* exiting threads at nlm unload

* renamed some libc functions

rtl/netwlibc/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2004/09/19]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2004/09/22]
 #
 default: all
 MAKEFILETARGETS=netwlibc
@@ -1427,7 +1427,8 @@ sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
 	$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
 classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
 		   sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) \
-		   sysconst$(PPUEXT) types$(PPUEXT) systhrds$(PPUEXT)
+		   sysconst$(PPUEXT) types$(PPUEXT) systhrds$(PPUEXT) \
+		   tthread.inc
 	$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp

rtl/netwlibc/Makefile.fpc

@@ -163,7 +163,8 @@ sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
 
 classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
                    sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) \
-                   sysconst$(PPUEXT) types$(PPUEXT) systhrds$(PPUEXT)
+                   sysconst$(PPUEXT) types$(PPUEXT) systhrds$(PPUEXT) \
+                   tthread.inc
         $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)

rtl/netwlibc/classes.pp

@@ -39,10 +39,21 @@ implementation
 { OS - independent class implementations are in /inc directory. }
 {$i classes.inc}
 
+initialization
+  CommonInit;
+
+finalization
+  DoneThreads;
+  CommonCleanup;
+
 end.
 {
   $Log$
-  Revision 1.1  2004-09-05 20:58:47  armin
+  Revision 1.2  2004-09-26 19:23:34  armin
+  * exiting threads at nlm unload
+  * renamed some libc functions
+
+  Revision 1.1  2004/09/05 20:58:47  armin
   * first rtl version for netwlibc
 
 }

rtl/netwlibc/dos.pp

@@ -66,7 +66,7 @@ uses
 function dosversion : word;
 var i : Tutsname;
 begin
-  if uname (i) >= 0 then
+  if Fpuname (i) >= 0 then
     dosversion := WORD (i.netware_minor) SHL 8 + i.netware_major
   else dosversion := $0005;
 end;
@@ -217,7 +217,7 @@ begin
   //writeln (stderr,'Ok');
   if i <> -1 then
   begin
-    waitpid(i,@wstat,0);
+    Fpwaitpid(i,@wstat,0);
     doserror := 0;
     lastdosexitcode := wstat;
   end else
@@ -393,7 +393,7 @@ begin
       fname := f._dir + f.name;
       if length (fname) = 255 then dec (byte(fname[0]));
       fname := fname + #0;
-      if stat (@fname[1],StatBuf) = 0 then
+      if Fpstat (@fname[1],StatBuf) = 0 then
         timet2dostime (StatBuf.st_mtim.tv_sec, time)
       else
         time := 0;
@@ -624,7 +624,7 @@ var
   StatBuf : TStat;
 begin
   doserror := 0;
-  if fstat (filerec (f).handle, StatBuf) = 0 then
+  if Fpfstat (filerec (f).handle, StatBuf) = 0 then
     timet2dostime (StatBuf.st_mtim.tv_sec,time)
   else begin
     time := 0;
@@ -671,7 +671,7 @@ procedure getfattr(var f;var attr : word);
 VAR StatBuf : TStat;
 begin
   doserror := 0;
-  if stat (@textrec(f).name, StatBuf) = 0 then
+  if Fpstat (@textrec(f).name, StatBuf) = 0 then
     attr := nwattr2dosattr (StatBuf.st_mode)
   else
   begin
@@ -686,7 +686,7 @@ var
   StatBuf : TStat;
   newMode : longint;
 begin
-  if stat (@textrec(f).name,StatBuf) = 0 then
+  if Fpstat (@textrec(f).name,StatBuf) = 0 then
   begin
     newmode := StatBuf.st_mode and ($FFFF0000 - M_A_RDONLY-M_A_HIDDEN-M_A_SYSTEM-M_A_ARCH); {only this can be set by dos unit}
     newmode := newmode or M_A_BITS_SIGNIFICANT;  {set netware attributes}
@@ -698,7 +698,7 @@ begin
       newmode := newmode or M_A_SYSTEM;
     if attr and archive > 0 then
       newmode := newmode or M_A_ARCH;
