* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows

Check work: ask Neli.

rtl/darwin/pthread.inc

@@ -32,6 +32,8 @@ CONST PTHREAD_EXPLICIT_SCHED       = 0;
     __destr_func_t       = procedure (p :pointer);cdecl;
     __startroutine_t     = function (p :pointer):pointer;cdecl;
     ppthread_mutexattr_t = ^pthread_mutexattr_t;
+    ppthread_cond_t      = ^pthread_cond_t;
+    ppthread_condattr_t  = ^pthread_condattr_t;
 
     sem_t       = cint;
     psem_t	    = ^sem_t;
@@ -55,6 +57,10 @@ function  pthread_mutex_unlock  (p:ppthread_mutexattr_t):cint; cdecl;external 'c
 function  pthread_cancel(_para1:pthread_t):cint;cdecl;external 'c';
 function  pthread_detach(_para1:pthread_t):cint;cdecl;external 'c';
 function  pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external 'c';
+function  pthread_cond_destroy(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_destroy';
+function  pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):cint;cdecl;external  'c' name 'pthread_cond_init';
+function  pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_signal';
+function  pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external 'c' name 'pthread_cond_wait';
 
 function sem_init(__sem:Psem_t; __pshared:cint;__value:cuint):cint;cdecl; external 'c' name 'sem_init';
 function sem_destroy(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_destroy';
@@ -72,7 +78,11 @@ function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cin
 
 {
   $Log$
-  Revision 1.5  2004-09-09 20:29:06  jonas
+  Revision 1.6  2004-12-22 21:29:24  marco
+   * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
+  	Check work: ask Neli.
+
+  Revision 1.5  2004/09/09 20:29:06  jonas
     * fixed definition of pthread_mutex_t for non-linux targets (and for
       linux as well, actually).
     * base libpthread definitions are now in ptypes.inc, included in unixtype

rtl/freebsd/Makefile

@@ -232,11 +232,11 @@ UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
 ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
 SYSTEMUNIT=system
-override FPCOPT+=-dNOMOUSE
+override FPCOPT+=-dNOGPM
 loaders+=gprt0
 else
 SYSTEMUNIT=sysbsd
-override FPCOPT+=-dUNIX -dNOMOUSE
+override FPCOPT+=-dUNIX -dNOGPM
 endif
 ifdef RELEASE
 override FPCOPT+=-Ur

rtl/freebsd/pthread.inc

@@ -29,6 +29,9 @@ CONST PTHREAD_EXPLICIT_SCHED       = 0;
     ppthread_key_t  = ^pthread_key_t;
     ppthread_mutex_t= ^pthread_mutex_t;
     ppthread_attr_t = ^pthread_attr_t;
+    ppthread_cond_t            = ^pthread_cond_t;
+    ppthread_condattr_t        = ^pthread_condattr_t;
+
     __destr_func_t  = procedure (p :pointer);cdecl;
     __startroutine_t= function (p :pointer):pointer;cdecl;
     ppthread_mutexattr_t = ^pthread_mutexattr_t;
@@ -56,6 +59,10 @@ function  pthread_mutex_unlock  (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_cancel(_para1:pthread_t):cint;cdecl;external;
 function  pthread_detach(_para1:pthread_t):cint;cdecl;external;
 function  pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external;
+function pthread_cond_destroy(_para1:Ppthread_cond_t):cint;cdecl;external;
+function pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):cint;cdecl;external;
+function pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external;
+function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external;
 
 function sem_init(__sem:Psem_t; __pshared:cint;__value:dword):cint;cdecl; external;
 function sem_destroy(__sem:Psem_t):cint;cdecl;external ;
@@ -74,7 +81,11 @@ function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cin
 
 {
   $Log$
-  Revision 1.5  2004-09-10 15:15:45  marco
+  Revision 1.6  2004-12-22 21:29:24  marco
+   * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
+  	Check work: ask Neli.
+
+  Revision 1.5  2004/09/10 15:15:45  marco
    * small glitch fixes
 
   Revision 1.4  2004/09/09 20:29:06  jonas

rtl/inc/thread.inc

@@ -229,6 +229,31 @@ begin
  result:=currenttm.basiceventWaitFor(Timeout,state);
 end;
 
+function  RTLEventCreate :PRTLEvent;
+
+begin
+  result:=currenttm.rtleventcreate;
+end;
+
+
+procedure RTLeventdestroy(state:pRTLEvent);
+
+begin
+  currenttm.rtleventdestroy(state);
+end;
+
+procedure RTLeventSetEvent(state:pRTLEvent);
+
+begin
+  currenttm.rtleventsetEvent(state);
+end;
+
+procedure RTLeventWaitFor(state:pRTLEvent);
+
+begin
+  currenttm.rtleventWaitFor(state);
+end;
+
 
 { ---------------------------------------------------------------------
     ThreadManager which gives run-time error. Use if no thread support.
@@ -354,6 +379,31 @@ begin
   NoThreadError;
 end;
 
+function  NORTLEventCreate :PRTLEvent;
+
+begin
+  NoThreadError;
+end;
+
+procedure NORTLeventdestroy(state:pRTLEvent);
+
+begin
+  NoThreadError;
+end;
+
+procedure NORTLeventSetEvent(state:pRTLEvent);
+
+begin
+  NoThreadError;
+end;
+
+procedure NORTLeventWaitFor(state:pRTLEvent);
+
+begin
+  NoThreadError;
+end;
+
+
 Var
   NoThreadManager : TThreadManager;
 
@@ -387,6 +437,10 @@ begin
     basiceventResetEvent   :=@NobasiceventResetEvent;
     basiceventSetEvent     :=@NobasiceventSetEvent;
     basiceventWaitFor      :=@NobasiceventWaitFor;
+    rtlEventCreate         :=@NortlEventCreate;
+    rtleventdestroy        :=@Nortleventdestroy;
+    rtleventSetEvent       :=@NortleventSetEvent;
+    rtleventWaitFor        :=@NortleventWaitFor;
 
     end;
   SetThreadManager(NoThreadManager);
@@ -395,7 +449,11 @@ end;
 
 {
   $Log$
-  Revision 1.12  2004-09-19 18:55:30  armin
+  Revision 1.13  2004-12-22 21:29:24  marco
+   * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
+  	Check work: ask Neli.
+
+  Revision 1.12  2004/09/19 18:55:30  armin
   * added define DISABLE_NO_THREAD_MANAGER to avoid warnings if thread manager is always present
 
   Revision 1.11  2004/05/23 20:26:20  marco

rtl/inc/threadh.inc

@@ -21,6 +21,7 @@ const
 
 type
   PEventState = pointer;
+  PRTLEvent   = pointer;   // Windows=thandle, other=pointer to record.
   TThreadFunc = function(parameter : pointer) : ptrint;
 
   // Function prototypes for TThreadManager Record.
@@ -41,6 +42,8 @@ type
   TBasicEventHandler	    = procedure(state:peventstate);
   TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
   TBasicEventCreateHandler  = function (EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
+  TRTLEventHandler	    = procedure(AEvent:PRTLEvent);
+  TRTLCreateEventHandler    = function:PRTLEvent;	
 
   // TThreadManager interface.
   TThreadManager = Record
@@ -64,11 +67,15 @@ type
     RelocateThreadVar      : TRelocateThreadVarHandler;
     AllocateThreadVars     : TAllocateThreadVarsHandler;
     ReleaseThreadVars      : TReleaseThreadVarsHandler;
-    BasicEventCreate	   : TBasicEventCreateHandler;
+    BasicEventCreate	   : TBasicEventCreateHandler;      // left in for a while.
-    BasicEventDestroy	   : TBasicEventHandler;
+    BasicEventDestroy	   : TBasicEventHandler;	    // we might need BasicEvent
-    BasicEventResetEvent   : TBasicEventHandler;
+    BasicEventResetEvent   : TBasicEventHandler;	    // for a real TEvent	
     BasicEventSetEvent     : TBasicEventHandler;
     BasiceventWaitFOr	   : TBasicEventWaitForHandler;
+    RTLEventCreate	   : TRTLCreateEventHandler;
+    RTLEventDestroy	   : TRTLEventHandler;
+    RTLEventSetEvent       : TRTLEventHandler;
+    RTLeventWaitFOr	   : TRTLEventHandler;
   end;
 
 {*****************************************************************************
@@ -143,9 +150,18 @@ procedure basiceventResetEvent(state:peventstate);
 procedure basiceventSetEvent(state:peventstate);
 function  basiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
 
+function  RTLEventCreate :PRTLEvent;
+procedure RTLeventdestroy(state:pRTLEvent);
+procedure RTLeventSetEvent(state:pRTLEvent);
+procedure RTLeventWaitFor(state:pRTLEvent);
+
 {
   $Log$
-  Revision 1.20  2004-12-12 14:30:27  peter
+  Revision 1.21  2004-12-22 21:29:24  marco
+   * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
+  	Check work: ask Neli.
+
+  Revision 1.20  2004/12/12 14:30:27  peter
     * x86_64 updates
 
   Revision 1.19  2004/09/19 18:55:30  armin

rtl/unix/cthreads.pp

@@ -52,6 +52,12 @@ Uses
 { Include OS specific parts. }
 {$i pthread.inc}
 
+Type  PINTRTLEvent = ^TINTRTLEvent;
+      TINTRTLEvent = record
+        condvar: pthread_cond_t;
+        mutex: pthread_mutex_t;
+       end;
+
 {*****************************************************************************
                              Threadvar support
 *****************************************************************************}
@@ -516,6 +522,48 @@ begin
     end;
 end;
 
+function intRTLEventCreate: PRTLEvent;
+
+var p:pintrtlevent;
+
+begin
+  new(p);
+  pthread_cond_init(@p^.condvar, nil);
+  pthread_mutex_init(@p^.mutex, nil);
+  result:=PRTLEVENT(p);
+end;
+
+procedure intRTLEventDestroy(AEvent: PRTLEvent);
+
+var p:pintrtlevent;
+
+begin
+  p:=pintrtlevent(aevent);
+  pthread_cond_destroy(@p^.condvar);
+  pthread_mutex_destroy(@p^.mutex);
+  dispose(p);
+end;
+
+procedure intRTLEventSetEvent(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+  p:=pintrtlevent(aevent);
+  pthread_mutex_lock(@p^.mutex);
+  pthread_cond_signal(@p^.condvar);
+  pthread_mutex_unlock(@p^.mutex);
+end;
+
+procedure intRTLEventWaitFor(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+  p:=pintrtlevent(aevent);  
+  pthread_mutex_lock(@p^.mutex);
+  pthread_cond_wait(@p^.condvar, @p^.mutex);
+  pthread_mutex_unlock(@p^.mutex);
+end;
+
 Var
   CThreadManager : TThreadManager;
 
@@ -551,6 +599,10 @@ begin
     BasicEventResetEvent   :=@intBasicEventResetEvent;
     BasicEventSetEvent     :=@intBasicEventSetEvent;
     BasiceventWaitFor      :=@intBasiceventWaitFor;
+    rtlEventCreate         :=@intrtlEventCreate;       
+    rtlEventDestroy        :=@intrtlEventDestroy;
+    rtlEventSetEvent       :=@intrtlEventSetEvent;
+    rtleventWaitFor        :=@intrtleventWaitFor;
     end;
   SetThreadManager(CThreadManager);
   InitHeapMutexes;
@@ -561,7 +613,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.14  2004-12-12 14:30:27  peter
+  Revision 1.15  2004-12-22 21:29:24  marco
+   * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
+  	Check work: ask Neli.
+
+  Revision 1.14  2004/12/12 14:30:27  peter
     * x86_64 updates
 
   Revision 1.13  2004/10/14 17:39:33  florian

rtl/win32/systhrds.pp

@@ -88,6 +88,7 @@ function  CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialSt
 function  CloseHandle(hObject:CARDINAL):LONGBOOL; external 'kernel32' name 'CloseHandle';
 function  ResetEvent(hEvent:CARDINAL):LONGBOOL; external 'kernel32' name 'ResetEvent';
 function  SetEvent(hEvent:CARDINAL):LONGBOOL; external 'kernel32' name 'SetEvent';
+function PulseEvent(hEvent:THANDLE):CARDINAL {WINBOOL}; external 'kernel32' name 'PulseEvent';
 
 CONST
    WAIT_OBJECT_0 = 0;
@@ -419,6 +420,30 @@ begin
   end;
 end;
 
+function intRTLEventCreate: PRTLEvent;
+begin
+  Result := PRTLEVENT(CreateEvent(nil, false, false, nil));
+end;
+
+procedure intRTLEventDestroy(AEvent: PRTLEvent);
+begin
+  CloseHandle(THANDLE(AEvent));
+end;
+
+procedure intRTLEventSetEvent(AEvent: PRTLEvent);
+begin
+  PulseEvent(THANDLE(AEvent));
+end;
+
+CONST INFINITE=-1;
+
+procedure intRTLEventWaitFor(AEvent: PRTLEvent);
+begin
+  WaitForSingleObject(THANDLE(AEvent), INFINITE);
+end;
+
+
+
 Var
   WinThreadManager : TThreadManager; 
 
@@ -454,6 +479,10 @@ begin
     BasicEventResetEvent   :=@intBasicEventResetEvent;
     BasicEventSetEvent     :=@intBasicEventSetEvent;
     BasiceventWaitFor      :=@intBasiceventWaitFor;
+    RTLEventCreate       :=@intRTLEventCreate;
+    RTLEventDestroy      :=@intRTLEventDestroy;
+    RTLEventSetEvent     :=@intRTLEventSetEvent;
+    RTLeventWaitFor      :=@intRTLeventWaitFor;
     end;
   SetThreadManager(WinThreadManager);
   InitHeapMutexes;
@@ -465,7 +494,11 @@ end.
 
 {
   $Log$
-  Revision 1.11  2004-05-23 15:30:13  marco
+  Revision 1.12  2004-12-22 21:29:24  marco
+   * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
+  	Check work: ask Neli.
+
+  Revision 1.11  2004/05/23 15:30:13  marco
    * first try
 
   Revision 1.10  2004/01/21 14:15:42  florian