amicommon: support for init/exit procedures for threads. will be used by Sockets unit for example, because bsdsocket.library needs to be reopened for each thread

git-svn-id: trunk@30991 -

rtl/amicommon/sysos.inc

@@ -172,3 +172,66 @@ begin
     end;
   end;
 end;
+
+{ Thread Init/Exit Procedure support }
+Type
+  PThreadProcInfo = ^TThreadProcInfo;
+  TThreadProcInfo = Record
+    Next     : PThreadProcInfo;
+    Proc     : TProcedure;
+  End;
+
+const
+  threadInitProcList :PThreadProcInfo = nil;
+  threadExitProcList :PThreadProcInfo = nil;
+
+Procedure DoThreadProcChain(p: PThreadProcInfo);
+Begin
+  while p <> nil do
+    begin
+      p^.proc;
+      p:=p^.next;
+    end;
+End;
+
+Procedure AddThreadProc(var procList: PThreadProcInfo; Proc: TProcedure);
+var
+  P : PThreadProcInfo;
+Begin
+  New(P);
+  P^.Next:=procList;
+  P^.Proc:=Proc;
+  procList:=P;
+End;
+
+Procedure CleanupThreadProcChain(var procList: PThreadProcInfo);
+var
+  P : PThreadProcInfo;
+Begin
+  while procList <> nil do
+    begin
+      p:=procList;
+      procList:=procList^.next;
+      dispose(p);
+    end;
+End;
+
+Procedure AddThreadInitProc(Proc: TProcedure);
+Begin
+  AddThreadProc(threadInitProcList,Proc);
+End;
+
+Procedure AddThreadExitProc(Proc: TProcedure);
+Begin
+  AddThreadProc(threadExitProcList,Proc);
+End;
+
+Procedure DoThreadInitProcChain;
+Begin
+  DoThreadProcChain(threadInitProcList);
+End;
+
+Procedure DoThreadExitProcChain;
+Begin
+  DoThreadProcChain(threadExitProcList);
+End;

rtl/amicommon/sysosh.inc

@@ -39,3 +39,9 @@ type
 const
   CREATE_SUSPENDED = 1;
   STACK_SIZE_PARAM_IS_A_RESERVATION = 2;
+
+{ Thread Init/Exit Procedure support }
+Procedure AddThreadInitProc(Proc: TProcedure);
+Procedure AddThreadExitProc(Proc: TProcedure);
+Procedure DoThreadInitProcChain;
+Procedure DoThreadExitProcChain;

rtl/amiga/system.pp

@@ -141,6 +141,10 @@ procedure System_exit;
 var
   oldDirLock: LongInt;
 begin
+  { Dispose the thread init/exit chains }
+  CleanupThreadProcChain(threadInitProcList);
+  CleanupThreadProcChain(threadExitProcList);
+
   { We must remove the CTRL-C FLAG here because halt }
   { may call I/O routines, which in turn might call  }
   { halt, so a recursive stack crash                 }

rtl/morphos/system.pp

@@ -99,6 +99,10 @@ procedure System_exit;
 var
   oldDirLock: LongInt;
 begin
+  { Dispose the thread init/exit chains }
+  CleanupThreadProcChain(threadInitProcList);
+  CleanupThreadProcChain(threadExitProcList);
+
   { We must remove the CTRL-C FLAG here because halt }
   { may call I/O routines, which in turn might call  }
   { halt, so a recursive stack crash                 }