paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 23:19:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* set function results for unimplemented generic thread manager routines

Browse Source 
(to remove warnings)
  * don't give a thread error for basicevent and threadevent routines if
    isMultiThreaded is false, except for the waiting routines (the new
    TMultiReadExclusiveWriteSynchronizer creates/sets such events in the
    constructor, which caused thread manager errors in case cthreads was
    not used under unix)
  * don't perform any actual locking in TMultiReadExclusiveWriteSynchronizer
    routines if isMultiThreaded is false (in order to avoid the errors
    described above)
  + added generic RTLeventResetEvent stub

git-svn-id: trunk@14592 -
This commit is contained in:
Jonas Maebe 2010-01-10 11:04:05 +00:00
parent 9bad162368
commit 356845ba1e
2 changed files with 132 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
rtl/inc/thread.inc
View File

@ -334,6 +334,7 @@ function NoBeginThread(sa : Pointer;stacksize : PtrUInt;
creationFlags : dword; var ThreadId : TThreadID) : TThreadID;
begin
NoThreadError;
result:=tthreadid(-1);
end;
procedure NoEndThread(ExitCode : DWord);
@ -344,6 +345,7 @@ end;
function NoThreadHandler (threadHandle : TThreadID) : dword;
begin
NoThreadError;
result:=dword(-1);
end;
procedure NoThreadSwitch; {give time to other threads}
@ -354,16 +356,19 @@ end;
function NoWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout}
begin
NoThreadError;
result:=dword(-1);
end;
function NoThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
begin
NoThreadError;
result:=false;
end;
function NoThreadGetPriority (threadHandle : TThreadID): longint;
begin
NoThreadError;
result:=-1;
end;
function NoGetCurrentThreadId : TThreadID;
@ -394,6 +399,7 @@ function NoRelocateThreadvar(offset : dword) : pointer;
begin
NoThreadError;
result:=nil;
end;
@ -412,31 +418,45 @@ end;
function noBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
result:=nil;
end;
procedure nobasiceventdestroy(state:peventstate);
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
procedure nobasiceventResetEvent(state:peventstate);
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
procedure nobasiceventSetEvent(state:peventstate);
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
function nobasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
begin
NoThreadError;
result:=-1;
end;
function NORTLEventCreate :PRTLEvent;
@ -445,7 +465,8 @@ begin
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true
ThreadingAlreadyUsed:=true;
result:=nil;
end;
procedure NORTLeventdestroy(state:pRTLEvent);
@ -460,7 +481,19 @@ end;
procedure NORTLeventSetEvent(state:pRTLEvent);
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
procedure NORTLeventResetEvent(state:pRTLEvent);
begin
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
procedure NORTLeventWaitFor(state:pRTLEvent);
@ -482,7 +515,11 @@ procedure NORTLeventsync(m:trtlmethod;p:tprocedure);
function NoSemaphoreInit: Pointer;
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
result:=nil;
end;
procedure NoSemaphoreWait(const FSem: Pointer);
@ -492,12 +529,18 @@ end;
procedure NoSemaphorePost(const FSem: Pointer);
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
procedure NoSemaphoreDestroy(const FSem: Pointer);
begin
NoThreadError;
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
Var
@ -536,6 +579,7 @@ begin
rtlEventCreate :=@NortlEventCreate;
rtleventdestroy :=@Nortleventdestroy;
rtleventSetEvent :=@NortleventSetEvent;
rtleventResetEvent :=@NortleventResetEvent;
rtleventWaitFor :=@NortleventWaitFor;
rtleventsync :=@Nortleventsync;
rtleventwaitfortimeout :=@NortleventWaitForTimeout;

138
rtl/objpas/sysutils/sysuthrd.inc
View File

