paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-23 16:49:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@30356 -
This commit is contained in:
Károly Balogh 2015-03-29 00:18:19 +00:00
parent 0bccf5f09f
commit bbecfeed9e
2 changed files with 16 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
rtl/amicommon/sysheap.inc
View File

@ -25,7 +25,14 @@ function SysOSAlloc(size: ptruint): pointer;
var values: array[0..2] of dword; var values: array[0..2] of dword;
{$ENDIF} {$ENDIF}
begin 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); result:=AllocPooled(ASYS_heapPool,size);
{$IFDEF AMIGA}
ReleaseSemaphore(ASYS_heapSemaphore);
{$ENDIF}
{$IFDEF ASYS_FPC_MEMDEBUG} {$IFDEF ASYS_FPC_MEMDEBUG}
values[0]:=dword(result); values[0]:=dword(result);
values[1]:=dword(size); values[1]:=dword(size);
@ -41,7 +48,13 @@ procedure SysOSFree(p: pointer; size: ptruint);
var values: array[0..2] of dword; var values: array[0..2] of dword;
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF AMIGA}
ObtainSemaphore(ASYS_heapSemaphore);
{$ENDIF}
FreePooled(ASYS_heapPool,p,size); FreePooled(ASYS_heapPool,p,size);
{$IFDEF AMIGA}
ReleaseSemaphore(ASYS_heapSemaphore);
{$ENDIF}
{$IFDEF ASYS_FPC_MEMDEBUG} {$IFDEF ASYS_FPC_MEMDEBUG}
values[0]:=dword(p); values[0]:=dword(p);
values[1]:=dword(size); values[1]:=dword(size);

3
rtl/amiga/system.pp
View File

@ -79,6 +79,7 @@ var
{$ENDIF} {$ENDIF}
ASYS_heapPool : Pointer; { pointer for the OS pool for growing the heap } 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 } ASYS_origDir : LongInt; { original directory on startup }
AOS_wbMsg : Pointer; public name '_WBenchMsg'; { the "public" part is amunits compatibility kludge } AOS_wbMsg : Pointer; public name '_WBenchMsg'; { the "public" part is amunits compatibility kludge }
_WBenchMsg : Pointer; external name '_WBenchMsg'; { amunits compatibility kludge } _WBenchMsg : Pointer; external name '_WBenchMsg'; { amunits compatibility kludge }
@ -353,6 +354,8 @@ begin
{ Creating the memory pool for growing heap } { Creating the memory pool for growing heap }
ASYS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1); ASYS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
if ASYS_heapPool=nil then Halt(1); if ASYS_heapPool=nil then Halt(1);
ASYS_heapSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
InitSemaphore(ASYS_heapSemaphore);
if AOS_wbMsg=nil then begin if AOS_wbMsg=nil then begin
StdInputHandle:=dosInput; StdInputHandle:=dosInput;