mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-06 08:47:10 +01:00
* fixed system exception handling
git-svn-id: trunk@3237 -
This commit is contained in:
florian
parent
c0348fff89
commit
a440cbc783
@ -1,9 +1,9 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2005 by Florian Klaempfl and Pavel Ozerski
|
||||
Copyright (c) 1999-2006 by Florian Klaempfl and Pavel Ozerski
|
||||
member of the Free Pascal development team.
|
||||
|
||||
FPC Pascal system unit for the Win32 API.
|
||||
FPC Pascal system unit for the Win64 API.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
@ -404,8 +404,8 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
|
||||
but don't insert it as it doesn't
|
||||
point to anything yet
|
||||
this will be used in signals unit }
|
||||
movl %esp,%eax
|
||||
movl %eax,System_exception_frame
|
||||
movq %rsp,%rax
|
||||
movq %rax,System_exception_frame
|
||||
{ keep stack aligned }
|
||||
pushq $0
|
||||
pushq %rbp
|
||||
@ -414,7 +414,7 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
|
||||
end;
|
||||
StackTop:=st;
|
||||
asm
|
||||
xorl %eax,%eax
|
||||
xorl %rax,%rax
|
||||
movw %ss,%ax
|
||||
movl %eax,_SS
|
||||
call SysResetFPU
|
||||
@ -653,7 +653,7 @@ const
|
||||
STATUS_REG_NAT_CONSUMPTION = $C00002C9;
|
||||
|
||||
EXCEPTION_EXECUTE_HANDLER = 1;
|
||||
EXCEPTION_CONTINUE_EXECUTION = -1;
|
||||
EXCEPTION_CONTINUE_EXECUTION = $fffffffff;
|
||||
EXCEPTION_CONTINUE_SEARCH = 0;
|
||||
|
||||
EXCEPTION_MAXIMUM_PARAMETERS = 15;
|
||||
@ -671,19 +671,6 @@ const
|
||||
MAXIMUM_SUPPORTED_EXTENSION = 512;
|
||||
|
||||
type
|
||||
PFloatingSaveArea = ^TFloatingSaveArea;
|
||||
TFloatingSaveArea = packed record
|
||||
ControlWord : Cardinal;
|
||||
StatusWord : Cardinal;
|
||||
TagWord : Cardinal;
|
||||
ErrorOffset : Cardinal;
|
||||
ErrorSelector : Cardinal;
|
||||
DataOffset : Cardinal;
|
||||
DataSelector : Cardinal;
|
||||
RegisterArea : array[0..79] of Byte;
|
||||
Cr0NpxState : Cardinal;
|
||||
end;
|
||||
|
||||
M128A = record
|
||||
Low : QWord;
|
||||
High : Int64;
|
||||
@ -758,12 +745,12 @@ type
|
||||
|
||||
type
|
||||
PExceptionRecord = ^TExceptionRecord;
|
||||
TExceptionRecord = packed record
|
||||
ExceptionCode : Longint;
|
||||
ExceptionFlags : Longint;
|
||||
TExceptionRecord = record
|
||||
ExceptionCode : DWord;
|
||||
ExceptionFlags : DWord;
|
||||
ExceptionRecord : PExceptionRecord;
|
||||
ExceptionAddress : Pointer;
|
||||
NumberParameters : Longint;
|
||||
NumberParameters : DWord;
|
||||
ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
|
||||
end;
|
||||
|
||||
@ -773,12 +760,10 @@ type
|
||||
ContextRecord : PContext;
|
||||
end;
|
||||
|
||||
{ type of functions that should be used for exception handling }
|
||||
TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
|
||||
|
||||
function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
|
||||
stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
|
||||
TVectoredExceptionHandler = function (excep : PExceptionPointers) : Longint;
|
||||
|
||||
function AddVectoredExceptionHandler(FirstHandler : DWORD;VectoredHandler : TVectoredExceptionHandler) : longint;
|
||||
external 'kernel32' name 'AddVectoredExceptionHandler';
|
||||
const
|
||||
MaxExceptionLevel = 16;
|
||||
exceptLevel : Byte = 0;
|
||||
@ -789,13 +774,13 @@ var
|
||||
resetFPU : array[0..MaxExceptionLevel-1] of Boolean;
|
||||
|
||||
{$ifdef SYSTEMEXCEPTIONDEBUG}
|
||||
procedure DebugHandleErrorAddrFrame(error, addr, frame : longint);
|
||||
procedure DebugHandleErrorAddrFrame(error : longint; addr, frame : pointer);
|
||||
begin
|
||||
if IsConsole then
|
||||
begin
|
||||
write(stderr,'HandleErrorAddrFrame(error=',error);
|
||||
write(stderr,',addr=',hexstr(addr,8));
|
||||
writeln(stderr,',frame=',hexstr(frame,8),')');
|
||||
write(stderr,',addr=',hexstr(int64(addr),16));
|
||||
writeln(stderr,',frame=',hexstr(int64(frame),16),')');
|
||||
end;
|
||||
HandleErrorAddrFrame(error,addr,frame);
|
||||
end;
|
||||
@ -803,7 +788,8 @@ end;
|
||||
|
||||
procedure JumpToHandleErrorFrame;
|
||||
var
|
||||
rip, rbp, error : int64;
|
||||
rip, rbp : int64;
|
||||
error : longint;
|
||||
begin
|
||||
// save ebp
|
||||
asm
|
||||
@ -820,15 +806,12 @@ procedure JumpToHandleErrorFrame;
|
||||
writeln(stderr,'In JumpToHandleErrorFrame error=',error);
|
||||
{$endif SYSTEMEXCEPTIONDEBUG}
|
||||
if resetFPU[exceptLevel] then
|
||||
asm
|
||||
fninit
|
||||
fldcw fpucw
|
||||
end;
|
||||
SysResetFPU;
|
||||
{ build a fake stack }
|
||||
asm
|
||||
movq rbp,%r8
|
||||
movq rip,%rdx
|
||||
movq error,%rcx
|
||||
movl error,%ecx
|
||||
pushq rip
|
||||
movq rbp,%rbp // Change frame pointer
|
||||
|
||||
@ -841,13 +824,17 @@ procedure JumpToHandleErrorFrame;
|
||||
end;
|
||||
|
||||
|
||||
function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
|
||||
function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint;public;
|
||||
var
|
||||
res: longint;
|
||||
err: byte;
|
||||
must_reset_fpu: boolean;
|
||||
begin
|
||||
res:=EXCEPTION_CONTINUE_SEARCH;
|
||||
{$ifdef SYSTEMEXCEPTIONDEBUG}
|
||||
if IsConsole then
|
||||
Writeln(stderr,'syswin64_x86_64_exception_handler called');
|
||||
{$endif SYSTEMEXCEPTIONDEBUG}
|
||||
if excep^.ContextRecord^.SegSs=_SS then
|
||||
begin
|
||||
err := 0;
|
||||
@ -928,9 +915,9 @@ function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint
|
||||
{$ifdef SYSTEMEXCEPTIONDEBUG}
|
||||
if IsConsole then begin
|
||||
writeln(stderr,'Exception Continue Exception set at ',
|
||||
hexstr(exceptEip[exceptLevel],8));
|
||||
writeln(stderr,'Eip changed to ',
|
||||
hexstr(int64(@JumpToHandleErrorFrame),16), ' error=', error);
|
||||
hexstr(exceptRip[exceptLevel-1],16));
|
||||
writeln(stderr,'Rip changed to ',
|
||||
hexstr(int64(@JumpToHandleErrorFrame),16), ' error=', err);
|
||||
end;
|
||||
{$endif SYSTEMEXCEPTIONDEBUG}
|
||||
end;
|
||||
@ -938,38 +925,16 @@ function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint
|
||||
syswin64_x86_64_exception_handler := res;
|
||||
end;
|
||||
|
||||
procedure install_exception_handlers;
|
||||
{$ifdef SYSTEMEXCEPTIONDEBUG}
|
||||
var
|
||||
oldexceptaddr,
|
||||
newexceptaddr : Longint;
|
||||
{$endif SYSTEMEXCEPTIONDEBUG}
|
||||
|
||||
|
||||
procedure install_exception_handlers;
|
||||
begin
|
||||
{$ifdef SYSTEMEXCEPTIONDEBUG}
|
||||
asm
|
||||
movl $0,%eax
|
||||
movl %fs:(%eax),%eax
|
||||
movl %eax,oldexceptaddr
|
||||
end;
|
||||
{$endif SYSTEMEXCEPTIONDEBUG}
|
||||
SetUnhandledExceptionFilter(@syswin64_x86_64_exception_handler);
|
||||
{$ifdef SYSTEMEXCEPTIONDEBUG}
|
||||
asm
|
||||
movl $0,%eax
|
||||
movl %fs:(%eax),%eax
|
||||
movl %eax,newexceptaddr
|
||||
end;
|
||||
if IsConsole then
|
||||
writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8),
|
||||
' new exception ',hexstr(newexceptaddr,8));
|
||||
{$endif SYSTEMEXCEPTIONDEBUG}
|
||||
AddVectoredExceptionHandler(1,@syswin64_x86_64_exception_handler);
|
||||
end;
|
||||
|
||||
|
||||
procedure remove_exception_handlers;
|
||||
begin
|
||||
SetUnhandledExceptionFilter(nil);
|
||||
end;
|
||||
|
||||
|
||||
@ -1176,6 +1141,7 @@ const
|
||||
}
|
||||
|
||||
begin
|
||||
SysResetFPU;
|
||||
StackLength := CheckInitialStkLen(InitialStkLen);
|
||||
StackBottom := StackTop - StackLength;
|
||||
{ get some helpful informations }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user