* first tthread.synchronize support (merged neli's patches)

rtl/freebsd/classes.pp

@@ -43,18 +43,26 @@ uses
 
 initialization
   CommonInit;
-
+  {$ifndef ver1_0}
+    InitCriticalSection(SynchronizeCritSect);
+    ExecuteEvent := RtlEventCreate;
+    SynchronizeMethod := nil;
+  {$endif}
 finalization
   CommonCleanup;
-
 {$ifndef ver1_0}
   if ThreadsInited then
      DoneThreads;
+  DoneCriticalSection(SynchronizeCritSect);
+  RtlEventDestroy(ExecuteEvent);
 {$endif}
 end.
 {
   $Log$
-  Revision 1.7  2004-01-22 17:11:23  peter
+  Revision 1.8  2004-12-23 09:42:42  marco
+   * first tthread.synchronize support (merged neli's patches)
+
+  Revision 1.7  2004/01/22 17:11:23  peter
     * classes uses types to import TPoint and TRect
 
   Revision 1.6  2004/01/10 20:13:40  michael

rtl/freebsd/tthread.inc

@@ -346,6 +346,31 @@ end;
   change them completely.
 }
 
+
+var
+  { event that happens when gui thread is done executing the method}
+  ExecuteEvent: PRtlEvent;
+  { guard for synchronization variables }
+  SynchronizeCritSect: TRtlCriticalSection;
+  { method to execute }
+  SynchronizeMethod: TThreadMethod;
+  { caught exception in gui thread, to be raised in calling thread }
+  SynchronizeException: Exception;
+
+procedure CheckSynchronize;
+  { assumes being called from GUI thread }
+begin
+  if SynchronizeMethod = nil then
+    exit;
+
+  try
+    SynchronizeMethod;
+  except
+    SynchronizeException := Exception(AcquireExceptionObject);
+  end;
+  RtlEventSetEvent(ExecuteEvent);
+end;
+
 function SemaphoreInit: Pointer;
 begin
   SemaphoreInit := GetMem(SizeOf(TFilDes));
@@ -594,8 +619,24 @@ begin
 end;
 
 procedure TThread.Synchronize(Method: TThreadMethod);
+var
+  LocalSyncException: Exception;
 begin
-{$TODO someone with more clue of the GUI stuff will have to do this}
+  if SynchronizeMethodProc = nil then
+    { raise some error? }
+    exit;
+
+  EnterCriticalSection(SynchronizeCritSect);
+  SynchronizeMethod := Method;
+  SynchronizeException := nil;
+  SynchronizeMethodProc;
+  // wait infinitely
+  RtlEventWaitFor(ExecuteEvent);
+  SynchronizeMethod := nil;
+  LocalSyncException := SynchronizeException;
+  LeaveCriticalSection(SynchronizeCritSect);
+  if LocalSyncException <> nil then
+    raise LocalSyncException;
 end;
 
 procedure TThread.SetPriority(Value: TThreadPriority);
@@ -606,7 +647,10 @@ end;
 
 {
   $Log$
-  Revision 1.9  2004-03-06 01:27:40  marco
+  Revision 1.10  2004-12-23 09:42:42  marco
+   * first tthread.synchronize support (merged neli's patches)
+
+  Revision 1.9  2004/03/06 01:27:40  marco
    * Somebody forgot to adapt bsd again
 
   Revision 1.8  2004/01/03 12:18:29  marco

rtl/linux/classes.pp

@@ -48,19 +48,27 @@ uses
 
 initialization
   CommonInit;
-
+  {$ifndef VER1_0}
+    InitCriticalSection(SynchronizeCritSect);
+    ExecuteEvent := RtlEventCreate;
+    SynchronizeMethod := nil;
+  {$endif}
 finalization
   CommonCleanup;
 
 {$ifndef VER1_0}
   if ThreadsInited then
      DoneThreads;
+  DoneCriticalSection(SynchronizeCritSect);
+  RtlEventDestroy(ExecuteEvent);
 {$endif}
-
 end.
 {
   $Log$
-  Revision 1.5  2004-01-22 17:11:23  peter
+  Revision 1.6  2004-12-23 09:42:42  marco
+   * first tthread.synchronize support (merged neli's patches)
+
+  Revision 1.5  2004/01/22 17:11:23  peter
     * classes uses types to import TPoint and TRect
 
   Revision 1.4  2004/01/10 19:35:52  michael

rtl/linux/tthread.inc

@@ -66,6 +66,20 @@
   change them completely.
 }
 
+
+var
+  { event that happens when gui thread is done executing the method
+}
+  ExecuteEvent: PRtlEvent;
+  { guard for synchronization variables }
+  SynchronizeCritSect: TRtlCriticalSection;
+  { method to execute }
+  SynchronizeMethod: TThreadMethod;
+  { caught exception in gui thread, to be raised in calling thread }
+  SynchronizeException: Exception;
+
+
+
 function SemaphoreInit: Pointer;
 begin
   SemaphoreInit := GetMem(SizeOf(TFilDes));
@@ -314,8 +328,38 @@ begin
 end;
 
 procedure TThread.Synchronize(Method: TThreadMethod);
+var
+  LocalSyncException: Exception;
 begin
-{$TODO someone with more clue of the GUI stuff will have to do this}
+  if SynchronizeMethodProc = nil then
+    { raise some error? }
+    exit;
+
+  EnterCriticalSection(SynchronizeCritSect);
+  SynchronizeMethod := Method;
+  SynchronizeException := nil;
+  SynchronizeMethodProc;
+  // wait infinitely
+  RtlEventWaitFor(ExecuteEvent);
+  SynchronizeMethod := nil;
+  LocalSyncException := SynchronizeException;
+  LeaveCriticalSection(SynchronizeCritSect);
+  if LocalSyncException <> nil then
+    raise LocalSyncException;
+end;
+
+procedure CheckSynchronize;
+  { assumes being called from GUI thread }
+begin
+  if SynchronizeMethod = nil then
+    exit;
+
+  try
+    SynchronizeMethod;
+  except
+    SynchronizeException := Exception(AcquireExceptionObject);
+  end;
+  RtlEventSetEvent(ExecuteEvent);
 end;
 
 procedure TThread.SetPriority(Value: TThreadPriority);
@@ -325,7 +369,10 @@ end;
 
 {
   $Log$
-  Revision 1.8  2004-12-12 14:30:27  peter
+  Revision 1.9  2004-12-23 09:42:42  marco
+   * first tthread.synchronize support (merged neli's patches)
+
+  Revision 1.8  2004/12/12 14:30:27  peter
     * x86_64 updates
 
   Revision 1.7  2004/03/03 22:00:37  peter

rtl/win32/classes.pp

@@ -47,14 +47,24 @@ uses
 
 initialization
   CommonInit;
-
+  {$ifndef ver1_0}
+  systhrds.InitCriticalSection(SynchronizeCritSect);
+  ExecuteEvent := RtlEventCreate;
+  SynchronizeMethod := nil;
+  {$endif}
 finalization
   CommonCleanup;
-
+  {$ifndef ver1_0}
+    systhrds.DoneCriticalSection(SynchronizeCritSect);
+  RtlEventDestroy(ExecuteEvent);
+  {$endif}
 end.
 {
   $Log$
-  Revision 1.5  2004-01-22 17:11:23  peter
+  Revision 1.6  2004-12-23 09:42:42  marco
+   * first tthread.synchronize support (merged neli's patches)
+
+  Revision 1.5  2004/01/22 17:11:23  peter
     * classes uses types to import TPoint and TRect
 
   Revision 1.4  2004/01/13 18:04:25  florian

rtl/win32/tthread.inc

@@ -16,6 +16,16 @@ type
 var
   ThreadWindow: HWND;
   ThreadCount: Integer;
+  { event that happens when gui thread is done executing the method
+}
+  ExecuteEvent: PRtlEvent;
+  { guard for synchronization variables }
+  SynchronizeCritSect: systhrds.TRtlCriticalSection;
+  { method to execute }
+  SynchronizeMethod: TThreadMethod;
+  { caught exception in gui thread, to be raised in calling thread }
+  SynchronizeException: Exception;
+
 
 function ThreadWndProc(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
 
@@ -174,6 +184,7 @@ begin
   SetThreadPriority(FHandle, Priorities[Value]);
 end;
 
+{ old implementation? :
 procedure TThread.Synchronize(Method: TThreadMethod);
 begin
   FSynchronizeException := nil;
@@ -181,6 +192,42 @@ begin
   SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self));
   if Assigned(FSynchronizeException) then raise FSynchronizeException;
 end;
+}
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+var
+  LocalSyncException: Exception;
+begin
+  if SynchronizeMethodProc = nil then
+    { raise some error? }
+    exit;
+
+  systhrds.EnterCriticalSection(SynchronizeCritSect);
+  SynchronizeMethod := Method;
+  SynchronizeException := nil;
+  SynchronizeMethodProc;
+  // wait infinitely
+  RtlEventWaitFor(ExecuteEvent);
+  SynchronizeMethod := nil;
+  LocalSyncException := SynchronizeException;
+  systhrds.LeaveCriticalSection(SynchronizeCritSect);
+  if LocalSyncException <> nil then
+    raise LocalSyncException;
+end;
+
+procedure CheckSynchronize;
+  { assumes being called from GUI thread }
+begin
+  if SynchronizeMethod = nil then
+    exit;
+
+  try
+    SynchronizeMethod;
+  except
+    SynchronizeException := Exception(AcquireExceptionObject);
+  end;
+  RtlEventSetEvent(ExecuteEvent);
+end;
 
 procedure TThread.SetSuspended(Value: Boolean);
 begin
@@ -219,7 +266,10 @@ begin
 end;
 {
   $Log$
-  Revision 1.2  2004-01-29 16:58:28  marco
+  Revision 1.3  2004-12-23 09:42:42  marco
+   * first tthread.synchronize support (merged neli's patches)
+
+  Revision 1.2  2004/01/29 16:58:28  marco
    * threadproc is passed to OS and must be stdcall;
 
   Revision 1.1  2003/10/06 21:01:07  peter