mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 09:19:39 +01:00
+ unload module no longer shows: Module did not release...
+ check-function will no longer be removed when smartlink is on
This commit is contained in:
armin
parent
fe48bc8f27
commit
fcdf7d83d3
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
#
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user