mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 06:59:24 +02:00
* ExitDLL fixed : uses now SetJmp LongJmp
* System_exit unloads the exception hanlder before leaving
This commit is contained in:
parent
24353efcb7
commit
1892f7443a
@ -273,7 +273,7 @@ begin
|
|||||||
l:=longint(GlobalLock(h));
|
l:=longint(GlobalLock(h));
|
||||||
if l=0 then
|
if l=0 then
|
||||||
l:=-1;
|
l:=-1;
|
||||||
{$ifdef SYSTEMDEBUG}
|
{$ifdef DUMPGROW}
|
||||||
Writeln('new heap part at $',hexstr(l,8), ' size = ',GlobalSize(h));
|
Writeln('new heap part at $',hexstr(l,8), ' size = ',GlobalSize(h));
|
||||||
{$endif}
|
{$endif}
|
||||||
sbrk:=l;
|
sbrk:=l;
|
||||||
@ -744,19 +744,27 @@ end;
|
|||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
System Dependent Exit code
|
System Dependent Exit code
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
|
||||||
|
procedure install_exception_handlers;forward;
|
||||||
|
procedure remove_exception_handlers;forward;
|
||||||
|
procedure PascalMain;external name 'PASCALMAIN';
|
||||||
|
procedure fpc_do_exit;external name 'FPC_DO_EXIT';
|
||||||
|
Procedure ExitDLL(Exitcode : longint); forward;
|
||||||
|
|
||||||
Procedure system_exit;
|
Procedure system_exit;
|
||||||
begin
|
begin
|
||||||
{ don't call ExitProcess inside
|
{ don't call ExitProcess inside
|
||||||
the DLL exit code !!
|
the DLL exit code !!
|
||||||
This crashes Win95 at least PM }
|
This crashes Win95 at least PM }
|
||||||
if IsLibrary then
|
if IsLibrary then
|
||||||
Exit;
|
ExitDLL(ExitCode);
|
||||||
if not IsConsole then
|
if not IsConsole then
|
||||||
begin
|
begin
|
||||||
Close(stderr);
|
Close(stderr);
|
||||||
Close(stdout);
|
Close(stdout);
|
||||||
{ what about Input and Output ?? PM }
|
{ what about Input and Output ?? PM }
|
||||||
end;
|
end;
|
||||||
|
remove_exception_handlers;
|
||||||
ExitProcess(ExitCode);
|
ExitProcess(ExitCode);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -778,10 +786,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
procedure install_exception_handlers;forward;
|
|
||||||
procedure PascalMain;external name 'PASCALMAIN';
|
|
||||||
procedure fpc_do_exit;external name 'FPC_DO_EXIT';
|
|
||||||
|
|
||||||
|
|
||||||
var
|
var
|
||||||
{ value of the stack segment
|
{ value of the stack segment
|
||||||
@ -817,33 +821,34 @@ Const
|
|||||||
DLL_THREAD_ATTACH = 2;
|
DLL_THREAD_ATTACH = 2;
|
||||||
DLL_PROCESS_DETACH = 0;
|
DLL_PROCESS_DETACH = 0;
|
||||||
DLL_THREAD_DETACH = 3;
|
DLL_THREAD_DETACH = 3;
|
||||||
|
Var
|
||||||
|
DLLBuf : Jmp_buf;
|
||||||
|
Const
|
||||||
|
DLLExitOK : boolean = true;
|
||||||
|
|
||||||
function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry'];
|
function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry'];
|
||||||
var
|
var
|
||||||
res : longbool;
|
res : longbool;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
IsLibrary:=true;
|
IsLibrary:=true;
|
||||||
|
Dll_entry:=false;
|
||||||
case DLLreason of
|
case DLLreason of
|
||||||
DLL_PROCESS_ATTACH :
|
DLL_PROCESS_ATTACH :
|
||||||
begin
|
begin
|
||||||
asm
|
If SetJmp(DLLBuf) = 0 then
|
||||||
movl %esp,%eax
|
|
||||||
movl %eax,Win32StackTop
|
|
||||||
xorl %edi,%edi
|
|
||||||
movw %ss,%di
|
|
||||||
movl %edi,_SS
|
|
||||||
end;
|
|
||||||
if assigned(Dll_Process_Attach_Hook) then
|
|
||||||
begin
|
begin
|
||||||
res:=Dll_Process_Attach_Hook(DllParam);
|
if assigned(Dll_Process_Attach_Hook) then
|
||||||
if not res then
|
|
||||||
begin
|
begin
|
||||||
Dll_entry:=false;
|
res:=Dll_Process_Attach_Hook(DllParam);
|
||||||
exit;
|
if not res then
|
||||||
|
exit(false);
|
||||||
end;
|
end;
|
||||||
end;
|
PASCALMAIN;
|
||||||
PASCALMAIN;
|
Dll_entry:=true;
|
||||||
Dll_entry:=true;
|
end
|
||||||
|
else
|
||||||
|
Dll_entry:=DLLExitOK;
|
||||||
end;
|
end;
|
||||||
DLL_THREAD_ATTACH :
|
DLL_THREAD_ATTACH :
|
||||||
begin
|
begin
|
||||||
@ -861,15 +866,22 @@ var
|
|||||||
end;
|
end;
|
||||||
DLL_PROCESS_DETACH :
|
DLL_PROCESS_DETACH :
|
||||||
begin
|
begin
|
||||||
inc(Thread_count);
|
|
||||||
Dll_entry:=true; { return value is ignored }
|
Dll_entry:=true; { return value is ignored }
|
||||||
FPC_DO_EXIT;
|
If SetJmp(DLLBuf) = 0 then
|
||||||
|
begin
|
||||||
|
FPC_DO_EXIT;
|
||||||
|
end;
|
||||||
if assigned(Dll_Process_Detach_Hook) then
|
if assigned(Dll_Process_Detach_Hook) then
|
||||||
Dll_Process_Detach_Hook(DllParam);
|
Dll_Process_Detach_Hook(DllParam);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Procedure ExitDLL(Exitcode : longint);
|
||||||
|
begin
|
||||||
|
DLLExitOK:=ExitCode=0;
|
||||||
|
LongJmp(DLLBuf,1);
|
||||||
|
end;
|
||||||
|
|
||||||
{$ifdef Set_i386_Exception_handler}
|
{$ifdef Set_i386_Exception_handler}
|
||||||
|
|
||||||
@ -1017,12 +1029,19 @@ type pexception_record = ^exception_record;
|
|||||||
SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
|
SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure remove_exception_handlers;
|
||||||
|
begin
|
||||||
|
SetUnhandledExceptionFilter(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
{$else not i386 (Processor specific !!)}
|
{$else not i386 (Processor specific !!)}
|
||||||
procedure install_exception_handlers;
|
procedure install_exception_handlers;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure remove_exception_handlers;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
{$endif Set_i386_Exception_handler}
|
{$endif Set_i386_Exception_handler}
|
||||||
|
|
||||||
@ -1161,7 +1180,11 @@ end.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.60 2000-02-09 16:59:34 peter
|
Revision 1.61 2000-03-10 09:21:11 pierre
|
||||||
|
* ExitDLL fixed : uses now SetJmp LongJmp
|
||||||
|
* System_exit unloads the exception hanlder before leaving
|
||||||
|
|
||||||
|
Revision 1.60 2000/02/09 16:59:34 peter
|
||||||
* truncated log
|
* truncated log
|
||||||
|
|
||||||
Revision 1.59 2000/02/09 12:24:39 peter
|
Revision 1.59 2000/02/09 12:24:39 peter
|
||||||
@ -1218,4 +1241,4 @@ end.
|
|||||||
Revision 1.44 1999/09/10 15:40:35 peter
|
Revision 1.44 1999/09/10 15:40:35 peter
|
||||||
* fixed do_open flags to be > $100, becuase filemode can be upto 255
|
* fixed do_open flags to be > $100, becuase filemode can be upto 255
|
||||||
|
|
||||||
}
|
}
|
Loading…
Reference in New Issue
Block a user