+ unload module no longer shows: Module did not release...

+ check-function will no longer be removed when smartlink is on

rtl/netware/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2002/03/31]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2002/04/01]
 #
 default: all
 MAKEFILETARGETS=netware
@@ -207,10 +207,9 @@ SYSTEMUNIT=system
 else
 SYSTEMUNIT=sysnetwa
 endif
-ifdef RELEASE
 override FPCOPT+=-Ur
-endif
 override FPCOPT+=-dMT
+CREATESMART=1
 OBJPASDIR=$(RTL)/objpas
 override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings netware os_types winsock2 dos crt objects sysutils typinfo math cpu mmx getopts heaptrc lineinfo sockets aio varutils video mouse keyboard
 override TARGET_LOADERS+=nwpre prelude
@@ -519,6 +518,7 @@ FPCMADE=fpcmade.qnx
 ZIPSUFFIX=qnx
 endif
 ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
 PPUEXT=.ppn
 OEXT=.on
 ASMEXT=.s
@@ -1171,7 +1171,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(WININC) netware.pp
 os_types$(PPUEXT) : $(INC)/os_types.pp
-winsock2$(PPUEXT) : winsock2.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) os_types$(PPUEXT)
+winsock2$(PPUEXT) : winsock2.pp qos.inc netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) os_types$(PPUEXT)
 sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
 		   $(INC)/sockets.inc $(INC)/socketsh.inc
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/netware/Makefile.fpc

@@ -48,13 +48,16 @@ endif
 # Use new feature from 1.0.5 version
 # that generates release PPU files
 # which will not be recompiled
-ifdef RELEASE
+# ifdef RELEASE
 override FPCOPT+=-Ur
-endif
+# endif
 
 # for netware always use multithread
 override FPCOPT+=-dMT
 
+# and alway use smartlinking
+CREATESMART=1
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 
@@ -180,3 +183,10 @@ nwimp/locnlm32.imp nwimp/ndpsrpc.imp nwimp/netnlm32.imp nwimp/nit.imp \
 nwimp/nlmlib.imp nwimp/nwpsrv3x.imp nwimp/nwpsrv.imp nwimp/nwsnut.imp \
 nwimp/requestr.imp nwimp/socklib.imp nwimp/streams.imp nwimp/threads.imp \
 nwimp/tli.imp nwimp/vollib.imp nwimp/ws2_32.imp nwimp/ws2nlm.imp
+
+# the smartlinked objects will not be installed by the
+# standard makefile ????
+
+#override UNITPPUFILES+=cpu.a crt.a dos.a getopts.a heaptrc.a keyboard.a \
+#lineinfo.a math.a mmx.a mouse.a netware.a objects.a objpas.a sockets.a \
+#strings.a system.a sysutils.a typinfo.a varutils.a video.a winsock2.a

rtl/netware/nwpre.as

@@ -27,6 +27,9 @@ _pasStart_:
     call	_SetupArgV_411
     addl	$4,%esp
     ret
+# this is a hack to avoid that FPC_NW_CHECKFUNCTION will be
+# eleminated by the linker (with smartlinking)
+    call	FPC_NW_CHECKFUNCTION
 
 
 #

rtl/netware/nwsys.inc

@@ -333,10 +333,18 @@ FUNCTION _ExitCritSec : LONGINT; CDecl; EXTERNAL ThreadsNlm NAME 'ExitCritSec';
 FUNCTION _SetThreadGroupID (id : longint) : longint; CDecl; EXTERNAL ThreadsNlm NAME 'SetThreadGroupID';
 FUNCTION _GetThreadGroupID : longint; CDecl; EXTERNAL ThreadsNlm NAME 'GetThreadGroupID';
 
+CONST _SIGTERM = 6;
+
+PROCEDURE _Signal (Sig : longint; SigFunc : pointer);  CDECL; EXTERNAL Clib NAME 'signal';
+
 
 {
   $Log$
-  Revision 1.5  2002-03-30 09:09:47  armin
+  Revision 1.6  2002-04-01 15:20:08  armin
+  + unload module no longer shows: Module did not release...
+  + check-function will no longer be removed when smartlink is on
+
+  Revision 1.5  2002/03/30 09:09:47  armin
   + support check-function for netware
 
   Revision 1.4  2002/03/08 19:06:47  armin

rtl/netware/system.pp

@@ -88,12 +88,6 @@ PROCEDURE ConsolePrintf (FormatStr : PCHAR);  CDecl;
 
 implementation
 
-{ ?? why does this not work ?? DEFINE FPC_SYSTEM_HAS_MOVE}
-{procedure move (const source; var dest; count : longint);
-begin
-  _memcpy (@dest, @source, count);
-end;}
-
 { include system independent routines }
 
 {$I system.inc}
@@ -102,13 +96,13 @@ end;}
 {$I nwsys.inc}
 {$I errno.inc}
 
-procedure setup_arguments;
+{procedure setup_arguments;
 begin
-end;
+end;
}
 
-procedure setup_environment;
+{procedure setup_environment;
 begin
-end;
+end;
}
 
 
 
