浏览代码

Amiga: manually semaphore-protect the heap Pool, because classic Amiga has no MEMF_SEM_PROTECTED

git-svn-id: trunk@30356 -
Károly Balogh 10 年之前
父节点
当前提交
bbecfeed9e
共有 2 个文件被更改,包括 16 次插入0 次删除
  1. 13 0
      rtl/amicommon/sysheap.inc
  2. 3 0
      rtl/amiga/system.pp

+ 13 - 0
rtl/amicommon/sysheap.inc

@@ -25,7 +25,14 @@ function SysOSAlloc(size: ptruint): pointer;
 var values: array[0..2] of dword;
 {$ENDIF}
 begin
+{$IFDEF AMIGA}
+  { The mutex locking is only needed for AmigaOS, AROS and MorphOS has MEMF_SEM_PROTECTED }
+  ObtainSemaphore(ASYS_heapSemaphore);
+{$ENDIF}
   result:=AllocPooled(ASYS_heapPool,size);
+{$IFDEF AMIGA}
+  ReleaseSemaphore(ASYS_heapSemaphore);
+{$ENDIF}
 {$IFDEF ASYS_FPC_MEMDEBUG}
   values[0]:=dword(result);
   values[1]:=dword(size);
@@ -41,7 +48,13 @@ procedure SysOSFree(p: pointer; size: ptruint);
 var values: array[0..2] of dword;
 {$ENDIF}
 begin
+{$IFDEF AMIGA}
+  ObtainSemaphore(ASYS_heapSemaphore);
+{$ENDIF}
   FreePooled(ASYS_heapPool,p,size);
+{$IFDEF AMIGA}
+  ReleaseSemaphore(ASYS_heapSemaphore);
+{$ENDIF}
 {$IFDEF ASYS_FPC_MEMDEBUG}
   values[0]:=dword(p);
   values[1]:=dword(size);

+ 3 - 0
rtl/amiga/system.pp

@@ -79,6 +79,7 @@ var
 {$ENDIF}
 
   ASYS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
+  ASYS_heapSemaphore: Pointer; { 68k OS from 3.x has no MEMF_SEM_PROTECTED for pools, have to do it ourselves }
   ASYS_origDir  : LongInt; { original directory on startup }
   AOS_wbMsg    : Pointer; public name '_WBenchMsg'; { the "public" part is amunits compatibility kludge }
   _WBenchMsg   : Pointer; external name '_WBenchMsg'; { amunits compatibility kludge }
@@ -353,6 +354,8 @@ begin
   { Creating the memory pool for growing heap }
   ASYS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
   if ASYS_heapPool=nil then Halt(1);
+  ASYS_heapSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
+  InitSemaphore(ASYS_heapSemaphore);
 
   if AOS_wbMsg=nil then begin
     StdInputHandle:=dosInput;