ソースを参照

* 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
only showed on make install should be fixed now.

marco 20 年 前
コミット
7377bbf1c9

+ 7 - 10
rtl/freebsd/classes.pp

@@ -43,23 +43,20 @@ uses
 
 initialization
   CommonInit;
-  {$ifndef ver1_0}
-    InitCriticalSection(SynchronizeCritSect);
-    ExecuteEvent := RtlEventCreate;
-    SynchronizeMethod := nil;
-  {$endif}
 finalization
   CommonCleanup;
-{$ifndef ver1_0}
+  {$ifndef ver1_0}
   if ThreadsInited then
      DoneThreads;
-  DoneCriticalSection(SynchronizeCritSect);
-  RtlEventDestroy(ExecuteEvent);
-{$endif}
+  {$endif}
 end.
 {
   $Log$
-  Revision 1.8  2004-12-23 09:42:42  marco
+  Revision 1.9  2004-12-23 15:08:58  marco
+   * 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
+     only showed on make install should be fixed now.
+
+  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

+ 8 - 27
rtl/freebsd/tthread.inc

@@ -346,31 +346,6 @@ 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));
@@ -625,7 +600,8 @@ begin
   if SynchronizeMethodProc = nil then
     { raise some error? }
     exit;
-
+  rtleventsync(systhrds.trtlmethod(method),synchronizemethodproc);
+{
   EnterCriticalSection(SynchronizeCritSect);
   SynchronizeMethod := Method;
   SynchronizeException := nil;
@@ -637,6 +613,7 @@ begin
   LeaveCriticalSection(SynchronizeCritSect);
   if LocalSyncException <> nil then
     raise LocalSyncException;
+}
 end;
 
 procedure TThread.SetPriority(Value: TThreadPriority);