-    if chmod (@textrec(f).name,newMode) < 0 then
+    if Fpchmod (@textrec(f).name,newMode) < 0 then
       doserror := ___errno^ else
       doserror := 0;
   end else
@@ -822,7 +822,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2004-09-19 20:06:37  armin
+  Revision 1.4  2004-09-26 19:23:34  armin
+  * exiting threads at nlm unload
+  * renamed some libc functions
+
+  Revision 1.3  2004/09/19 20:06:37  armin
   * removed get/free video buf from video.pp
   * implemented sockets
   * basic library support

rtl/netwlibc/system.pp

@@ -82,6 +82,7 @@ const
   Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Attach_Hook  : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook  : TDLL_Entry_Hook = nil;
+  NetwareUnloadProc       : pointer = nil;  {like exitProc but for nlm unload only}
   envp : ppchar = nil;
 
 
@@ -96,7 +97,12 @@ procedure NWSysSetThreadFunctions (atv:TSysReleaseThreadVars;
                                    stdata:TSysSetThreadDataAreaPtr);
 
 
-procedure __ConsolePrintf (s :shortstring);
+procedure ConsolePrintf (s :shortstring);
+procedure ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
+procedure ConsolePrintf (FormatStr : PCHAR; Param : pchar);
+procedure ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
+procedure ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
+procedure ConsolePrintf (FormatStr : PCHAR);
 procedure __EnterDebugger; cdecl;
 
 function NWGetCodeStart : pointer;  // needed for Lineinfo
@@ -126,6 +132,7 @@ var
   ReleaseThreadVars : TSysReleaseThreadVars = nil;
   AllocateThreadVars: TSysReleaseThreadVars = nil;
   SetThreadDataAreaPtr : TSysSetThreadDataAreaPtr = nil;
