paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 07:09:23 +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); New(FSynchronizeEntry);
FillChar(FSynchronizeEntry^, SizeOf(TThreadQueueEntry), 0); FillChar(FSynchronizeEntry^, SizeOf(TThreadQueueEntry), 0);
FSynchronizeEntry^.Thread := Self; FSynchronizeEntry^.Thread := Self;
FSynchronizeEntry^.ThreadID := ThreadID;
FSynchronizeEntry^.SyncEvent := RtlEventCreate; FSynchronizeEntry^.SyncEvent := RtlEventCreate;
end; end;
@ -335,20 +336,34 @@ procedure TThread.DoneSynchronizeEvent;
class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod); class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
var
syncentry: PThreadQueueEntry;
begin begin
{ ensure that we have a TThread instance } if not Assigned(AThread) then begin
if not Assigned(AThread) then { use a local synchronize event }
AThread := CurrentThread; 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 } syncentry := AThread.FSynchronizeEntry;
AThread.InitSynchronizeEvent; end;
AThread.FSynchronizeEntry^.Exception := Nil; syncentry^.Exception := Nil;
AThread.FSynchronizeEntry^.Method := AMethod; syncentry^.Method := AMethod;
ThreadQueueAppend(AThread.FSynchronizeEntry); ThreadQueueAppend(syncentry);
AThread.FSynchronizeEntry^.Method := Nil; syncentry^.Method := Nil;
AThread.FSynchronizeEntry^.Next := Nil; syncentry^.Next := Nil;
if not Assigned(AThread) then begin
{ clean up again }
RtlEventDestroy(syncentry^.SyncEvent);
Dispose(syncentry);
end;
end; end;
@ -453,13 +468,10 @@ class procedure TThread.Queue(aThread: TThread; aMethod: TThreadMethod); static;
var var
queueentry: PThreadQueueEntry; queueentry: PThreadQueueEntry;
begin begin
{ ensure that we have a valid TThread instance }
if not Assigned(aThread) then
aThread := CurrentThread;
New(queueentry); New(queueentry);
FillChar(queueentry^, SizeOf(TThreadQueueEntry), 0); FillChar(queueentry^, SizeOf(TThreadQueueEntry), 0);
queueentry^.Thread := aThread; queueentry^.Thread := aThread;
queueentry^.ThreadID := GetCurrentThreadID;
queueentry^.Method := aMethod; queueentry^.Method := aMethod;
{ the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) } { the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) }
@ -481,7 +493,7 @@ begin
entry := ThreadQueueHead; entry := ThreadQueueHead;
while Assigned(entry) do begin while Assigned(entry) do begin
{ first check for the thread } { 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; lastentry := entry;
entry := entry^.Next; entry := entry^.Next;
Continue; Continue;

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

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