Browse Source

+ classes.mainthreadid is set now
+ rtleventresetevent
+ rtleventwairfor with timeout
+ checksynchronize with timeout
* race condition in synchronize fixed

florian 20 years ago
parent
commit
710dbcef0a
4 changed files with 94 additions and 18 deletions
  1. 42 13
      rtl/inc/thread.inc
  2. 13 1
      rtl/inc/threadh.inc
  3. 15 1
      rtl/unix/cthreads.pp
  4. 24 3
      rtl/win32/systhrd.inc

+ 42 - 13
rtl/inc/thread.inc

@@ -238,6 +238,12 @@ begin
   currenttm.rtleventsetEvent(state);
 end;
 
+procedure RTLeventResetEvent(state:pRTLEvent);
+
+begin
+  currenttm.rtleventResetEvent(state);
+end;
+
 procedure RTLeventStartWait(state:pRTLEvent);
 
 begin
@@ -250,6 +256,12 @@ begin
   currenttm.rtleventWaitFor(state);
 end;
 
+procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
+
+begin
+  currenttm.rtleventWaitForTimeout(state,timeout);
+end;
+
 procedure RTLeventsync(m:trtlmethod;p:tprocedure);
 
 begin
@@ -319,7 +331,11 @@ end;
 
 function  NoGetCurrentThreadId : dword;
 begin
-  NoThreadError;
+  if IsMultiThread then
+    NoThreadError
+  else
+    ThreadingAlreadyUsed:=true;
+  result:=ThreadID;
 end;
 
 procedure NoCriticalSection(var CS);
@@ -411,22 +427,27 @@ begin
 end;
 
 procedure NORTLeventStartWait(state:pRTLEvent);
-
-begin
-  NoThreadError;
-end;
+  begin
+    NoThreadError;
+  end;
+  
 
 procedure NORTLeventWaitFor(state:pRTLEvent);
+  begin
+    NoThreadError;
+  end;
+  
 
-begin
-  NoThreadError;
-end;
+procedure NORTLeventWaitForTimeout(state:pRTLEvent;timeout : longint);
+  begin
+    NoThreadError;
+  end;
+  
 
 procedure NORTLeventsync(m:trtlmethod;p:tprocedure);
-
-begin
-  NoThreadError;
-end;
+  begin
+    NoThreadError;
+  end;
 
 
 Var
@@ -468,6 +489,7 @@ begin
     rtleventStartWait      :=@NortleventStartWait;
     rtleventWaitFor        :=@NortleventWaitFor;
     rtleventsync           :=@Nortleventsync;
+    rtleventwaitfortimeout :=@NortleventWaitForTimeout;
     end;
   SetThreadManager(NoThreadManager);
 end;
