paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 12:29:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

amicommon: properly arbitrate access to the open file list in a multithreaded environment

Browse Source 
git-svn-id: trunk@30899 -
This commit is contained in:
Károly Balogh 2015-05-24 12:15:02 +00:00
parent 528b0832c6
commit f5bcb011ea
4 changed files with 29 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
rtl/amicommon/sysfile.inc
View File

@ -40,6 +40,7 @@ var
tmpHandle : LongInt;
begin
if l=nil then exit;
ObtainSemaphore(ASYS_fileSemaphore);
{ First, close all tracked files }
tmpNext:=l^.next;
@ -58,6 +59,7 @@ begin
l:=l^.next;
dispose(tmpNext);
end;
ReleaseSemaphore(ASYS_fileSemaphore);
end;
{ Function to be called to add a file to the opened file list }
@ -67,6 +69,8 @@ var
inList: Boolean;
begin
inList:=False;
ObtainSemaphore(ASYS_fileSemaphore);
if l<>nil then begin
{ if there is a valid filelist, search for the value }
{ in the list to avoid double additions }
@ -93,6 +97,7 @@ begin
RawDoFmt('FPC_FILE_DEBUG: Error! Trying add filehandle a filehandle twice: $%lx !'+#10,@h,pointer(1),nil);
{$ENDIF}
;
ReleaseSemaphore(ASYS_fileSemaphore);
end;
{ Function to be called to remove a file from the list }
@ -108,6 +113,7 @@ begin
exit;
end;
ObtainSemaphore(ASYS_fileSemaphore);
p:=l;
while (p^.next<>nil) and (not inList) do
if p^.next^.handle=h then inList:=True
@ -123,6 +129,7 @@ begin
RawDoFmt('FPC_FILE_DEBUG: Error! Trying to remove not existing filehandle: $%lx !'+#10,@h,pointer(1),nil);
{$ENDIF}
;
ReleaseSemaphore(ASYS_fileSemaphore);
RemoveFromList:=inList;
end;
@ -140,6 +147,7 @@ begin
exit;
end;
ObtainSemaphore(ASYS_fileSemaphore);
p:=l;
while (p^.next<>nil) and (inList=nil) do
if p^.next^.handle=h then inList:=p^.next
@ -150,6 +158,7 @@ begin
RawDoFmt('FPC_FILE_DEBUG: Warning! Check for not existing filehandle: $%lx !'+#10,@h,pointer(1),nil);
{$ENDIF}
ReleaseSemaphore(ASYS_fileSemaphore);
CheckInList:=inList;
end;

7
rtl/amiga/system.pp
View File

@ -80,6 +80,7 @@ var
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_fileSemaphore: Pointer; { mutex semaphore for filelist access arbitration }
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 }
@ -355,8 +356,14 @@ begin
ASYS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
if ASYS_heapPool=nil then Halt(1);
ASYS_heapSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
if ASYS_heapSemaphore = nil then Halt(1);
InitSemaphore(ASYS_heapSemaphore);
{ Initialize semaphore for filelist access arbitration }
ASYS_fileSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
if ASYS_fileSemaphore = nil then Halt(1);
InitSemaphore(ASYS_fileSemaphore);
if AOS_wbMsg=nil then begin
StdInputHandle:=dosInput;
StdOutputHandle:=dosOutput;

7
rtl/aros/system.pp
View File

@ -67,6 +67,7 @@ var
AROS_ThreadLib : Pointer; public name 'AROS_THREADLIB';
ASYS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
ASYS_fileSemaphore: Pointer; { mutex semaphore for filelist access arbitration }
ASYS_origDir : LongInt; { original directory on startup }
AOS_wbMsg : Pointer;
AOS_ConName : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT';
@ -415,6 +416,12 @@ begin
if ASYS_heapPool = nil then
Halt(1);
{ Initialize semaphore for filelist access arbitration }
ASYS_fileSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
if ASYS_fileSemaphore = nil then
Halt(1);
InitSemaphore(ASYS_fileSemaphore);
if AOS_wbMsg = nil then begin
StdInputHandle := THandle(dosInput);
StdOutputHandle := THandle(dosOutput);

6
rtl/morphos/system.pp
View File

@ -64,6 +64,7 @@ var
MOS_UtilityBase: Pointer;
ASYS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
ASYS_fileSemaphore: Pointer; { mutex semaphore for filelist access arbitration }
ASYS_origDir : LongInt; { original directory on startup }
MOS_ambMsg : Pointer;
MOS_ConName : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT';
@ -367,6 +368,11 @@ begin
{ Creating the memory pool for growing heap }
ASYS_heapPool:=CreatePool(MEMF_FAST or MEMF_SEM_PROTECTED,growheapsize2,growheapsize1);
if ASYS_heapPool=nil then Halt(1);
{ Initialize semaphore for filelist access arbitration }
ASYS_fileSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
if ASYS_fileSemaphore = nil then Halt(1);
InitSemaphore(ASYS_fileSemaphore);
if MOS_ambMsg=nil then begin
MOS_ConHandle:=0;