* fixed FreeOnTerminate (was already fixed in Linux version)

  * handle interrupted reads from the semaphore pipe in Darwin (should be
    applied to *BSD and Linux as well)
  + lots of extra debugging code in Darwin tthread.inc if DEBUG_MT defined

git-svn-id: trunk@1416 -

rtl/darwin/tthread.inc

@@ -54,6 +54,15 @@
   Johannes Berg <[email protected]>, Sunday, November 16 2003
 }
 
+{ 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}
+
 // ========== semaphore stuff ==========
 {
   I don't like this. It eats up 2 filedescriptors for each thread,
@@ -70,13 +79,18 @@ 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
-  fpread(PFilDes(FSem)^[0], b, 1);
+  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);
@@ -85,16 +99,19 @@ 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}
-  fpwrite(PFilDes(FSem)^[1], #0, 1);
+  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);
@@ -121,15 +138,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;
@@ -191,7 +199,7 @@ end;
 
 destructor TThread.Destroy;
 begin
-  if FThreadID = GetCurrentThreadID then begin
+  if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) 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
@@ -256,7 +264,7 @@ end;
 
 function TThread.WaitFor: Integer;
 begin
-  WRITE_DEBUG('waiting for thread ',FHandle);
+  WRITE_DEBUG('waiting for thread ',ptrint(FHandle));
   WaitFor := WaitForThreadTerminate(FHandle, 0);
   WRITE_DEBUG('thread terminated');
 end;

rtl/freebsd/tthread.inc

@@ -204,7 +204,7 @@ end;
 
 destructor TThread.Destroy;
 begin
-  if FThreadID = GetCurrentThreadID then begin
+  if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) 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

rtl/netbsd/tthread.inc

@@ -195,7 +195,7 @@ end;
 
 destructor TThread.Destroy;
 begin
-  if FThreadID = GetCurrentThreadID then begin
+  if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) 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

rtl/openbsd/tthread.inc

@@ -205,7 +205,7 @@ end;
 
 destructor TThread.Destroy;
 begin
-  if FThreadID = GetCurrentThreadID then begin
+  if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) 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