diff --git a/rtl/netware/Makefile b/rtl/netware/Makefile index 5661ea129c..b88059c648 100644 --- a/rtl/netware/Makefile +++ b/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) diff --git a/rtl/netware/Makefile.fpc b/rtl/netware/Makefile.fpc index 27735aae05..3348d3cd28 100644 --- a/rtl/netware/Makefile.fpc +++ b/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 diff --git a/rtl/netware/nwpre.as b/rtl/netware/nwpre.as index 5cde93e123..346dffa3e7 100644 --- a/rtl/netware/nwpre.as +++ b/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 # diff --git a/rtl/netware/nwsys.inc b/rtl/netware/nwsys.inc index 48f3df13d9..3c4c1a66ef 100644 --- a/rtl/netware/nwsys.inc +++ b/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 diff --git a/rtl/netware/system.pp b/rtl/netware/system.pp index 507dae9623..7a7138ce4e 100644 --- a/rtl/netware/system.pp +++ b/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 } - PressAnyKeyToContinue; + if not SigTermHandlerActive then + 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_Arguments; + {Setup_Environment; + 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 diff --git a/rtl/netware/thread.inc b/rtl/netware/thread.inc index 6532f568e3..6a1c2fb56b 100644 --- a/rtl/netware/thread.inc +++ b/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)); - ConsolePrintf(#13'size of threadvars: %d'#13#10,threadvarblocksize); + ConsolePrintf3(#13'threadvars allocated at (%x), size: %d'#13#10,longint(threadvars),threadvarblocksize,0); {$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