From d5cc59c22eab86713496e215a59b33b7d8b007c8 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Tue, 31 May 2016 20:01:52 +0000
Subject: [PATCH] Avoid the creation of a TExternalThread instance for
 Synchronize() and Queue() (Delphi does the same). 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 -
---
 rtl/objpas/classes/classes.inc  | 42 +++++++++++++++++++++------------
 rtl/objpas/classes/classesh.inc |  1 +
 2 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc
index 11ce4a433a..056ae4438d 100644
--- a/rtl/objpas/classes/classes.inc
+++ b/rtl/objpas/classes/classes.inc
@@ -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;
diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
index 578c41a35c..0cada287e7 100644
--- a/rtl/objpas/classes/classesh.inc
+++ b/rtl/objpas/classes/classesh.inc
@@ -1591,6 +1591,7 @@ type
       // uncomment once closures are supported
       //ThreadProc: TThreadProcedure;
       Thread: TThread;
+      ThreadID: TThreadID;
       Exception: Exception;
       SyncEvent: PRtlEvent;
       Next: PThreadQueueEntry;