+  TerminatingThreadID : dword = 0;
 
 procedure NWSysSetThreadFunctions (atv:TSysReleaseThreadVars;
                                    rtv:TSysReleaseThreadVars;
@@ -153,7 +160,18 @@ var SigTermHandlerActive : boolean;
 
 Procedure system_exit;
 begin
-  //__ConsolePrintf ('system_exit');
+  if TerminatingThreadID <> 0 then
+    if TerminatingThreadID <> ThreadId then
+      if TerminatingThreadID <> dword(pthread_self) then
+      begin
+        {$ifdef DEBUG_MT}
+        ConsolePrintf ('Terminating Thread %x because halt was called while Thread %x terminates nlm'#13#10,dword(pthread_self),TerminatingThreadId);
+        {$endif}
+        pthread_exit (nil);
+        // only for the case ExitThread fails
+        while true do
+          NXThreadYield;
+      end;
   if assigned (ReleaseThreadVars) then ReleaseThreadVars;
 
   {$ifdef autoHeapRelease}
@@ -260,7 +278,7 @@ var P2 : POINTER;
 begin
   if HeapSbrkReleased then
   begin
-    __ConsolePrintf ('Error: SysOSFree called after all heap memory was released');
+    ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
     exit(nil);
   end;
   SysOSAlloc := _Alloc (size,HeapAllocResourceTag);
@@ -332,7 +350,7 @@ var i : longint;
 begin
   if HeapSbrkReleased then
   begin
-    __ConsolePrintf ('Error: SysOSFree called after all heap memory was released');
+    ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
   end else
   if (HeapSbrkLastUsed > 0) then
     for i := 1 to HeapSbrkLastUsed do
@@ -541,7 +559,7 @@ VAR res     : LONGINT;
     statbuf : TStat;
 begin
   {$ifdef IOpossix}
-  res := fstat (handle, statbuf);
+  res := Fpfstat (handle, statbuf);
   {$else}
   res := _fstat (_fileno (_TFILE(handle)), statbuf);  // was _filelength for clib
   {$endif}
@@ -858,7 +876,7 @@ procedure InitFPU;assembler;
 function CheckFunction : longint; CDECL; [public,alias: '_NonAppCheckUnload'];
 var oldPtr : pointer;
 begin
-  //__ConsolePrintf ('CheckFunction');
+  //ConsolePrintf ('CheckFunction'#13#10);
   if assigned (NetwareCheckFunction) then
   begin
     if assigned (SetThreadDataAreaPtr) then
@@ -875,14 +893,49 @@ begin
 end;
 
 
-procedure __ConsolePrintf (s : shortstring);
+procedure ConsolePrintf (s : shortstring);
+begin
+  if length(s) > 254 then
+    byte(s[0]) := 254;
+  s := s + #0;
+  ConsolePrintf (@s[1]);
+end;
+
+procedure ConsolePrintf (FormatStr : PCHAR);
+begin
+  if NWLoggerScreen = nil then
+    NWLoggerScreen := getnetwarelogger;
+  if NWLoggerScreen <> nil then
+    screenprintf (NWLoggerScreen,FormatStr);
+end;
+
+procedure ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
+begin
+  if NWLoggerScreen = nil then
+    NWLoggerScreen := getnetwarelogger;
+  if NWLoggerScreen <> nil then
+    screenprintf (NWLoggerScreen,FormatStr,Param);
+end;
+
+procedure ConsolePrintf (FormatStr : PCHAR; Param : pchar);
+begin
+  ConsolePrintf (FormatStr,longint(Param));
+end;
+
+procedure ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
+begin
+  if NWLoggerScreen = nil then
+    NWLoggerScreen := getnetwarelogger;
+  if NWLoggerScreen <> nil then
+    screenprintf (NWLoggerScreen,FormatStr,P1,P2);
+end;
+
+procedure ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
 begin
-  if length(s) > 252 then
-    byte(s[0]) := 252;
-  s := s + #13#10#0;
   if NWLoggerScreen = nil then
     NWLoggerScreen := getnetwarelogger;
-  screenprintf (NWLoggerScreen,@s[1]);
+  if NWLoggerScreen <> nil then
+    screenprintf (NWLoggerScreen,FormatStr,P1,P2,P3);
 end;
 
 
@@ -892,7 +945,7 @@ var NWUts : Tutsname;
 
 procedure getCodeAddresses;
 begin
-  if uname(NWUts) < 0 then
+  if Fpuname(NWUts) < 0 then
     FillChar(NWuts,sizeof(NWUts),0);
 end;
 
@@ -973,6 +1026,7 @@ end;
   Halt (or _exit) can not be called from this callback procedure }
 procedure TermSigHandler (Sig:longint); CDecl;
 var oldPtr : pointer;
+    current_exit : procedure;
 begin
   { Threadvar Pointer will not be valid because the signal
     handler is called by netware with a differnt thread. To avoid
@@ -980,6 +1034,28 @@ begin
     here }
   if assigned (SetThreadDataAreaPtr) then
     oldPtr := SetThreadDataAreaPtr (NIL);  { nil means main thread }
+
+  TerminatingThreadID := dword(pthread_self);
+
+  {we need to finalize winock to release threads
+   waiting on a blocking socket call. If that thread
+   calls halt, we have to avoid that unit finalization
+   is called by that thread because we are doing it
+   here
+
+   like the old exitProc, mainly to allow winsock to release threads
+   blocking in a winsock calls }
+  while NetwareUnloadProc<>nil Do
+  Begin
+    InOutRes:=0;
+    current_exit:=tProcedure(NetwareUnloadProc);
+    NetwareUnloadProc:=nil;
+    current_exit();
+    NXThreadYield;
+    //hadExitProc := true;
+  End;
+
+
   SigTermHandlerActive := true;  { to avoid that system_exit calls _exit }
   do_exit;                       { calls finalize units }
   if assigned (SetThreadDataAreaPtr) then
@@ -1025,7 +1101,9 @@ function _DLLMain (hInstDLL:pointer; fdwReason:dword; DLLParam:longint):longbool
 [public, alias : '_FPC_DLL_Entry'];
 var res : longbool;
 begin
-  __ConsolePrintf ('_FPC_DLL_Entry called');
+  {$ifdef DEBUG_MT}
+  ConsolePrintf ('_FPC_DLL_Entry called');
+  {$endif}
   _DLLMain := false;
   isLibrary := true;
   case fdwReason of
@@ -1094,7 +1172,7 @@ Begin
   HeapListAllocResourceTag :=
     AllocateResourceTag(NLMHandle,'Heap Memory List',AllocSignature);
   {$endif}
-  Signal (SIGTERM, @TermSigHandler);
+  FpSignal (SIGTERM, @TermSigHandler);
 
 { Setup heap }
   InitHeap;
@@ -1116,7 +1194,11 @@ Begin
 End.
 {
   $Log$
-  Revision 1.3  2004-09-19 20:06:37  armin
+  Revision 1.4  2004-09-26 19:23:34  armin
+  * exiting threads at nlm unload
+  * renamed some libc functions
+
+  Revision 1.3  2004/09/19 20:06:37  armin
   * removed get/free video buf from video.pp
   * implemented sockets
   * basic library support

rtl/netwlibc/systhrds.pp

@@ -34,6 +34,14 @@ type
 
 implementation
 
+{ 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 := ConsolePrintf} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
 
 {*****************************************************************************
                              Generic overloaded
@@ -82,17 +90,13 @@ implementation
         pthread_setspecific(tlskey,dataindex);
         if thredvarsmainthread = nil then
           thredvarsmainthread := dataindex;
-        {$ifdef DEBUG_MT}
-        __ConsolePrintf ('SysAllocateThreadVars');
-        {$endif}
+        WRITE_DEBUG ('SysAllocateThreadVars'#13#10);
       end;
 
 
     procedure SysReleaseThreadVars;
       begin
-        {$ifdef DEBUG_MT}
-        __ConsolePrintf ('SysReleaseThreadVars');
-        {$endif}
+        WRITE_DEBUG ('SysReleaseThreadVars'#13#10);
         _Free (pthread_getspecific(tlskey));
       end;
 
@@ -128,9 +132,7 @@ implementation
       begin
         { Release Threadvars }
 {$ifdef HASTHREADVAR}
-{$ifdef DEBUG_MT}
-        __ConsolePrintf('DoneThread, releasing threadvars');
-{$endif DEBUG_MT}
+        WRITE_DEBUG('DoneThread, releasing threadvars'#13#10);
         SysReleaseThreadVars;
 {$endif HASTHREADVAR}
       end;
@@ -139,39 +141,25 @@ implementation
     function ThreadMain(param : pointer) : pointer;cdecl;
       var
         ti : tthreadinfo;
-{$ifdef DEBUG_MT}
-        // in here, don't use write/writeln before having called
-        // InitThread! I wonder if anyone ever debugged these routines,
-        // because they will have crashed if DEBUG_MT was enabled!
-        // this took me the good part of an hour to figure out
-        // why it was crashing all the time!
-        // this is kind of a workaround, we simply write(2) to fd 0
-        s: string[100]; // not an ansistring
-{$endif DEBUG_MT}
       begin
-{$ifdef DEBUG_MT}
-        __ConsolePrintf('New thread started, initing threadvars');
-{$endif DEBUG_MT}
+        WRITE_DEBUG('New thread started, initing threadvars'#13#10);
 {$ifdef HASTHREADVAR}
         { Allocate local thread vars, this must be the first thing,
           because the exception management and io depends on threadvars }
         SysAllocateThreadVars;
 {$endif HASTHREADVAR}
         { Copy parameter to local data }
-{$ifdef DEBUG_MT}
-        __ConsolePrintf ('New thread started, initialising ...');
-{$endif DEBUG_MT}
+        WRITE_DEBUG('New thread started, initialising ...'#13#10);
         ti:=pthreadinfo(param)^;
         dispose(pthreadinfo(param));
         { Initialize thread }
         InitThread(ti.stklen);
         { Start thread function }
-{$ifdef DEBUG_MT}
-        __ConsolePrintf('Jumping to thread function');
-{$endif DEBUG_MT}
+        WRITE_DEBUG('Jumping to thread function'#13#10);
         ThreadMain:=pointer(ti.f(ti.p));
         DoneThread;
-	pthread_detach(pointer(pthread_self));
+	//pthread_detach(pointer(pthread_self));
+        pthread_exit (nil);
       end;
 
 
@@ -182,9 +170,7 @@ implementation
         ti : pthreadinfo;
         thread_attr : pthread_attr_t;
       begin
-{$ifdef DEBUG_MT}
-        __ConsolePrintf('Creating new thread');
-{$endif DEBUG_MT}
+        WRITE_DEBUG('SysBeginThread: Creating new thread'#13#10);
         { Initialize multithreading if not done }
         if not IsMultiThread then
          begin
@@ -202,9 +188,7 @@ implementation
         ti^.p:=p;
         ti^.stklen:=stacksize;
         { call pthread_create }
-{$ifdef DEBUG_MT}
-        __ConsolePrintf('Starting new thread');
-{$endif DEBUG_MT}
+        WRITE_DEBUG('SysBeginThread: Starting new thread'#13#10);
         pthread_attr_init(@thread_attr);
         pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
 
@@ -218,9 +202,7 @@ implementation
           threadid := 0;
         end;
         SysBeginThread:=threadid;
-{$ifdef DEBUG_MT}
-        writeln('BeginThread returning ',SysBeginThread);
-{$endif DEBUG_MT}
+        WRITE_DEBUG('SysBeginThread returning %d'#13#10,SysBeginThread);
       end;
 
 
@@ -262,6 +244,7 @@ implementation
     begin
       LResult := 0;
       LResultP := @LResult;
+      WRITE_DEBUG('SysWaitForThreadTerminate: waiting for %d, timeout %d'#13#10,threadHandle,timeoutMS);
       pthread_join(Pointer(threadHandle), @LResultP);
       SysWaitForThreadTerminate := LResult;
     end;
@@ -500,7 +483,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.2  2004-09-19 20:06:37  armin
+  Revision 1.3  2004-09-26 19:23:34  armin
+  * exiting threads at nlm unload
+  * renamed some libc functions
+
+  Revision 1.2  2004/09/19 20:06:37  armin
   * removed get/free video buf from video.pp
   * implemented sockets
   * basic library support

rtl/netwlibc/sysutils.pp

@@ -175,7 +175,7 @@ Function FileAge (Const FileName : String): Longint;
 var Info : TStat;
     TM  : TTM;
 begin
-  If stat (pchar(FileName),Info) <> 0 then
+  If Fpstat (pchar(FileName),Info) <> 0 then
     exit(-1)
   else
     begin
@@ -189,7 +189,7 @@ end;
 Function FileExists (Const FileName : String) : Boolean;
 VAR Info : TStat;
 begin
-  FileExists:=(stat(pchar(filename),Info) = 0);
+  FileExists:=(Fpstat(pchar(filename),Info) = 0);
 end;
 
 
@@ -239,7 +239,7 @@ begin
       size := Pdirent(FindData.EntryP)^.d_size;
       name := strpas (Pdirent(FindData.EntryP)^.d_name);
       fname := FindData._dir + name;
-      if stat (pchar(fname),StatBuf) = 0 then
+      if Fpstat (pchar(fname),StatBuf) = 0 then
         time := UnixToWinAge (StatBuf.st_mtim.tv_sec)
       else
         time := 0;
@@ -337,7 +337,7 @@ Function FileGetDate (Handle : Longint) : Longint;
 Var Info : TStat;
     _PTM : PTM;
 begin
-  If fstat(Handle,Info) <> 0 then
+  If Fpfstat(Handle,Info) <> 0 then
     Result:=-1
   else
     begin
@@ -361,7 +361,7 @@ end;
 Function FileGetAttr (Const FileName : String) : Longint;
 Var Info : TStat;
 begin
-  If stat (pchar(FileName),Info) <> 0 then
+  If Fpstat (pchar(FileName),Info) <> 0 then
     Result:=-1
   Else
     Result := (Info.st_mode shr 16) and $ffff;
@@ -373,7 +373,7 @@ var
   StatBuf : TStat;
   newMode : longint;
 begin
-  if stat (pchar(Filename),StatBuf) = 0 then
+  if Fpstat (pchar(Filename),StatBuf) = 0 then
   begin
     {what should i do here ?
      only support sysutils-standard attributes or also support the extensions defined
@@ -389,7 +389,7 @@ begin
       newmode := StatBuf.st_mode and ($ffff0000-M_A_RDONLY-M_A_HIDDEN- M_A_SYSTEM-M_A_SUBDIR-M_A_ARCH);
       newmode := newmode or (attr shl 16) or M_A_BITS_SIGNIFICANT;
     end;
-    if chmod (pchar(Filename),newMode) < 0 then
+    if Fpchmod (pchar(Filename),newMode) < 0 then
       result := ___errno^ else
       result := 0;
   end else
@@ -509,7 +509,7 @@ end;
 function DirectoryExists (const Directory: string): boolean;
 var Info : TStat;
 begin
-  If stat (pchar(Directory),Info) <> 0 then
+  If Fpstat (pchar(Directory),Info) <> 0 then
     exit(false)
   else
     Exit ((Info.st_mode and M_A_SUBDIR) <> 0);
@@ -638,7 +638,11 @@ end.
 {
 
   $Log$
-  Revision 1.3  2004-09-19 20:06:37  armin
+  Revision 1.4  2004-09-26 19:23:34  armin
+  * exiting threads at nlm unload
+  * renamed some libc functions
+
+  Revision 1.3  2004/09/19 20:06:37  armin
   * removed get/free video buf from video.pp
   * implemented sockets
   * basic library support

rtl/netwlibc/tthread.inc

@@ -66,6 +66,16 @@
   change them completely.
 }
 
+{ 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 := ConsolePrintf} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
+
+
 function SemaphoreInit: Pointer;
 begin
   SemaphoreInit := GetMem(SizeOf(TFilDes));
@@ -95,11 +105,22 @@ end;
 
 // =========== semaphore end ===========
 
+type
+  PThreadRec=^TThreadRec;
+  TThreadRec=record
+    thread : TThread;
+    next   : PThreadRec;
+  end;
+
 var
-  ThreadsInited: boolean = false;
+  ThreadRoot : PThreadRec;
+  ThreadsInited : boolean = false;
+  DisableRemoveThread : boolean;
+  ThreadCount: longint = 0;
 {$IFDEF LINUX}
   GMainPID: LongInt = 0;
 {$ENDIF}
+
 const
   // stupid, considering its not even implemented...
   Priorities: array [TThreadPriority] of Integer =
@@ -112,29 +133,83 @@ begin
     {$IFDEF LINUX}
     GMainPid := fpgetpid();
     {$ENDIF}
+    ThreadRoot:=nil;
+    ThreadsInited:=true;
+    DisableRemoveThread:=false;
   end;
 end;
 
 procedure DoneThreads;
+var
+  hp,next : PThreadRec;
 begin
-  ThreadsInited := false;
+  DisableRemoveThread := true;    {to avoid that Destroy calling RemoveThread modifies Thread List}
+  while assigned(ThreadRoot) do
+   begin
+     WRITE_DEBUG('DoneThreads: calling Destroy'#13#10);
+     ThreadRoot^.Thread.Destroy;
+     hp:=ThreadRoot;
+     ThreadRoot:=ThreadRoot^.Next;
+     dispose(hp);
+     WRITE_DEBUG('DoneThreads: called destroy, remaining threads: %d ThreadRoot: %x'#13#10,ThreadCount,longint(ThreadRoot));
+   end;
+  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}
+procedure AddThread(t:TThread);
+var
+  hp : PThreadRec;
+begin
+  { Need to initialize threads ? }
+  if not ThreadsInited then
+   InitThreads;
+
+  { Put thread in the linked list }
+  new(hp);
+  hp^.Thread:=t;
+  hp^.next:=ThreadRoot;
+  ThreadRoot:=hp;
+
+  inc(ThreadCount);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+  lasthp,hp : PThreadRec;
+begin
+  if not DisableRemoveThread then  {disabled while in DoneThreads}
+  begin
+    hp:=ThreadRoot;
+    lasthp:=nil;
+    while assigned(hp) do
+    begin
+      if hp^.Thread=t then
+      begin
+        if assigned(lasthp) then
+         lasthp^.next:=hp^.next
+        else
+         ThreadRoot:=hp^.next;
+        dispose(hp);
+        Dec(ThreadCount);
+        if ThreadCount = 0 then ThreadsInited := false;
+        exit;
+      end;
+      lasthp:=hp;
+      hp:=hp^.next;
+    end;
+  end else
+    dec(ThreadCount);
+end;
+
+
 
 function ThreadFunc(parameter: Pointer): LongInt;
 var
   LThread: TThread;
   c: char;
 begin
-  WRITE_DEBUG('ThreadFunc is here...');
+  WRITE_DEBUG('ThreadFunc is here...'#13#10);
   LThread := TThread(parameter);
   {$IFDEF LINUX}
   // save the PID of the "thread"
@@ -142,38 +217,38 @@ begin
   // the LinuxThreads implementation is used
   LThread.FPid := fpgetpid();
   {$ENDIF}
-  WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+  WRITE_DEBUG('thread initing, parameter = %d'#13#10, LongInt(LThread));
   try
     if LThread.FInitialSuspended then begin
       SemaphoreWait(LThread.FSem);
       if not LThread.FInitialSuspended then begin
-        WRITE_DEBUG('going into LThread.Execute');
+        WRITE_DEBUG('going into LThread.Execute'#13#10);
         LThread.Execute;
       end;
     end else begin
-      WRITE_DEBUG('going into LThread.Execute');
+      WRITE_DEBUG('going into LThread.Execute'#13#10);
       LThread.Execute;
     end;
   except
     on e: exception do begin
-      WRITE_DEBUG('got exception: ',e.message);
+      WRITE_DEBUG('got exception: %s'#13#10,pchar(e.message));
       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;
     end;
   end;
-  WRITE_DEBUG('thread done running');
+  WRITE_DEBUG('thread done running'#13#10);
   Result := LThread.FReturnValue;
-  WRITE_DEBUG('Result is ',Result);
+  WRITE_DEBUG('Result is %d'#13#10,Result);
   LThread.FFinished := True;
   LThread.DoTerminate;
   if LThread.FreeOnTerminate then begin
-    WRITE_DEBUG('Thread should be freed');
+    WRITE_DEBUG('Thread should be freed'#13#10);
     LThread.Free;
-    WRITE_DEBUG('Thread freed');
+    WRITE_DEBUG('Thread freed'#13#10);
   end;
-  WRITE_DEBUG('thread func exiting');
+  WRITE_DEBUG('thread func exiting'#13#10);
 end;
 
 { TThread }
@@ -182,15 +257,16 @@ begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!
   InitThreads;
+  AddThread(self);
   inherited Create;
   FSem := SemaphoreInit;
   FSuspended :=CreateSuspended;
   FSuspendedExternal := false;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
-  WRITE_DEBUG('creating thread, self = ',longint(self));
+  WRITE_DEBUG('creating thread, self = %d'#13#10,longint(self));
   FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
-  WRITE_DEBUG('TThread.Create done');
+  WRITE_DEBUG('TThread.Create done'#13#10);
 end;
 
 
@@ -215,6 +291,7 @@ begin
   FFatalException := nil;
   SemaphoreDestroy(FSem);
   inherited Destroy;
+  RemoveThread(self);          {remove it from the list of active threads}
 end;
 
 procedure TThread.SetSuspended(Value: Boolean);
@@ -326,7 +403,11 @@ end;
 
 {
   $Log$
-  Revision 1.1  2004-09-05 20:58:47  armin
+  Revision 1.2  2004-09-26 19:23:34  armin
+  * exiting threads at nlm unload
+  * renamed some libc functions
+
+  Revision 1.1  2004/09/05 20:58:47  armin
   * first rtl version for netwlibc
 
 }