* adds semaphore support to ThreadManager, removes pipe hack from non linux

  + adds SemaphoreInit, SemaphorePost, SemaphoreWait and SemaphoreDestroy to TM

git-svn-id: trunk@4900 -

rtl/darwin/tthread.inc

@@ -63,64 +63,9 @@
 {$define WRITE_DEBUG := //}      // just comment out those lines
 {$ENDIF}
 
-// ========== semaphore stuff ==========
-{
-  I don't like this. It eats up 2 filedescriptors for each thread,
-  and those are a limited resource. If you have a server programm
-  handling client connections (one per thread) it will not be able
-  to handle many if we use 2 fds already for internal structures.
-  However, right now I don't see a better option unless some sem_*
-  functions are added to systhrds.
-  I encapsulated all used functions here to make it easier to
-  change them completely.
-}
-
-function SemaphoreInit: Pointer;
-begin
-  SemaphoreInit := GetMem(SizeOf(TFilDes));
-  fppipe(PFilDes(SemaphoreInit)^);
-  WRITE_DEBUG('Opened file descriptor ',PFilDes(SemaphoreInit)^[0]);
-end;
-
-procedure SemaphoreWait(const FSem: Pointer);
-var
-  b: byte;
-begin
-  WRITE_DEBUG('Waiting for file descriptor ',PFilDes(FSem)^[0]);
-  repeat
-    if fpread(PFilDes(FSem)^[0], b, 1) = -1 then
-      WRITE_DEBUG('Error reading from semaphore ',PFilDes(FSem)^[0],' error = ',fpgeterrno);
-  until fpgeterrno <> ESysEIntr;
-end;
-
-procedure SemaphorePost(const FSem: Pointer);
-{$ifdef VER2_0}
-var
-  b : byte;
-{$endif}
-begin
-  WRITE_DEBUG('Activating file descriptor ',PFilDes(FSem)^[0]);
-{$ifdef VER2_0}
-  b:=0;
-  fpwrite(PFilDes(FSem)^[1], b, 1);
-{$else}
-  if fpwrite(PFilDes(FSem)^[1], #0, 1) = -1 then
-    WRITE_DEBUG('Error writing file descriptor ',PFilDes(FSem)^[0],' error = ',fpgeterrno);
-{$endif}
-end;
-
-procedure SemaphoreDestroy(const FSem: Pointer);
-begin
-  WRITE_DEBUG('Closing file descriptor ',PFilDes(FSem)^[0]);
-  fpclose(PFilDes(FSem)^[0]);
-  fpclose(PFilDes(FSem)^[1]);
-  FreeMemory(FSem);
-end;
-
-// =========== semaphore end ===========
-
 var
   ThreadsInited: boolean = false;
+  CurrentTM: TThreadManager;
 const
   // stupid, considering its not even implemented...
   Priorities: array [TThreadPriority] of Integer =
@@ -128,6 +73,7 @@ const
 
 procedure InitThreads;
 begin
+  GetThreadManager(CurrentTM);
   if not ThreadsInited then begin
     ThreadsInited := true;
   end;
@@ -148,7 +94,7 @@ begin
   try
     if LThread.FInitialSuspended then
       begin
-        SemaphoreWait(LThread.FSem);
+        CurrentTM.SemaphoreWait(LThread.FSem);
         if not(LThread.FTerminated) then
           begin
             if not LThread.FSuspended then
@@ -196,7 +142,7 @@ begin
   // via BeginThread and creates the first TThread Object in there!
   InitThreads;
   inherited Create;
-  FSem := SemaphoreInit;
+  FSem := CurrentTM.SemaphoreInit;
   FSuspended := CreateSuspended;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
@@ -225,7 +171,7 @@ begin
     end;
   FFatalException.Free;
   FFatalException := nil;
-  SemaphoreDestroy(FSem);
+  CurrentTM.SemaphoreDestroy(FSem);
   { threadvars have been released by cthreads.ThreadMain -> DoneThread }
   inherited Destroy;
 end;
@@ -244,7 +190,7 @@ begin
   if not FSuspended then begin
     if FThreadID = GetCurrentThreadID then begin
       FSuspended := true;
-      SemaphoreWait(FSem);
+      CurrentTM.SemaphoreWait(FSem);
     end else begin
       FSuspendedExternal := true;
       SuspendThread(FHandle);
@@ -258,7 +204,7 @@ begin
   if (not FSuspendedExternal) then begin
     if FSuspended then begin
       FSuspended := False;
-      SemaphorePost(FSem);
+      CurrentTM.SemaphorePost(FSem);
     end;
   end else begin
     FSuspendedExternal := false;

rtl/freebsd/tthread.inc

@@ -54,56 +54,19 @@
   Johannes Berg <[email protected]>, Sunday, November 16 2003
 }
 
-// ========== semaphore stuff ==========
-{
-  I don't like this. It eats up 2 filedescriptors for each thread,
-  and those are a limited resource. If you have a server programm
-  handling client connections (one per thread) it will not be able
-  to handle many if we use 2 fds already for internal structures.
-  However, right now I don't see a better option unless some sem_*
-  functions are added to systhrds.
-  I encapsulated all used functions here to make it easier to
-  change them completely.
-}
-
-function SemaphoreInit: Pointer;
-begin
-  SemaphoreInit := GetMem(SizeOf(TFilDes));
-  fppipe(PFilDes(SemaphoreInit)^);
-end;
-
-procedure SemaphoreWait(const FSem: Pointer);
-var
-  b: byte;
-begin
-  fpread(PFilDes(FSem)^[0], b, 1);
-end;
-
-procedure SemaphorePost(const FSem: Pointer);
-{$ifdef VER2_0}
-var
-  b : byte;
-{$endif}
-begin
-{$ifdef VER2_0}
-  b:=0;
-  fpwrite(PFilDes(FSem)^[1], b, 1);
-{$else}
-  fpwrite(PFilDes(FSem)^[1], #0, 1);
-{$endif}
-end;
-
-procedure SemaphoreDestroy(const FSem: Pointer);
-begin
-  fpclose(PFilDes(FSem)^[0]);
-  fpclose(PFilDes(FSem)^[1]);
-  FreeMemory(FSem);
-end;
-
-// =========== semaphore end ===========
+{ ok, so this is a hack, but it works nicely. Just never use
+  a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
 
 var
   ThreadsInited: boolean = false;
+  CurrentTM: TThreadManager;
+  
 const
   // stupid, considering its not even implemented...
   Priorities: array [TThreadPriority] of Integer =
@@ -111,6 +74,7 @@ const
 
 procedure InitThreads;
 begin
+  GetThreadManager(CurrentTM);
   if not ThreadsInited then
     ThreadsInited := true;
 end;
@@ -120,15 +84,6 @@ begin
   ThreadsInited := false;
 end;
 
-{ ok, so this is a hack, but it works nicely. Just never use
-  a multiline argument with WRITE_DEBUG! }
-{$MACRO ON}
-{$IFDEF DEBUG_MT}
-{$define WRITE_DEBUG := writeln} // actually write something
-{$ELSE}
-{$define WRITE_DEBUG := //}      // just comment out those lines
-{$ENDIF}
-
 function ThreadFunc(parameter: Pointer): LongInt;
 var
   LThread: TThread;
@@ -139,7 +94,7 @@ begin
   WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
   try
     if LThread.FInitialSuspended then begin
-      SemaphoreWait(LThread.FSem);
+      CurrentTM.SemaphoreWait(LThread.FSem);
       if not LThread.FSuspended then begin
         LThread.FInitialSuspended := false;
         WRITE_DEBUG('going into LThread.Execute');
@@ -180,7 +135,7 @@ begin
   // via BeginThread and creates the first TThread Object in there!
   InitThreads;
   inherited Create;
-  FSem := SemaphoreInit;
+  FSem := CurrentTM.SemaphoreInit;
   FSuspended := CreateSuspended;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
@@ -205,12 +160,12 @@ begin
   end;
   if (FInitialSuspended) then begin
     // thread was created suspended but never woken up.
-    SemaphorePost(FSem);
+    CurrentTM.SemaphorePost(FSem);
     WaitFor;
   end;
   FFatalException.Free;
   FFatalException := nil;
-  SemaphoreDestroy(FSem);
+  CurrentTM.SemaphoreDestroy(FSem);
   inherited Destroy;
 end;
 
@@ -228,7 +183,7 @@ begin
   if not FSuspended then begin
     if FThreadID = GetCurrentThreadID then begin
       FSuspended := true;
-      SemaphoreWait(FSem);
+      CurrentTM.SemaphoreWait(FSem);
     end else begin
       FSuspendedExternal := true;
       SuspendThread(FHandle);
@@ -242,7 +197,7 @@ begin
   if (not FSuspendedExternal) then begin
     if FSuspended then begin
       FSuspended := False;
-      SemaphorePost(FSem);
+      CurrentTM.SemaphorePost(FSem);
     end;
   end else begin
     FSuspendedExternal := false;

rtl/inc/thread.inc

@@ -449,6 +449,25 @@ procedure NORTLeventsync(m:trtlmethod;p:tprocedure);
     NoThreadError;
   end;
 
+function NoSemaphoreInit: Pointer;
+begin
+  NoThreadError;
+end;
+
+procedure NoSemaphoreWait(const FSem: Pointer);
+begin
+  NoThreadError;
+end;
+
+procedure NoSemaphorePost(const FSem: Pointer);
+begin
+  NoThreadError;
+end;
+
+procedure NoSemaphoreDestroy(const FSem: Pointer);
+begin
+  NoThreadError;
+end;
 
 Var
   NoThreadManager : TThreadManager;
@@ -490,6 +509,11 @@ begin
     rtleventWaitFor        :=@NortleventWaitFor;
     rtleventsync           :=@Nortleventsync;
     rtleventwaitfortimeout :=@NortleventWaitForTimeout;
+    // semaphores stuff
+    SemaphoreInit          :=@NoSemaphoreInit;
+    SemaphoreDestroy       :=@NoSemaphoreDestroy;
+    SemaphoreWait          :=@NoSemaphoreWait;
+    SemaphorePost          :=@NoSemaphorePost;
     end;
   SetThreadManager(NoThreadManager);
 end;

rtl/inc/threadh.inc

@@ -46,6 +46,11 @@ type
   TRTLEventHandlerTimeout   = procedure(AEvent:PRTLEvent;timeout : longint);
   TRTLCreateEventHandler    = function:PRTLEvent;
   TRTLEventSyncHandler      = procedure (m:trtlmethod;p:tprocedure);
+  // semaphores stuff
+  TSempahoreInitHandler     = function: Pointer;
+  TSemaphoreDestroyHandler  = procedure (const sem: Pointer);
+  TSemaphorePostHandler     = procedure (const sem: Pointer);
+  TSemaphoreWaitHandler     = procedure (const sem: Pointer);
 
   // TThreadManager interface.
   TThreadManager = Record
@@ -82,6 +87,11 @@ type
     RTLEventWaitFor        : TRTLEventHandler;
     RTLEventSync           : TRTLEventSyncHandler;
     RTLEventWaitForTimeout : TRTLEventHandlerTimeout;
+    // semaphores stuff
+    SemaphoreInit          : TSempahoreInitHandler;
+    SemaphoreDestroy       : TSemaphoreDestroyHandler;
+    SemaphorePost          : TSemaphorePostHandler;
+    SemaphoreWait          : TSemaphoreWaitHandler;
   end;
 
 {*****************************************************************************

rtl/netbsd/tthread.inc

@@ -54,47 +54,19 @@
   Johannes Berg <[email protected]>, Sunday, November 16 2003
 }
 
-// ========== semaphore stuff ==========
-{
-  I don't like this. It eats up 2 filedescriptors for each thread,
-  and those are a limited resource. If you have a server programm
-  handling client connections (one per thread) it will not be able
-  to handle many if we use 2 fds already for internal structures.
-  However, right now I don't see a better option unless some sem_*
-  functions are added to systhrds.
-  I encapsulated all used functions here to make it easier to
-  change them completely.
-}
-
-function SemaphoreInit: Pointer;
-begin
-  SemaphoreInit := GetMem(SizeOf(TFilDes));
-  fppipe(PFilDes(SemaphoreInit)^);
-end;
-
-procedure SemaphoreWait(const FSem: Pointer);
-var
-  b: byte;
-begin
-  fpread(PFilDes(FSem)^[0], b, 1);
-end;
-
-procedure SemaphorePost(const FSem: Pointer);
-begin
-  fpwrite(PFilDes(FSem)^[1], #0, 1);
-end;
-
-procedure SemaphoreDestroy(const FSem: Pointer);
-begin
-  fpclose(PFilDes(FSem)^[0]);
-  fpclose(PFilDes(FSem)^[1]);
-  FreeMemory(FSem);
-end;
-
-// =========== semaphore end ===========
+{ ok, so this is a hack, but it works nicely. Just never use
+  a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
 
 var
   ThreadsInited: boolean = false;
+  CurrentTM: TThreadManager;
+  
 const
   // stupid, considering its not even implemented...
   Priorities: array [TThreadPriority] of Integer =
@@ -102,9 +74,9 @@ const
 
 procedure InitThreads;
 begin
-  if not ThreadsInited then begin
+  GetThreadManager(CurrentTM);
+  if not ThreadsInited then
     ThreadsInited := true;
-  end;
 end;
 
 procedure DoneThreads;
@@ -112,16 +84,7 @@ begin
   ThreadsInited := false;
 end;
 
-{ ok, so this is a hack, but it works nicely. Just never use
-  a multiline argument with WRITE_DEBUG! }
-{$MACRO ON}
-{$IFDEF DEBUG_MT}
-{$define WRITE_DEBUG := writeln} // actually write something
-{$ELSE}
-{$define WRITE_DEBUG := //}      // just comment out those lines
-{$ENDIF}
-
-function ThreadFunc(parameter: Pointer): LongInt; cdecl;
+function ThreadFunc(parameter: Pointer): LongInt;
 var
   LThread: TThread;
   c: char;
@@ -131,7 +94,7 @@ begin
   WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
   try
     if LThread.FInitialSuspended then begin
-      SemaphoreWait(LThread.FSem);
+      CurrentTM.SemaphoreWait(LThread.FSem);
       if not LThread.FSuspended then begin
         LThread.FInitialSuspended := false;
         WRITE_DEBUG('going into LThread.Execute');
@@ -172,13 +135,13 @@ begin
   // via BeginThread and creates the first TThread Object in there!
   InitThreads;
   inherited Create;
-  FSem := SemaphoreInit;
+  FSem := CurrentTM.SemaphoreInit;
   FSuspended := CreateSuspended;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
-  WRITE_DEBUG('creating thread, self = ',longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
+  WRITE_DEBUG('creating thread, self = ',PtrInt(self));
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID,StackSize);
   WRITE_DEBUG('TThread.Create done');
 end;
 
@@ -197,12 +160,12 @@ begin
   end;
   if (FInitialSuspended) then begin
     // thread was created suspended but never woken up.
-    SemaphorePost(FSem);
+    CurrentTM.SemaphorePost(FSem);
     WaitFor;
   end;
   FFatalException.Free;
   FFatalException := nil;
-  SemaphoreDestroy(FSem);
+  CurrentTM.SemaphoreDestroy(FSem);
   inherited Destroy;
 end;
 
@@ -220,7 +183,7 @@ begin
   if not FSuspended then begin
     if FThreadID = GetCurrentThreadID then begin
       FSuspended := true;
-      SemaphoreWait(FSem);
+      CurrentTM.SemaphoreWait(FSem);
     end else begin
       FSuspendedExternal := true;
       SuspendThread(FHandle);
@@ -234,7 +197,7 @@ begin
   if (not FSuspendedExternal) then begin
     if FSuspended then begin
       FSuspended := False;
-      SemaphorePost(FSem);
+      CurrentTM.SemaphorePost(FSem);
     end;
   end else begin
     FSuspendedExternal := false;

rtl/openbsd/tthread.inc

@@ -14,7 +14,6 @@
 }
 
 
-
 {
   What follows, is a short description on my implementation of TThread.
   Most information can also be found by reading the source and accompanying
@@ -55,56 +54,19 @@
   Johannes Berg <[email protected]>, Sunday, November 16 2003
 }
 
-// ========== semaphore stuff ==========
-{
-  I don't like this. It eats up 2 filedescriptors for each thread,
-  and those are a limited resource. If you have a server programm
-  handling client connections (one per thread) it will not be able
-  to handle many if we use 2 fds already for internal structures.
-  However, right now I don't see a better option unless some sem_*
-  functions are added to systhrds.
-  I encapsulated all used functions here to make it easier to
-  change them completely.
-}
-
-function SemaphoreInit: Pointer;
-begin
-  SemaphoreInit := GetMem(SizeOf(TFilDes));
-  fppipe(PFilDes(SemaphoreInit)^);
-end;
-
-procedure SemaphoreWait(const FSem: Pointer);
-var
-  b: byte;
-begin
-  fpread(PFilDes(FSem)^[0], b, 1);
-end;
-
-procedure SemaphorePost(const FSem: Pointer);
-{$ifdef VER2_0}
-var
-  b : byte;
-{$endif}
-begin
-{$ifdef VER2_0}
-  b:=0;
-  fpwrite(PFilDes(FSem)^[1], b, 1);
-{$else}
-  fpwrite(PFilDes(FSem)^[1], #0, 1);
-{$endif}
-end;
-
-procedure SemaphoreDestroy(const FSem: Pointer);
-begin
-  fpclose(PFilDes(FSem)^[0]);
-  fpclose(PFilDes(FSem)^[1]);
-  FreeMemory(FSem);
-end;
-
-// =========== semaphore end ===========
+{ ok, so this is a hack, but it works nicely. Just never use
+  a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
 
 var
   ThreadsInited: boolean = false;
+  CurrentTM: TThreadManager;
+  
 const
   // stupid, considering its not even implemented...
   Priorities: array [TThreadPriority] of Integer =
@@ -112,9 +74,9 @@ const
 
 procedure InitThreads;
 begin
-  if not ThreadsInited then begin
+  GetThreadManager(CurrentTM);
+  if not ThreadsInited then
     ThreadsInited := true;
-  end;
 end;
 
 procedure DoneThreads;
@@ -122,16 +84,7 @@ begin
   ThreadsInited := false;
 end;
 
-{ ok, so this is a hack, but it works nicely. Just never use
-  a multiline argument with WRITE_DEBUG! }
-{$MACRO ON}
-{$IFDEF DEBUG_MT}
-{$define WRITE_DEBUG := writeln} // actually write something
-{$ELSE}
-{$define WRITE_DEBUG := //}      // just comment out those lines
-{$ENDIF}
-
-function ThreadFunc(parameter: Pointer): LongInt; cdecl;
+function ThreadFunc(parameter: Pointer): LongInt;
 var
   LThread: TThread;
   c: char;
@@ -141,7 +94,7 @@ begin
   WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
   try
     if LThread.FInitialSuspended then begin
-      SemaphoreWait(LThread.FSem);
+      CurrentTM.SemaphoreWait(LThread.FSem);
       if not LThread.FSuspended then begin
         LThread.FInitialSuspended := false;
         WRITE_DEBUG('going into LThread.Execute');
@@ -175,19 +128,20 @@ begin
 end;
 
 { TThread }
-constructor TThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt = DefaultStackSize);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: SizeUInt = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!
   InitThreads;
   inherited Create;
-  FSem := SemaphoreInit;
+  FSem := CurrentTM.SemaphoreInit;
   FSuspended := CreateSuspended;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
-  WRITE_DEBUG('creating thread, self = ',longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
+  WRITE_DEBUG('creating thread, self = ',PtrInt(self));
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID,StackSize);
   WRITE_DEBUG('TThread.Create done');
 end;
 
@@ -206,12 +160,12 @@ begin
   end;
   if (FInitialSuspended) then begin
     // thread was created suspended but never woken up.
-    SemaphorePost(FSem);
+    CurrentTM.SemaphorePost(FSem);
     WaitFor;
   end;
   FFatalException.Free;
   FFatalException := nil;
-  SemaphoreDestroy(FSem);
+  CurrentTM.SemaphoreDestroy(FSem);
   inherited Destroy;
 end;
 
@@ -229,7 +183,7 @@ begin
   if not FSuspended then begin
     if FThreadID = GetCurrentThreadID then begin
       FSuspended := true;
-      SemaphoreWait(FSem);
+      CurrentTM.SemaphoreWait(FSem);
     end else begin
       FSuspendedExternal := true;
       SuspendThread(FHandle);
@@ -243,7 +197,7 @@ begin
   if (not FSuspendedExternal) then begin
     if FSuspended then begin
       FSuspended := False;
-      SemaphorePost(FSem);
+      CurrentTM.SemaphorePost(FSem);
     end;
   end else begin
     FSuspendedExternal := false;

rtl/solaris/tthread.inc

@@ -1,17 +1,17 @@
 {
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 by Peter Vreman
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 by Marco van de Voort
+   member of the Free Pascal development team.
 
-    Darwin TThread implementation
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
 
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
+   TThread implementation old (1.0) and new (pthreads) style
 
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
 
 
 {
@@ -63,64 +63,10 @@
 {$define WRITE_DEBUG := //}      // just comment out those lines
 {$ENDIF}
 
-// ========== semaphore stuff ==========
-{
-  I don't like this. It eats up 2 filedescriptors for each thread,
-  and those are a limited resource. If you have a server programm
-  handling client connections (one per thread) it will not be able
-  to handle many if we use 2 fds already for internal structures.
-  However, right now I don't see a better option unless some sem_*
-  functions are added to systhrds.
-  I encapsulated all used functions here to make it easier to
-  change them completely.
-}
-
-function SemaphoreInit: Pointer;
-begin
-  SemaphoreInit := GetMem(SizeOf(TFilDes));
-  fppipe(PFilDes(SemaphoreInit)^);
-  WRITE_DEBUG('Opened file descriptor ',PFilDes(SemaphoreInit)^[0]);
-end;
-
-procedure SemaphoreWait(const FSem: Pointer);
-var
-  b: byte;
-begin
-  WRITE_DEBUG('Waiting for file descriptor ',PFilDes(FSem)^[0]);
-  repeat
-    if fpread(PFilDes(FSem)^[0], b, 1) = -1 then
-      WRITE_DEBUG('Error reading from semaphore ',PFilDes(FSem)^[0],' error = ',fpgeterrno);
-  until fpgeterrno <> ESysEIntr;
-end;
-
-procedure SemaphorePost(const FSem: Pointer);
-{$ifdef VER2_0}
-var
-  b : byte;
-{$endif}
-begin
-  WRITE_DEBUG('Activating file descriptor ',PFilDes(FSem)^[0]);
-{$ifdef VER2_0}
-  b:=0;
-  fpwrite(PFilDes(FSem)^[1], b, 1);
-{$else}
-  if fpwrite(PFilDes(FSem)^[1], #0, 1) = -1 then
-    WRITE_DEBUG('Error writing file descriptor ',PFilDes(FSem)^[0],' error = ',fpgeterrno);
-{$endif}
-end;
-
-procedure SemaphoreDestroy(const FSem: Pointer);
-begin
-  WRITE_DEBUG('Closing file descriptor ',PFilDes(FSem)^[0]);
-  fpclose(PFilDes(FSem)^[0]);
-  fpclose(PFilDes(FSem)^[1]);
-  FreeMemory(FSem);
-end;
-
-// =========== semaphore end ===========
-
 var
   ThreadsInited: boolean = false;
+  CurrentTM: TThreadManager;
+  
 const
   // stupid, considering its not even implemented...
   Priorities: array [TThreadPriority] of Integer =
@@ -128,9 +74,9 @@ const
 
 procedure InitThreads;
 begin
-  if not ThreadsInited then begin
+  GetThreadManager(CurrentTM);
+  if not ThreadsInited then
     ThreadsInited := true;
-  end;
 end;
 
 procedure DoneThreads;
@@ -141,13 +87,14 @@ end;
 function ThreadFunc(parameter: Pointer): LongInt;
 var
   LThread: TThread;
+  c: char;
 begin
   WRITE_DEBUG('ThreadFunc is here...');
   LThread := TThread(parameter);
   WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
   try
     if LThread.FInitialSuspended then begin
-      SemaphoreWait(LThread.FSem);
+      CurrentTM.SemaphoreWait(LThread.FSem);
       if not LThread.FSuspended then begin
         LThread.FInitialSuspended := false;
         WRITE_DEBUG('going into LThread.Execute');
@@ -188,13 +135,13 @@ begin
   // via BeginThread and creates the first TThread Object in there!
   InitThreads;
   inherited Create;
-  FSem := SemaphoreInit;
+  FSem := CurrentTM.SemaphoreInit;
   FSuspended := CreateSuspended;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
-  WRITE_DEBUG('creating thread, self = ',longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
+  WRITE_DEBUG('creating thread, self = ',PtrInt(self));
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID,StackSize);
   WRITE_DEBUG('TThread.Create done');
 end;
 
@@ -213,12 +160,12 @@ begin
   end;
   if (FInitialSuspended) then begin
     // thread was created suspended but never woken up.
-    SemaphorePost(FSem);
+    CurrentTM.SemaphorePost(FSem);
     WaitFor;
   end;
   FFatalException.Free;
   FFatalException := nil;
-  SemaphoreDestroy(FSem);
+  CurrentTM.SemaphoreDestroy(FSem);
   inherited Destroy;
 end;
 
@@ -236,7 +183,7 @@ begin
   if not FSuspended then begin
     if FThreadID = GetCurrentThreadID then begin
       FSuspended := true;
-      SemaphoreWait(FSem);
+      CurrentTM.SemaphoreWait(FSem);
     end else begin
       FSuspendedExternal := true;
       SuspendThread(FHandle);
@@ -250,7 +197,7 @@ begin
   if (not FSuspendedExternal) then begin
     if FSuspended then begin
       FSuspended := False;
-      SemaphorePost(FSem);
+      CurrentTM.SemaphorePost(FSem);
     end;
   end else begin
     FSuspendedExternal := false;
@@ -266,7 +213,7 @@ end;
 
 function TThread.WaitFor: Integer;
 begin
-  WRITE_DEBUG('waiting for thread ',ptrint(FHandle));
+  WRITE_DEBUG('waiting for thread ',FHandle);
   WaitFor := WaitForThreadTerminate(FHandle, 0);
   WRITE_DEBUG('thread terminated');
 end;

rtl/unix/cthreads.pp

@@ -570,7 +570,36 @@ procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
     if (errres=0) or (errres=ESysETIMEDOUT) then
       pthread_mutex_unlock(@p^.mutex);
   end;
+  
+function cSemaphoreInit: Pointer;
+var
+  s: PSemaphore;
+begin
+  GetMem(s, SizeOf(TSemaphore));
+  if sem_init(s, 0, 0) = 0 then
+    cSemaphoreInit:=s
+  else
+    cSemaphoreInit:=nil;
+end;
+
+procedure cSemaphoreWait(const FSem: Pointer);
+begin
+  sem_wait(PSemaphore(FSem));
+end;
+
+procedure cSemaphorePost(const FSem: Pointer);
+begin
+  sem_post(PSemaphore(FSem));
+end;
 
+procedure cSemaphoreDestroy(const FSem: Pointer);
+var
+  s: PSemaphore;
+begin
+  s:=FSem;
+  sem_destroy(PSemaphore(FSem));
+  FreeMem(s);
+end;
 
 type
   threadmethod = procedure of object;
@@ -610,8 +639,7 @@ Var
 Procedure SetCThreadManager;
 
 begin
-  With CThreadManager do
-    begin
+  With CThreadManager do begin
     InitManager            :=@CInitThreads;
     DoneManager            :=@CDoneThreads;
     BeginThread            :=@CBeginThread;
@@ -644,7 +672,12 @@ begin
     rtlEventStartWait      :=@intrtlEventStartWait;
     rtleventWaitForTimeout :=@intrtleventWaitForTimeout;
     rtleventWaitFor        :=@intrtleventWaitFor;
-    end;
+    // semaphores
+    SemaphoreInit          :=@cSemaphoreInit;
+    SemaphoreDestroy       :=@cSemaphoreDestroy;
+    SemaphoreWait          :=@cSemaphoreWait;
+    SemaphorePost          :=@cSemaphorePost;
+  end;
   SetThreadManager(CThreadManager);
   InitHeapMutexes;
 end;