|
@@ -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
|
|
|
|
- movl %esp,%eax
|
|
|
|
- movl %eax,Win32StackTop
|
|
|
|
- xorl %edi,%edi
|
|
|
|
- movw %ss,%di
|
|
|
|
- movl %edi,_SS
|
|
|
|
- end;
|
|
|
|
- if assigned(Dll_Process_Attach_Hook) then
|
|
|
|
|
|
+ If SetJmp(DLLBuf) = 0 then
|
|
begin
|
|
begin
|
|
- res:=Dll_Process_Attach_Hook(DllParam);
|
|
|
|
- if not res then
|
|
|
|
|
|
+ if assigned(Dll_Process_Attach_Hook) then
|
|
begin
|
|
begin
|
|
- Dll_entry:=false;
|
|
|
|
- exit;
|
|
|
|
|
|
+ res:=Dll_Process_Attach_Hook(DllParam);
|
|
|
|
+ if not res then
|
|
|
|
+ exit(false);
|
|
end;
|
|
end;
|
|
- end;
|
|
|
|
- PASCALMAIN;
|
|
|
|
- Dll_entry:=true;
|
|
|
|
|
|
+ PASCALMAIN;
|
|
|
|
+ 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
|
|
|
|
|
|
-}
|
|
|
|
|
|
+}
|