@@ -134,25 +128,6 @@ procedure CloseAllRemainingSemaphores; FORWARD;
 procedure ReleaseThreadVars; FORWARD;
 {$endif}
 
-{ if return-value is <> 0, netware shows the message
-  Unload Anyway ?
-  To Disable unload at all, SetNLMDontUnloadFlag can be used on
-  Netware >= 4.0 }
-function CheckFunction : longint; CDECL; [public,alias: 'FPC_NW_CHECKFUNCTION'];
-var oldTG:longint;
-begin
-  if @NetwareCheckFunction <> nil then
-  begin
-    { this function is called without clib context, to allow clib
-      calls, we set the thread group id before calling the
-      user-function }
-    oldTG := _SetThreadGroupID (NetwareMainThreadGroupID);
-    result := 0;
-    NetwareCheckFunction (result);
-    _SetThreadGroupID (oldTG);
-  end else
-    result := 0;
-end;
 
 {*****************************************************************************
                          System Dependent Exit code
@@ -160,6 +135,8 @@ end;
 
 procedure FreeSbrkMem; forward;
 
+var SigTermHandlerActive : boolean;
+
 Procedure system_exit;
 begin
 {$ifdef MT}
@@ -168,10 +145,13 @@ begin
 {$endif}
   FreeSbrkMem;            { free memory allocated by heapmanager }
 
-  if ExitCode <> 0 Then   { otherwise we dont see runtime-errors }
+  if not SigTermHandlerActive then
-    PressAnyKeyToContinue;
+  begin
+    if ExitCode <> 0 Then   { otherwise we dont see runtime-errors }
+      PressAnyKeyToContinue;
   
-  _exit (ExitCode);
+    _exit (ExitCode);
+  end;
 end;
 
 {*****************************************************************************
@@ -291,6 +271,7 @@ begin
     _free (HeapSbrkBlockList);
     HeapSbrkAllocated := 0;
     HeapSbrkLastUsed := 0;
+    HeapSbrkBlockList := nil;
   end;    
 end;
 
@@ -659,6 +640,34 @@ procedure InitFPU;assembler;
 { include threading stuff, this is os dependend part }
 {$I thread.inc}
 
+{ if return-value is <> 0, netware shows the message
+  Unload Anyway ?
+  To Disable unload at all, SetNLMDontUnloadFlag can be used on
+  Netware >= 4.0 }
+function CheckFunction : longint; CDECL; [public,alias: 'FPC_NW_CHECKFUNCTION'];
+var oldTG:longint;
+    oldPtr: pointer;
+begin
+  if assigned (NetwareCheckFunction) then
+  begin
+    { this function is called without clib context, to allow clib
+      calls, we set the thread group id before calling the
+      user-function }
+    oldTG := _SetThreadGroupID (NetwareMainThreadGroupID);
+    { to allow use of threadvars, we simply set the threadvar-memory
+      from the main thread }
+    oldPtr:= _GetThreadDataAreaPtr;
+    _SaveThreadDataAreaPtr (thredvarsmainthread);
+    result := 0;
+    NetwareCheckFunction (result);
+    _SaveThreadDataAreaPtr (oldPtr);
+    _SetThreadGroupID (oldTG);
+  end else
+    result := 0;
+end;
+
+
+
 {$ifdef StdErrToConsole}
 var ConsoleBuff : array [0..512] of char;
 
@@ -703,7 +712,28 @@ begin
   Rewrite(T);
 end;
 {$endif}
-
+
+
+{ this will be called if the nlm is unloaded. It will NOT be
+  called if the program exits i.e. with halt.
+  Halt (or _exit) can not be called from this callback procedure }
+procedure TermSigHandler (Sig:longint); CDecl;
+var oldTG : longint;
+    oldPtr: pointer;
+begin
+  oldTG := _SetThreadGroupID (NetwareMainThreadGroupID); { this is only needed for nw 3.11 }
+  
+  { _GetThreadDataAreaPtr will not be valid because the signal
+    handler is called by netware with a differnt thread. To avoid
+    problems in the exit routines, we set the data of the main thread
+    here }
+  oldPtr:= _GetThreadDataAreaPtr;
+  _SaveThreadDataAreaPtr (thredvarsmainthread);
+  SigTermHandlerActive := true;  { to avoid that system_exit calls _exit }
+  do_exit;                       { calls finalize units }
+  _SaveThreadDataAreaPtr (oldPtr);
+  _SetThreadGroupID (oldTG);
+end;
 
 
 {*****************************************************************************
@@ -715,9 +745,11 @@ Begin
   { the exceptions use threadvars so do this _before_ initexceptions }
   AllocateThreadVars;
 {$endif MT}
-
+  SigTermHandlerActive := false;
   NetwareCheckFunction := nil;
   NetwareMainThreadGroupID := _GetThreadGroupID;
+  
+  _Signal (_SIGTERM, @TermSigHandler);
 
 { Setup heap }
   InitHeap;
@@ -739,8 +771,8 @@ Begin
   {$endif}
   
 { Setup environment and arguments }
-  Setup_Environment;
+  {Setup_Environment;
-  Setup_Arguments;
+  Setup_Arguments;
}
 { Reset IO Error }
   InOutRes:=0;
   {Delphi Compatible}
@@ -750,7 +782,11 @@ Begin
 End.
 {
   $Log$
-  Revision 1.9  2002-04-01 10:47:31  armin
+  Revision 1.10  2002-04-01 15:20:08  armin
+  + unload module no longer shows: Module did not release...
+  + check-function will no longer be removed when smartlink is on
+
+  Revision 1.9  2002/04/01 10:47:31  armin
   makefile.fpc for netware
   stderr to netware console
   free all memory (threadvars and heap) to avoid error message while unloading nlm

rtl/netware/thread.inc

@@ -30,7 +30,8 @@
 }
 
 const
-   threadvarblocksize : dword = 0;  // total size of allocated threadvars
+   threadvarblocksize : dword = 0;     // total size of allocated threadvars
+   thredvarsmainthread: pointer = nil; // to free the threadvars in the signal handler
 
 type
    tthreadinfo = record
@@ -63,9 +64,6 @@ procedure init_unit_threadvars (tableEntry : pltvInitEntry);
 begin
   while tableEntry^.varaddr <> nil do
   begin
-    {$ifdef DEBUG_MT}
-    ConsolePrintf3(#13'init_unit_threadvars, size: %d, addr: %d'#13#10,tableEntry^.size,dword(tableEntry^.varaddr),0);
-    {$endif}
     init_threadvar (tableEntry^.varaddr^, tableEntry^.size);
     inc (pchar (tableEntry), sizeof (tableEntry^));
   end;
@@ -87,8 +85,15 @@ begin
   ConsolePrintf(#13'init_all_unit_threadvars (%d) units'#13#10,ThreadvarTablesTable.count);
   {$endif}
   for i := 1 to ThreadvarTablesTable.count do
+  begin
+    {$ifdef DEBUG_MT}
+    ConsolePrintf(#13'init_unit_threadvars for unit (%d):'#13#10,i);
+    {$endif}
     init_unit_threadvars (ThreadvarTablesTable.tables[i]);
-  
+    {$ifdef DEBUG_MT}
+    ConsolePrintf(#13'init_unit_threadvars for unit (%d) done'#13#10,i);
+    {$endif}
+  end;
 end;
 
 {$ifdef DEBUG_MT}
@@ -96,17 +101,18 @@ var dummy_buff : array [0..255] of char;  // to avoid abends (for current compil
 {$endif}
 
 function relocate_threadvar(offset : dword) : pointer;[public,alias: 'FPC_RELOCATE_THREADVAR'];
+var p : pointer;
 begin
  {$ifdef DEBUG_MT}
-   ConsolePrintf(#13'relocate_threadvar, offset: (%d)'#13#10,offset);
+//   ConsolePrintf(#13'relocate_threadvar, offset: (%d)'#13#10,offset);
    if offset > threadvarblocksize then
    begin
-     ConsolePrintf(#13'relocate_threadvar, invalid offset'#13#10,0);
+//     ConsolePrintf(#13'relocate_threadvar, invalid offset'#13#10,0);
      relocate_threadvar := @dummy_buff;
      exit;
    end;
  {$endif DEBUG_MT}
-  relocate_threadvar:=_GetThreadDataAreaPtr + offset;
+ relocate_threadvar:= _GetThreadDataAreaPtr + offset;
 end;
 
 procedure AllocateThreadVars;
@@ -124,9 +130,10 @@ procedure AllocateThreadVars;
      fillchar (threadvars^, threadvarblocksize, 0);
      _SaveThreadDataAreaPtr (threadvars);
      {$ifdef DEBUG_MT}
-       ConsolePrintf(#13'threadvars allocated at (%x)'#13#10,longint(threadvars));
+       ConsolePrintf3(#13'threadvars allocated at (%x), size: %d'#13#10,longint(threadvars),threadvarblocksize,0);
-       ConsolePrintf(#13'size of threadvars: %d'#13#10,threadvarblocksize);
      {$endif DEBUG_MT}
+     if thredvarsmainthread = nil then
+       thredvarsmainthread := threadvars;
   end;
 
 procedure ReleaseThreadVars;
@@ -136,7 +143,13 @@ begin
    if threadvarblocksize > 0 then
    begin
      threadvars:=_GetThreadDataAreaPtr;
-    _Free (threadvars);
+     if threadvars <> nil then
+     begin
+       {$ifdef DEBUG_MT}
+        ConsolePrintf (#13'free threadvars'#13#10,0);
+       {$endif DEBUG_MT}
+       _Free (threadvars);
+     end;
   end;
 end;
 
@@ -356,7 +369,11 @@ end;
 
 {
   $Log$
-  Revision 1.3  2002-04-01 10:47:31  armin
+  Revision 1.4  2002-04-01 15:20:08  armin
+  + unload module no longer shows: Module did not release...
+  + check-function will no longer be removed when smartlink is on
+
+  Revision 1.3  2002/04/01 10:47:31  armin
   makefile.fpc for netware
   stderr to netware console
   free all memory (threadvars and heap) to avoid error message while unloading nlm