@ -68,28 +68,33 @@ end;
function TMultiReadExclusiveWriteSynchronizer.Beginwrite : boolean;
begin
{ wait for any other writers that may be in progress }
RTLEventWaitFor(fwritelock);
{ it is possible that we earlier on missed waiting on the
fwaitingwriterlock and that it's still set (must be done
after aquiring the fwritelock, because otherwise one
writer could reset the fwaitingwriterlock of another one
that's about to wait on it) }
RTLeventResetEvent(fwaitingwriterlock);
{ new readers have to block from now on; writers get priority to avoid
writer starvation (since they have to compete with potentially many
concurrent readers) }
BasicEventResetEvent(freaderqueue);
{ for quick checking by candidate-readers }
System.InterlockedExchange(fwritelocked,1);
{ wait until all readers are gone -- freadercount and fwritelocked are only
accessed using atomic operations (that's why we use
InterLockedExchangeAdd(x,0) below) -> always in-order. The writer always
first sets fwritelocked and then checks freadercount, while the readers
always first increase freadercount and then check fwritelocked }
while (System.InterLockedExchangeAdd(freadercount,0)<>0) do
RTLEventWaitFor(fwaitingwriterlock);
{ if IsMultiThread is false, no thread manager may be installed
under unix and hence the event routines may throw an error }
if IsMultiThread then
begin
{ wait for any other writers that may be in progress }
RTLEventWaitFor(fwritelock);
{ it is possible that we earlier on missed waiting on the
fwaitingwriterlock and that it's still set (must be done
after aquiring the fwritelock, because otherwise one
writer could reset the fwaitingwriterlock of another one
that's about to wait on it) }
RTLeventResetEvent(fwaitingwriterlock);
{ new readers have to block from now on; writers get priority to avoid
writer starvation (since they have to compete with potentially many
concurrent readers) }
BasicEventResetEvent(freaderqueue);
{ for quick checking by candidate-readers }
System.InterlockedExchange(fwritelocked,1);
{ wait until all readers are gone -- freadercount and fwritelocked are only
accessed using atomic operations (that's why we use
InterLockedExchangeAdd(x,0) below) -> always in-order. The writer always
first sets fwritelocked and then checks freadercount, while the readers
always first increase freadercount and then check fwritelocked }
while (System.InterLockedExchangeAdd(freadercount,0)<>0) do
RTLEventWaitFor(fwaitingwriterlock);
end;
{ we have the writer lock, and all readers are gone }
result:=true;
@ -98,20 +103,25 @@ end;
procedure TMultiReadExclusiveWriteSynchronizer.Endwrite;
begin
{ Finish all writes inside the section so that everything executing
afterwards will certainly see these results }
WriteBarrier;
{ if IsMultiThread is false, no thread manager may be installed
under unix and hence the event routines may throw an error }
if IsMultiThread then
begin
{ Finish all writes inside the section so that everything executing
afterwards will certainly see these results }
WriteBarrier;
{ signal potential readers that the coast is clear }
System.InterlockedExchange(fwritelocked,0);
{ wake up waiting readers (if any); do not check first whether freadercount
is <> 0, because the InterlockedDecrement in the while loop of BeginRead
can have already occurred, so a single reader may be about to wait on
freaderqueue even though freadercount=0. Setting an event multiple times
is no problem. }
BasicEventSetEvent(freaderqueue);
{ free the writer lock so another writer can become active }
RTLeventSetEvent(fwritelock);
{ signal potential readers that the coast is clear }
System.InterlockedExchange(fwritelocked,0);
{ wake up waiting readers (if any); do not check first whether freadercount
is <> 0, because the InterlockedDecrement in the while loop of BeginRead
can have already occurred, so a single reader may be about to wait on
freaderqueue even though freadercount=0. Setting an event multiple times
is no problem. }
BasicEventSetEvent(freaderqueue);
{ free the writer lock so another writer can become active }
RTLeventSetEvent(fwritelock);
end;
end;
@ -122,37 +132,47 @@ Const
wrAbandoned= 2;
wrError = 3;
begin
System.InterlockedIncrement(freadercount);
{ wait until there is no more writer }
while System.InterLockedExchangeAdd(fwritelocked,0)<>0 do
{ if IsMultiThread is false, no thread manager may be installed
under unix and hence the event routines may throw an error }
if IsMultiThread then
begin
{ there's a writer busy or wanting to start -> wait until it's
finished; a writer may already be blocked in the mean time, so
wake it up if we're the last to go to sleep }
if System.InterlockedDecrement(freadercount)=0 then
RTLEventSetEvent(fwaitingwriterlock);
if (BasicEventWaitFor(high(cardinal),freaderqueue) in [wrAbandoned,wrError]) then
raise Exception.create('BasicEventWaitFor failed in TMultiReadExclusiveWriteSynchronizer.Beginread');
{ and try again: first increase freadercount, only then check
fwritelocked }
System.InterlockedIncrement(freadercount);
{ wait until there is no more writer }
while System.InterLockedExchangeAdd(fwritelocked,0)<>0 do
begin
{ there's a writer busy or wanting to start -> wait until it's
finished; a writer may already be blocked in the mean time, so
wake it up if we're the last to go to sleep }
if System.InterlockedDecrement(freadercount)=0 then
RTLEventSetEvent(fwaitingwriterlock);
if (BasicEventWaitFor(high(cardinal),freaderqueue) in [wrAbandoned,wrError]) then
raise Exception.create('BasicEventWaitFor failed in TMultiReadExclusiveWriteSynchronizer.Beginread');
{ and try again: first increase freadercount, only then check
fwritelocked }
System.InterlockedIncrement(freadercount);
end;
end;
end;
procedure TMultiReadExclusiveWriteSynchronizer.Endread;
begin
{ Make sure that all read operations have finished, so that none of those
can still be executed after a writer starts working and changes some
things }
ReadBarrier;
{ if IsMultiThread is false, no thread manager may be installed
under unix and hence the event routines may throw an error }
if IsMultiThread then
begin
{ Make sure that all read operations have finished, so that none of those
can still be executed after a writer starts working and changes some
things }
ReadBarrier;
{ If no more readers, wake writer in the ready-queue if any. Since a writer
always first atomically sets the fwritelocked and then atomically checks
the freadercount, first modifying freadercount and then checking fwritelock
ensures that we cannot miss one of the events regardless of execution
order. }
if (System.InterlockedDecrement(freadercount)=0) and
(System.InterLockedExchangeAdd(fwritelocked,0)<>0) then
RTLEventSetEvent(fwaitingwriterlock);
{ If no more readers, wake writer in the ready-queue if any. Since a writer
always first atomically sets the fwritelocked and then atomically checks
the freadercount, first modifying freadercount and then checking fwritelock
ensures that we cannot miss one of the events regardless of execution
order. }
if (System.InterlockedDecrement(freadercount)=0) and
(System.InterLockedExchangeAdd(fwritelocked,0)<>0) then
RTLEventSetEvent(fwaitingwriterlock);
end;
end;