* remove pipe hack from linux tthread as well

git-svn-id: trunk@4901 -

rtl/linux/tthread.inc

@@ -1,17 +1,18 @@
 {
-    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.
 
-    Linux 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.
+}
 
- **********************************************************************}
 
 {
   What follows, is a short description on my implementation of TThread.
@@ -53,59 +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;
-{$IFDEF LINUX}
-  GMainPID: LongInt = 0;
-{$ENDIF}
+  CurrentTM: TThreadManager;
+  
 const
   // stupid, considering its not even implemented...
   Priorities: array [TThreadPriority] of Integer =
@@ -113,12 +74,9 @@ const
 
 procedure InitThreads;
 begin
-  if not ThreadsInited then begin
+  GetThreadManager(CurrentTM);
+  if not ThreadsInited then
     ThreadsInited := true;
-    {$IFDEF LINUX}
-    GMainPid := fpgetpid();
-    {$ENDIF}
-  end;
 end;
 
 procedure DoneThreads;
@@ -126,32 +84,17 @@ 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): PtrInt;
+function ThreadFunc(parameter: Pointer): LongInt;
 var
   LThread: TThread;
   c: char;
 begin
   WRITE_DEBUG('ThreadFunc is here...');
   LThread := TThread(parameter);
-  {$IFDEF LINUX}
-  // save the PID of the "thread"
-  // this is different from the PID of the main thread if
-  // the LinuxThreads implementation is used
-  LThread.FPid := fpgetpid();
-  {$ENDIF}
-  WRITE_DEBUG('thread initing, parameter = ', PtrInt(LThread));
+  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');
@@ -167,8 +110,7 @@ begin
       LThread.FFatalException :=  TObject(AcquireExceptionObject);
       // not sure if we should really do this...
       // but .Destroy was called, so why not try FreeOnTerminate?
-      if e is EThreadDestroyCalled then
-        LThread.FFreeOnTerminate := true;
+      if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
     end;
   end;
   WRITE_DEBUG('thread done running');
@@ -193,23 +135,22 @@ begin
   // via BeginThread and creates the first TThread Object in there!
   InitThreads;
   inherited Create;
-  FSem := SemaphoreInit;
-  FSuspended :=CreateSuspended;
+  FSem := CurrentTM.SemaphoreInit;
+  FSuspended := CreateSuspended;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
-  WRITE_DEBUG('creating thread, self = ', PtrInt(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;
 
 
 destructor TThread.Destroy;
 begin
-  if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) 
-	and not fFinished then		
+  if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) and not ffinished then begin
     raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
-
+  end;
   // if someone calls .Free on a thread with
   // FreeOnTerminate, then don't crash!
   FFreeOnTerminate := false;
@@ -219,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;
 
@@ -242,25 +183,10 @@ begin
   if not FSuspended then begin
     if FThreadID = GetCurrentThreadID then begin
       FSuspended := true;
-      SemaphoreWait(FSem);
+      CurrentTM.SemaphoreWait(FSem);
     end else begin
       FSuspendedExternal := true;
-{$IFDEF LINUX}
-      // naughty hack if the user doesn't have Linux with NPTL...
-      // in that case, the PID of threads will not be identical
-      // to the other threads, which means that our thread is a normal
-      // process that we can suspend via SIGSTOP...
-      // this violates POSIX, but is the way it works on the
-      // LinuxThreads pthread implementation. Not with NPTL, but in that case
-      // getpid(2) also behaves properly and returns the same PID for
-      // all threads. Thats actually (FINALLY!) native thread support :-)
-      if FPid <> GMainPID then begin
-        FSuspended := true;
-        fpkill(FPid, SIGSTOP);
-      end;
-{$ELSE}
       SuspendThread(FHandle);
-{$ENDIF}
     end;
   end;
 end;
@@ -271,19 +197,11 @@ begin
   if (not FSuspendedExternal) then begin
     if FSuspended then begin
       FSuspended := False;
-      SemaphorePost(FSem);
+      CurrentTM.SemaphorePost(FSem);
     end;
   end else begin
     FSuspendedExternal := false;
-{$IFDEF LINUX}
-    // see .Suspend
-    if FPid <> GMainPID then begin
-      FSuspended := False;
-      fpkill(FPid, SIGCONT);
-    end;
-{$ELSE}
     ResumeThread(FHandle);
-{$ENDIF}
   end;
 end;
 
@@ -296,9 +214,6 @@ end;
 function TThread.WaitFor: Integer;
 begin
   WRITE_DEBUG('waiting for thread ',FHandle);
-  if GetCurrentThreadID=MainThreadID then
-    while not(FFinished) do
-      CheckSynchronize(1000);
   WaitFor := WaitForThreadTerminate(FHandle, 0);
   WRITE_DEBUG('thread terminated');
 end;