paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 11:48:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

Avoid the creation of a TExternalThread instance for Synchronize() and Queue() (Delphi does the same).

Browse Source 
Note: the Sender parameter of WakeMainThread will be Nil for such threads. This is Delphi compatible.

rtl/objpas/classes/classesh.inc, TThread:
  + TThreadQueueEntry: new field ThreadID so that entries with Thread = Nil can be removed
rtl/objpas/classes/classes.inc, TThread:
  * InitSynchronizeEvent: setup ThreadID field
  * Synchronize: use a local TThreadQueueEntry if no TThread instance was passed in
  * Queue: setup ThreadID
  * RemoveQueueEvents: also check for ThreadID when trying to find the current thread

git-svn-id: trunk@33863 -
This commit is contained in:
svenbarth 2016-05-31 20:01:52 +00:00
parent a561ffe836
commit d5cc59c22e
2 changed files with 28 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
rtl/objpas/classes/classes.inc
View File

@ -319,6 +319,7 @@ procedure TThread.InitSynchronizeEvent;
New(FSynchronizeEntry);
FillChar(FSynchronizeEntry^, SizeOf(TThreadQueueEntry), 0);
FSynchronizeEntry^.Thread := Self;
FSynchronizeEntry^.ThreadID := ThreadID;
FSynchronizeEntry^.SyncEvent := RtlEventCreate;
end;
@ -335,20 +336,34 @@ procedure TThread.DoneSynchronizeEvent;
class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
var
syncentry: PThreadQueueEntry;
begin
{ ensure that we have a TThread instance }
if not Assigned(AThread) then
AThread := CurrentThread;
if not Assigned(AThread) then begin
{ use a local synchronize event }
New(syncentry);
FillChar(syncentry^, SizeOf(syncentry), 0);
syncentry^.ThreadID := GetCurrentThreadID;
syncentry^.SyncEvent := RtlEventCreate;
end else begin
{ the Synchronize event is instantiated on demand }
AThread.InitSynchronizeEvent;
{ the Synchronize event is instantiated on demand }
AThread.InitSynchronizeEvent;
syncentry := AThread.FSynchronizeEntry;
end;
AThread.FSynchronizeEntry^.Exception := Nil;
AThread.FSynchronizeEntry^.Method := AMethod;
ThreadQueueAppend(AThread.FSynchronizeEntry);
syncentry^.Exception := Nil;
syncentry^.Method := AMethod;
ThreadQueueAppend(syncentry);
AThread.FSynchronizeEntry^.Method := Nil;
AThread.FSynchronizeEntry^.Next := Nil;
syncentry^.Method := Nil;
syncentry^.Next := Nil;
if not Assigned(AThread) then begin
{ clean up again }
RtlEventDestroy(syncentry^.SyncEvent);
Dispose(syncentry);
end;
end;
@ -453,13 +468,10 @@ class procedure TThread.Queue(aThread: TThread; aMethod: TThreadMethod); static;
var
queueentry: PThreadQueueEntry;
begin
{ ensure that we have a valid TThread instance }
if not Assigned(aThread) then
aThread := CurrentThread;
New(queueentry);
FillChar(queueentry^, SizeOf(TThreadQueueEntry), 0);
queueentry^.Thread := aThread;
queueentry^.ThreadID := GetCurrentThreadID;
queueentry^.Method := aMethod;
{ the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) }
@ -481,7 +493,7 @@ begin
entry := ThreadQueueHead;
while Assigned(entry) do begin
{ first check for the thread }
if Assigned(aThread) and (entry^.Thread <> aThread) then begin
if Assigned(aThread) and (entry^.Thread <> aThread) and (entry^.ThreadID <> aThread.ThreadID) then begin
lastentry := entry;
entry := entry^.Next;
Continue;

1
rtl/objpas/classes/classesh.inc
View File

@ -1591,6 +1591,7 @@ type
// uncomment once closures are supported
//ThreadProc: TThreadProcedure;
Thread: TThread;
ThreadID: TThreadID;
Exception: Exception;
SyncEvent: PRtlEvent;
Next: PThreadQueueEntry;