@@ -647,7 +624,11 @@ end;
 
 {
   $Log$
-  Revision 1.10  2004-12-23 09:42:42  marco
+  Revision 1.11  2004-12-23 15:08:58  marco
+   * 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
+     only showed on make install should be fixed now.
+
+  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

+ 18 - 2
rtl/inc/thread.inc

@@ -254,6 +254,12 @@ begin
   currenttm.rtleventWaitFor(state);
 end;
 
+procedure RTLeventsync(m:trtlmethod;p:tprocedure);
+
+begin
+  currenttm.rtleventsync(m,p);
+end;
+
 
 { ---------------------------------------------------------------------
     ThreadManager which gives run-time error. Use if no thread support.
@@ -403,6 +409,12 @@ begin
   NoThreadError;
 end;
 
+procedure NORTLeventsync(m:trtlmethod;p:tprocedure);
+
+begin
+  NoThreadError;
+end;
+
 
 Var
   NoThreadManager : TThreadManager;
@@ -441,7 +453,7 @@ begin
     rtleventdestroy        :=@Nortleventdestroy;
     rtleventSetEvent       :=@NortleventSetEvent;
     rtleventWaitFor        :=@NortleventWaitFor;
-
+    rtleventsync	   :=@Nortleventsync;
     end;
   SetThreadManager(NoThreadManager);
 end;
@@ -449,7 +461,11 @@ end;
 
 {
   $Log$
-  Revision 1.13  2004-12-22 21:29:24  marco
+  Revision 1.14  2004-12-23 15:08:58  marco
+   * 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
+     only showed on make install should be fixed now.
+
+  Revision 1.13  2004/12/22 21:29:24  marco
    * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
   	Check work: ask Neli.
 

+ 9 - 3
rtl/inc/threadh.inc

@@ -23,6 +23,7 @@ type
   PEventState = pointer;
   PRTLEvent   = pointer;   // Windows=thandle, other=pointer to record.
   TThreadFunc = function(parameter : pointer) : ptrint;
+  trtlmethod     = procedure of object;
 
   // Function prototypes for TThreadManager Record.
   TBeginThreadHandler = Function (sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : THandle) : DWord;
@@ -44,7 +45,7 @@ type
   TBasicEventCreateHandler  = function (EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
   TRTLEventHandler	    = procedure(AEvent:PRTLEvent);
   TRTLCreateEventHandler    = function:PRTLEvent;	
-
+  TRTLEventSyncHandler	    = procedure (m:trtlmethod;p:tprocedure);
   // TThreadManager interface.
   TThreadManager = Record
     InitManager            : Function : Boolean;
@@ -76,6 +77,7 @@ type
     RTLEventDestroy	   : TRTLEventHandler;
     RTLEventSetEvent       : TRTLEventHandler;
     RTLeventWaitFOr	   : TRTLEventHandler;
+    RTLEventSync	   : TRTLEventSyncHandler;
   end;
 
 {*****************************************************************************
@@ -154,10 +156,14 @@ function  RTLEventCreate :PRTLEvent;
 procedure RTLeventdestroy(state:pRTLEvent);
 procedure RTLeventSetEvent(state:pRTLEvent);
 procedure RTLeventWaitFor(state:pRTLEvent);
-
+procedure RTLeventsync(m:trtlmethod;p:tprocedure);
 {
   $Log$
-  Revision 1.21  2004-12-22 21:29:24  marco
+  Revision 1.22  2004-12-23 15:08:58  marco
+   * 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
+     only showed on make install should be fixed now.
+
+  Revision 1.21  2004/12/22 21:29:24  marco
    * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
   	Check work: ask Neli.
 

+ 5 - 8
rtl/linux/classes.pp

@@ -48,24 +48,21 @@ 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.6  2004-12-23 09:42:42  marco
+  Revision 1.7  2004-12-23 15:08:58  marco
+   * 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
+     only showed on make install should be fixed now.
+
+  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

+ 6 - 41
rtl/linux/tthread.inc

@@ -66,20 +66,6 @@
   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));
@@ -334,32 +320,7 @@ begin
   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);
+  rtleventsync(systhrds.trtlmethod(method),synchronizemethodproc);
 end;
 
 procedure TThread.SetPriority(Value: TThreadPriority);
@@ -369,7 +330,11 @@ end;
 
 {
   $Log$
-  Revision 1.9  2004-12-23 09:42:42  marco
+  Revision 1.10  2004-12-23 15:08:58  marco
+   * 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
+     only showed on make install should be fixed now.
+
+  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

+ 63 - 1
rtl/unix/cthreads.pp

@@ -564,6 +564,52 @@ begin
   pthread_mutex_unlock(@p^.mutex);
 end;
 
+type tthreadmethod = procedure of object;
+
+
+
+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;
+
+procedure intRTLEventsync(thrdmethd: tmethod;synchronizemethodproc:TProcedure);
+
+var LocalSyncException : Exception;
+
+begin
+  EnterCriticalSection(SynchronizeCritSect);
+  SynchronizeMethod := tthreadmethod(thrdmethd);
+  SynchronizeException := nil;
+  SynchronizeMethodProc;
+  // wait infinitely
+  RtlEventWaitFor(ExecuteEvent);
+  SynchronizeMethod := nil;
+  LocalSyncException  := SynchronizeException;
+  LeaveCriticalSection(SynchronizeCritSect);
+  if LocalSyncException <> nil then
+    raise LocalSyncException;
+end;
+
 Var
   CThreadManager : TThreadManager;
 
@@ -603,17 +649,33 @@ begin
     rtlEventDestroy        :=@intrtlEventDestroy;
     rtlEventSetEvent       :=@intrtlEventSetEvent;
     rtleventWaitFor        :=@intrtleventWaitFor;
+    rtleventsync           :=trtleventsynchandler(@intrtleventsync);
     end;
   SetThreadManager(CThreadManager);
   InitHeapMutexes;
 end;
 
+
 initialization
   SetCThreadManager;
+ {$ifndef ver1_0}
+    InitCriticalSection(SynchronizeCritSect);
+    ExecuteEvent := RtlEventCreate;
+    SynchronizeMethod := nil;
+  {$endif}
+finalization
+  {$ifndef ver1_0}
+    DoneCriticalSection(SynchronizeCritSect);  
+    RtlEventDestroy(ExecuteEvent);
+  {$endif}
 end.
 {
   $Log$
-  Revision 1.15  2004-12-22 21:29:24  marco
+  Revision 1.16  2004-12-23 15:08:59  marco
+   * 2nd synchronize attempt. cthreads<->systhrds difference was not ok, but
+     only showed on make install should be fixed now.
+
+  Revision 1.15  2004/12/22 21:29:24  marco
    * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
   	Check work: ask Neli.