paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 13:47:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed system exception handling

Browse Source 
git-svn-id: trunk@3237 -
This commit is contained in:
florian 2006-04-17 07:51:10 +00:00
parent c0348fff89
commit a440cbc783
1 changed files with 56 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
rtl/win64/system.pp
View File

@ -1,9 +1,9 @@
{ {
This file is part of the Free Pascal run time library. 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. 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, See the file COPYING.FPC, included in this distribution,
for details about the copyright. 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 but don't insert it as it doesn't
point to anything yet point to anything yet
this will be used in signals unit } this will be used in signals unit }
movl %esp,%eax movq %rsp,%rax
movl %eax,System_exception_frame movq %rax,System_exception_frame
{ keep stack aligned } { keep stack aligned }
pushq $0 pushq $0
pushq %rbp pushq %rbp
@ -414,7 +414,7 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
end; end;
StackTop:=st; StackTop:=st;
asm asm
xorl %eax,%eax xorl %rax,%rax
movw %ss,%ax movw %ss,%ax
movl %eax,_SS movl %eax,_SS
call SysResetFPU call SysResetFPU
@ -653,7 +653,7 @@ const
STATUS_REG_NAT_CONSUMPTION = $C00002C9; STATUS_REG_NAT_CONSUMPTION = $C00002C9;
EXCEPTION_EXECUTE_HANDLER = 1; EXCEPTION_EXECUTE_HANDLER = 1;
EXCEPTION_CONTINUE_EXECUTION = -1; EXCEPTION_CONTINUE_EXECUTION = $fffffffff;
EXCEPTION_CONTINUE_SEARCH = 0; EXCEPTION_CONTINUE_SEARCH = 0;
EXCEPTION_MAXIMUM_PARAMETERS = 15; EXCEPTION_MAXIMUM_PARAMETERS = 15;
@ -671,19 +671,6 @@ const
MAXIMUM_SUPPORTED_EXTENSION = 512; MAXIMUM_SUPPORTED_EXTENSION = 512;
type 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 M128A = record
Low : QWord; Low : QWord;
High : Int64; High : Int64;
@ -758,12 +745,12 @@ type
type type
PExceptionRecord = ^TExceptionRecord; PExceptionRecord = ^TExceptionRecord;
TExceptionRecord = packed record TExceptionRecord = record
ExceptionCode : Longint; ExceptionCode : DWord;
ExceptionFlags : Longint; ExceptionFlags : DWord;
ExceptionRecord : PExceptionRecord; ExceptionRecord : PExceptionRecord;
ExceptionAddress : Pointer; ExceptionAddress : Pointer;
NumberParameters : Longint; NumberParameters : DWord;
ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer; ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
end; end;
@ -773,12 +760,10 @@ type
ContextRecord : PContext; ContextRecord : PContext;
end; end;
{ type of functions that should be used for exception handling } TVectoredExceptionHandler = function (excep : PExceptionPointers) : Longint;
TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
function AddVectoredExceptionHandler(FirstHandler : DWORD;VectoredHandler : TVectoredExceptionHandler) : longint;
external 'kernel32' name 'AddVectoredExceptionHandler';
const const
MaxExceptionLevel = 16; MaxExceptionLevel = 16;
exceptLevel : Byte = 0; exceptLevel : Byte = 0;
@ -789,13 +774,13 @@ var
resetFPU : array[0..MaxExceptionLevel-1] of Boolean; resetFPU : array[0..MaxExceptionLevel-1] of Boolean;
{$ifdef SYSTEMEXCEPTIONDEBUG} {$ifdef SYSTEMEXCEPTIONDEBUG}
procedure DebugHandleErrorAddrFrame(error, addr, frame : longint); procedure DebugHandleErrorAddrFrame(error : longint; addr, frame : pointer);
begin begin
if IsConsole then if IsConsole then
begin begin
write(stderr,'HandleErrorAddrFrame(error=',error); write(stderr,'HandleErrorAddrFrame(error=',error);
write(stderr,',addr=',hexstr(addr,8)); write(stderr,',addr=',hexstr(int64(addr),16));
writeln(stderr,',frame=',hexstr(frame,8),')'); writeln(stderr,',frame=',hexstr(int64(frame),16),')');
end; end;
HandleErrorAddrFrame(error,addr,frame); HandleErrorAddrFrame(error,addr,frame);
end; end;
@ -803,7 +788,8 @@ end;
procedure JumpToHandleErrorFrame; procedure JumpToHandleErrorFrame;
var var
rip, rbp, error : int64; rip, rbp : int64;
error : longint;
begin begin
// save ebp // save ebp
asm asm
@ -820,15 +806,12 @@ procedure JumpToHandleErrorFrame;
writeln(stderr,'In JumpToHandleErrorFrame error=',error); writeln(stderr,'In JumpToHandleErrorFrame error=',error);
{$endif SYSTEMEXCEPTIONDEBUG} {$endif SYSTEMEXCEPTIONDEBUG}
if resetFPU[exceptLevel] then if resetFPU[exceptLevel] then
asm SysResetFPU;
fninit
fldcw fpucw
end;
{ build a fake stack } { build a fake stack }
asm asm
movq rbp,%r8 movq rbp,%r8
movq rip,%rdx movq rip,%rdx
movq error,%rcx movl error,%ecx
pushq rip pushq rip
movq rbp,%rbp // Change frame pointer movq rbp,%rbp // Change frame pointer
@ -841,13 +824,17 @@ procedure JumpToHandleErrorFrame;
end; end;
function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint;stdcall; function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint;public;
var var
res: longint; res: longint;
err: byte; err: byte;
must_reset_fpu: boolean; must_reset_fpu: boolean;
begin begin
res:=EXCEPTION_CONTINUE_SEARCH; 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 if excep^.ContextRecord^.SegSs=_SS then
begin begin
err := 0; err := 0;
@ -928,9 +915,9 @@ function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint
{$ifdef SYSTEMEXCEPTIONDEBUG} {$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then begin if IsConsole then begin
writeln(stderr,'Exception Continue Exception set at ', writeln(stderr,'Exception Continue Exception set at ',
hexstr(exceptEip[exceptLevel],8)); hexstr(exceptRip[exceptLevel-1],16));
writeln(stderr,'Eip changed to ', writeln(stderr,'Rip changed to ',
hexstr(int64(@JumpToHandleErrorFrame),16), ' error=', error); hexstr(int64(@JumpToHandleErrorFrame),16), ' error=', err);
end; end;
{$endif SYSTEMEXCEPTIONDEBUG} {$endif SYSTEMEXCEPTIONDEBUG}
end; end;
@ -938,38 +925,16 @@ function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint
syswin64_x86_64_exception_handler := res; syswin64_x86_64_exception_handler := res;
end; end;
procedure install_exception_handlers;
{$ifdef SYSTEMEXCEPTIONDEBUG}
var
oldexceptaddr,
newexceptaddr : Longint;
{$endif SYSTEMEXCEPTIONDEBUG}
procedure install_exception_handlers;
begin begin
{$ifdef SYSTEMEXCEPTIONDEBUG} AddVectoredExceptionHandler(1,@syswin64_x86_64_exception_handler);
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}
end; end;
procedure remove_exception_handlers; procedure remove_exception_handlers;
begin begin
SetUnhandledExceptionFilter(nil);
end; end;
@ -1176,6 +1141,7 @@ const
} }
begin begin
SysResetFPU;
StackLength := CheckInitialStkLen(InitialStkLen); StackLength := CheckInitialStkLen(InitialStkLen);
StackBottom := StackTop - StackLength; StackBottom := StackTop - StackLength;
{ get some helpful informations } { get some helpful informations }