@@ -475,7 +497,14 @@ end;
 
 {
   $Log$
-  Revision 1.25  2005-04-03 19:29:28  florian
+  Revision 1.26  2005-04-09 17:26:08  florian
+    + classes.mainthreadid is set now
+    + rtleventresetevent
+    + rtleventwairfor with timeout
+    + checksynchronize with timeout
+    * race condition in synchronize fixed
+
+  Revision 1.25  2005/04/03 19:29:28  florian
     * proper error message if the cthreads unit is included too late
       uses clause
 

+ 13 - 1
rtl/inc/threadh.inc

@@ -44,6 +44,7 @@ type
   TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
   TBasicEventCreateHandler  = function (EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
   TRTLEventHandler          = procedure(AEvent:PRTLEvent);
+  TRTLEventHandlerTimeout   = procedure(AEvent:PRTLEvent;timeout : longint);
   TRTLCreateEventHandler    = function:PRTLEvent;
   TRTLEventSyncHandler      = procedure (m:trtlmethod;p:tprocedure);
 
@@ -77,9 +78,11 @@ type
     RTLEventCreate         : TRTLCreateEventHandler;
     RTLEventDestroy        : TRTLEventHandler;
     RTLEventSetEvent       : TRTLEventHandler;
+    RTLEventResetEvent     : TRTLEventHandler;
     RTLEventStartWait      : TRTLEventHandler;
     RTLEventWaitFor        : TRTLEventHandler;
     RTLEventSync           : TRTLEventSyncHandler;
+    RTLEventWaitForTimeout : TRTLEventHandlerTimeout;
   end;
 
 {*****************************************************************************
@@ -144,13 +147,22 @@ function  basiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
 function  RTLEventCreate :PRTLEvent;
 procedure RTLeventdestroy(state:pRTLEvent);
 procedure RTLeventSetEvent(state:pRTLEvent);
+procedure RTLeventResetEvent(state:pRTLEvent);
 procedure RTLeventStartWait(state:pRTLEvent);
 procedure RTLeventWaitFor(state:pRTLEvent);
+procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
 procedure RTLeventsync(m:trtlmethod;p:tprocedure);
 
 {
   $Log$
-  Revision 1.28  2005-02-25 22:02:48  florian
+  Revision 1.29  2005-04-09 17:26:08  florian
+    + classes.mainthreadid is set now
+    + rtleventresetevent
+    + rtleventwairfor with timeout
+    + checksynchronize with timeout
+    * race condition in synchronize fixed
+
+  Revision 1.28  2005/02/25 22:02:48  florian
     * another "transfer to linux"-commit
 
   Revision 1.27  2005/02/14 17:13:29  peter

+ 15 - 1
rtl/unix/cthreads.pp

@@ -527,6 +527,13 @@ begin
   pthread_mutex_unlock(@p^.mutex);
 end;
 
+
+procedure intRTLEventResetEvent(AEvent: PRTLEvent);
+  begin
+    { events before startwait are ignored unix }
+  end;
+
+
 procedure intRTLEventStartWait(AEvent: PRTLEvent);
 var p:pintrtlevent;
 
@@ -634,7 +641,14 @@ finalization
 end.
 {
   $Log$
-  Revision 1.25  2005-04-03 19:29:28  florian
+  Revision 1.26  2005-04-09 17:26:08  florian
+    + classes.mainthreadid is set now
+    + rtleventresetevent
+    + rtleventwairfor with timeout
+    + checksynchronize with timeout
+    * race condition in synchronize fixed
+
+  Revision 1.25  2005/04/03 19:29:28  florian
     * proper error message if the cthreads unit is included too late
       uses clause
 

+ 24 - 3
rtl/win32/systhrd.inc

@@ -396,18 +396,30 @@ begin
   SetEvent(THANDLE(AEvent));
 end;
 
+procedure intRTLEventResetEvent(AEvent: PRTLEvent);
+begin
+  ResetEvent(THANDLE(AEvent));
+end;
+
 procedure intRTLEventStartWait(AEvent: PRTLEvent);
 begin
-  // nothing to do, win32 events stay signalled after being set
+  { this is to get at least some common behaviour on unix and win32:
+    events before startwait are lost on unix, so reset the event on
+    win32 as well }
+  ResetEvent(THANDLE(AEvent));
 end;
 
 procedure intRTLEventWaitFor(AEvent: PRTLEvent);
-CONST
+const
   INFINITE=-1;
 begin
   WaitForSingleObject(THANDLE(AEvent), INFINITE);
 end;
 
+procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
+begin
+  WaitForSingleObject(THANDLE(AEvent), timeout);
+end;
 
 
 Var
@@ -447,8 +459,10 @@ begin
     RTLEventCreate         :=@intRTLEventCreate;
     RTLEventDestroy        :=@intRTLEventDestroy;
     RTLEventSetEvent       :=@intRTLEventSetEvent;
+    RTLEventResetEvent     :=@intRTLEventResetEvent;
     RTLEventStartWait      :=@intRTLEventStartWait;
     RTLEventWaitFor        :=@intRTLEventWaitFor;
+    RTLEventWaitForTimeout :=@intRTLEventWaitForTimeout;
     end;
   SetThreadManager(WinThreadManager);
   InitHeapMutexes;
@@ -458,7 +472,14 @@ end;
 
 {
   $Log$
-  Revision 1.2  2005-02-08 16:28:27  peter
+  Revision 1.3  2005-04-09 17:26:08  florian
+    + classes.mainthreadid is set now
+    + rtleventresetevent
+    + rtleventwairfor with timeout
+    + checksynchronize with timeout
+    * race condition in synchronize fixed
+
+  Revision 1.2  2005/02/08 16:28:27  peter
   pulseevent -> setevent
 
   Revision 1.1  2005/02/06 13:06:20  peter