From bfc1a6ff1c69b305a509044f402ebb471d6e990e Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Mon, 12 Jul 2010 16:16:50 +0000
Subject: [PATCH]   + added support for intialising/finalising threads not
 started via the FPC     runtime

git-svn-id: trunk@15557 -
---
 .gitattributes        |  1 +
 rtl/unix/cthreads.pp  | 59 +++++++++++++++++++++++++----
 tests/test/textthr.pp | 86 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 138 insertions(+), 8 deletions(-)
 create mode 100644 tests/test/textthr.pp

diff --git a/.gitattributes b/.gitattributes
index 136f07dac5..a42bef5976 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -9137,6 +9137,7 @@ tests/test/texception6.pp svneol=native#text/plain
 tests/test/texception7.pp svneol=native#text/plain
 tests/test/texception8.pp svneol=native#text/plain
 tests/test/texception9.pp svneol=native#text/plain
+tests/test/textthr.pp svneol=native#text/plain
 tests/test/tfillchr.pp svneol=native#text/plain
 tests/test/tfinal1.pp svneol=native#text/pascal
 tests/test/tfinal2.pp svneol=native#text/pascal
diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp
index b211eb5c25..ec78f1070a 100644
--- a/rtl/unix/cthreads.pp
+++ b/rtl/unix/cthreads.pp
@@ -107,7 +107,8 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
 
 
     var
-      TLSKey : pthread_key_t;
+      TLSKey,
+      CleanupKey : pthread_key_t;
 
     procedure CInitThreadvar(var offset : dword;size : dword);
       begin
@@ -160,22 +161,54 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
         pthread_setspecific(tlskey,dataindex);
       end;
 
+
+    procedure CthreadCleanup(p: pointer); cdecl;
+    {$ifdef DEBUG_MT}
+      var
+        s: string[100]; // not an ansistring
+{$endif DEBUG_MT}
+      begin
+{$ifdef DEBUG_MT}
+        s := 'finishing externally started thread'#10;
+        fpwrite(0,s[1],length(s));
+{$endif DEBUG_MT}
+        { clean up }
+        DoneThread;
+        { the pthread routine that calls us is supposed to do this, but doesn't
+          at least on Mac OS X 10.6 }
+        pthread_setspecific(CleanupKey,nil);
+      end;
+
+
+    procedure HookThread;
+      begin
+        { Allocate local thread vars, this must be the first thing,
+          because the exception management and io depends on threadvars }
+        CAllocateThreadVars;
+        { we cannot know the stack size of the current thread, so pretend it
+          is really large to prevent spurious stack overflow errors }
+        InitThread(1000000000);
+        { instruct the pthreads system to clean up this thread when it exits }
+        pthread_setspecific(CleanupKey,pointer(1));
+      end;
+
+
     function CRelocateThreadvar(offset : dword) : pointer;
-
-    var
-      P : Pointer;
-
+      var
+        P : Pointer;
       begin
         P:=pthread_getspecific(tlskey);
+        { a thread which we did not create? }
         if (P=Nil) then
           begin
-          CAllocateThreadvars;
-          // If this also goes wrong: bye bye threadvars...
-          P:=pthread_getspecific(tlskey);
+            HookThread;
+            // If this also goes wrong: bye bye threadvars...
+            P:=pthread_getspecific(tlskey);
           end;
         CRelocateThreadvar:=P+Offset;
       end;
 
+
     procedure CReleaseThreadVars;
       begin
         Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
@@ -276,6 +309,16 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
               { We're still running in single thread mode, setup the TLS }
               pthread_key_create(@TLSKey,nil);
               InitThreadVars(@CRelocateThreadvar);
+              { used to clean up threads that we did not create ourselves:
+                 a) the default value for a key (and hence also this one) in
+                    new threads is NULL, and if it's still like that when the
+                    thread terminates, nothing will happen
+                 b) if it's non-NULL, the destructor routine will be called
+                    when the thread terminates
+               -> we will set it to 1 if the threadvar relocation routine is
+                  called from a thread we did not create, so that we can
+                  clean up everything at the end }
+              pthread_key_create(@CleanupKey,@CthreadCleanup);
             end
         end;
       { the only way to pass data to the newly created thread
diff --git a/tests/test/textthr.pp b/tests/test/textthr.pp
new file mode 100644
index 0000000000..c60370afba
--- /dev/null
+++ b/tests/test/textthr.pp
@@ -0,0 +1,86 @@
+{ %os=darwin,linux,freebsd,solaris,haiku }
+
+{$mode objfpc}
+uses
+  cthreads, pthreads, classes, unixtype;
+
+type
+  tc = class(tthread)
+    procedure execute;override;
+  end;
+
+procedure tc.execute;
+begin
+end;
+
+function threadproc(arg: pointer): pointer; cdecl;
+var
+  p: pointer;
+  a: ansistring;
+begin
+  setlength(a,4000000);
+  getmem(p,5);
+  writeln('hi from thread ',ptruint(arg));
+  freemem(p);
+  result:=pointer(ptruint(arg)+10);
+end;
+
+var
+  t1, t2, t3: pthread_t;
+  res: pointer;
+begin
+  { initialise threading system }
+  with tc.create(false) do
+    begin
+      waitfor;
+      free;
+    end;
+  if pthread_create(@t1,nil,@threadproc,pointer(1))<>0 then
+    begin
+      writeln('error creating 1');
+      halt(1);
+    end;
+  if pthread_create(@t2,nil,@threadproc,pointer(2))<>0 then
+    begin
+      writeln('error creating 2');
+      halt(1);
+    end;
+  if pthread_create(@t3,nil,@threadproc,pointer(3))<>0 then
+    begin
+      writeln('error creating 3');
+      halt(1);
+    end;
+
+  if pthread_join(t1,@res)<>0 then
+    begin
+      writeln('error joining 1');
+      halt(1);
+    end;
+  if res<>pointer(11) then
+    begin
+      writeln('error 1');
+      halt(1);
+    end;
+
+  if pthread_join(t2,@res)<>0 then
+    begin
+      writeln('error joining 1');
+      halt(1);
+    end;
+  if res<>pointer(12) then
+    begin
+      writeln('error 2');
+      halt(2);
+    end;
+
+  if pthread_join(t3,@res)<>0 then
+    begin
+      writeln('error joining 1');
+      halt(1);
+    end;
+  if res<>pointer(13) then
+    begin
+      writeln('error 3');
+      halt(3);
+    end;
+end.