paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 09:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* system exception handling cleaned up

Browse Source 
* fixed setjmp for win64

git-svn-id: trunk@3228 -
This commit is contained in:
florian 2006-04-16 12:53:51 +00:00
parent c8bd730bd7
commit dff1eef6e6
3 changed files with 272 additions and 250 deletions

482
rtl/win64/system.pp
View File

@ -20,10 +20,6 @@ interface
{$define SYSTEMEXCEPTIONDEBUG}
{$endif SYSTEMDEBUG}
{$ifdef cpui386}
{$define Set_i386_Exception_handler}
{$endif cpui386}
{ include system-independent routine headers }
{$I systemh.inc}
@ -589,8 +585,6 @@ function is_prefetch(p : pointer) : boolean;
// Hardware exception handling
//
{$ifdef Set_i386_Exception_handler}
{
Error code definitions for the Win32 API functions
@ -690,74 +684,93 @@ type
Cr0NpxState : Cardinal;
end;
PContext = ^TContext;
TContext = packed record
//
// The flags values within this flag control the contents of
// a CONTEXT record.
//
ContextFlags : Cardinal;
//
// This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
// set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT
// included in CONTEXT_FULL.
//
Dr0, Dr1, Dr2,
Dr3, Dr6, Dr7 : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
//
FloatSave : TFloatingSaveArea;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_SEGMENTS.
//
SegGs, SegFs,
SegEs, SegDs : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_INTEGER.
//
Edi, Esi, Ebx,
Edx, Ecx, Eax : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_CONTROL.
//
Ebp : Cardinal;
Eip : Cardinal;
SegCs : Cardinal;
EFlags, Esp, SegSs : Cardinal;
//
// This section is specified/returned if the ContextFlags word
// contains the flag CONTEXT_EXTENDED_REGISTERS.
// The format and contexts are processor specific
//
ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
M128A = record
Low : QWord;
High : Int64;
end;
PContext = ^TContext;
TContext = record
P1Home : QWord;
P2Home : QWord;
P3Home : QWord;
P4Home : QWord;
P5Home : QWord;
P6Home : QWord;
ContextFlags : DWord;
MxCsr : DWord;
SegCs : word;
SegDs : word;
SegEs : word;
SegFs : word;
SegGs : word;
SegSs : word;
EFlags : DWord;
Dr0 : QWord;
Dr1 : QWord;
Dr2 : QWord;
Dr3 : QWord;
Dr6 : QWord;
Dr7 : QWord;
Rax : QWord;
Rcx : QWord;
Rdx : QWord;
Rbx : QWord;
Rsp : QWord;
Rbp : QWord;
Rsi : QWord;
Rdi : QWord;
R8 : QWord;
R9 : QWord;
R10 : QWord;
R11 : QWord;
R12 : QWord;
R13 : QWord;
R14 : QWord;
R15 : QWord;
Rip : QWord;
Header : array[0..1] of M128A;
Legacy : array[0..7] of M128A;
Xmm0 : M128A;
Xmm1 : M128A;
Xmm2 : M128A;
Xmm3 : M128A;
Xmm4 : M128A;
Xmm5 : M128A;
Xmm6 : M128A;
Xmm7 : M128A;
Xmm8 : M128A;
Xmm9 : M128A;
Xmm10 : M128A;
Xmm11 : M128A;
Xmm12 : M128A;
Xmm13 : M128A;
Xmm14 : M128A;
Xmm15 : M128A;
VectorRegister : array[0..25] of M128A;
VectorControl : QWord;
DebugControl : QWord;
LastBranchToRip : QWord;
LastBranchFromRip : QWord;
LastExceptionToRip : QWord;
LastExceptionFromRip : QWord;
end;
type
PExceptionRecord = ^TExceptionRecord;
TExceptionRecord = packed record
ExceptionCode : Longint;
ExceptionFlags : Longint;
ExceptionRecord : PExceptionRecord;
ExceptionAddress : Pointer;
NumberParameters : Longint;
ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
ExceptionCode : Longint;
ExceptionFlags : Longint;
ExceptionRecord : PExceptionRecord;
ExceptionAddress : Pointer;
NumberParameters : Longint;
ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
end;
PExceptionPointers = ^TExceptionPointers;
TExceptionPointers = packed record
ExceptionRecord : PExceptionRecord;
ContextRecord : PContext;
ExceptionRecord : PExceptionRecord;
ContextRecord : PContext;
end;
{ type of functions that should be used for exception handling }
@ -771,7 +784,7 @@ const
exceptLevel : Byte = 0;
var
exceptEip : array[0..MaxExceptionLevel-1] of Longint;
exceptRip : array[0..MaxExceptionLevel-1] of Int64;
exceptError : array[0..MaxExceptionLevel-1] of Byte;
resetFPU : array[0..MaxExceptionLevel-1] of Boolean;
@ -789,208 +802,177 @@ end;
{$endif SYSTEMEXCEPTIONDEBUG}
procedure JumpToHandleErrorFrame;
var
eip, ebp, error : Longint;
begin
// save ebp
asm
movl (%ebp),%eax
movl %eax,ebp
end;
if (exceptLevel > 0) then
dec(exceptLevel);
eip:=exceptEip[exceptLevel];
error:=exceptError[exceptLevel];
{$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then
writeln(stderr,'In JumpToHandleErrorFrame error=',error);
{$endif SYSTEMEXCEPTIONDEBUG}
if resetFPU[exceptLevel] then asm
fninit
fldcw fpucw
end;
{ build a fake stack }
asm
{$ifdef REGCALL}
movl ebp,%ecx
movl eip,%edx
movl error,%eax
pushl eip
movl ebp,%ebp // Change frame pointer
{$else}
movl ebp,%eax
pushl %eax
movl eip,%eax
pushl %eax
movl error,%eax
pushl %eax
movl eip,%eax
pushl %eax
movl ebp,%ebp // Change frame pointer
{$endif}
{$ifdef SYSTEMEXCEPTIONDEBUG}
jmpl DebugHandleErrorAddrFrame
{$else not SYSTEMEXCEPTIONDEBUG}
jmpl HandleErrorAddrFrame
{$endif SYSTEMEXCEPTIONDEBUG}
end;
end;
var
{ this variable is set to true, if currently an sse check is executed and no sig ill should be generated }
sse_check : boolean;
function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
var
res: longint;
err: byte;
must_reset_fpu: boolean;
begin
res := EXCEPTION_CONTINUE_SEARCH;
if excep^.ContextRecord^.SegSs=_SS then begin
err := 0;
must_reset_fpu := true;
{$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then Writeln(stderr,'Exception ',
hexstr(excep^.ExceptionRecord^.ExceptionCode, 8));
{$endif SYSTEMEXCEPTIONDEBUG}
case cardinal(excep^.ExceptionRecord^.ExceptionCode) of
STATUS_INTEGER_DIVIDE_BY_ZERO,
STATUS_FLOAT_DIVIDE_BY_ZERO :
err := 200;
STATUS_ARRAY_BOUNDS_EXCEEDED :
begin
err := 201;
must_reset_fpu := false;
end;
STATUS_STACK_OVERFLOW :
begin
err := 202;
must_reset_fpu := false;
end;
STATUS_FLOAT_OVERFLOW :
err := 205;
STATUS_FLOAT_DENORMAL_OPERAND,
STATUS_FLOAT_UNDERFLOW :
err := 206;
{excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
STATUS_FLOAT_INEXACT_RESULT,
STATUS_FLOAT_INVALID_OPERATION,
STATUS_FLOAT_STACK_CHECK :
err := 207;
STATUS_INTEGER_OVERFLOW :
begin
err := 215;
must_reset_fpu := false;
end;
STATUS_ILLEGAL_INSTRUCTION:
{ if we're testing sse support, simply set the flag and continue }
if sse_check then
begin
os_supports_sse:=false;
{ if yes, then retry }
excep^.ExceptionRecord^.ExceptionCode := 0;
res:=EXCEPTION_CONTINUE_EXECUTION;
end
else
err := 216;
STATUS_ACCESS_VIOLATION:
{ Athlon prefetch bug? }
if is_prefetch(pointer(excep^.ContextRecord^.Eip)) then
begin
{ if yes, then retry }
excep^.ExceptionRecord^.ExceptionCode := 0;
res:=EXCEPTION_CONTINUE_EXECUTION;
end
else
err := 216;
STATUS_CONTROL_C_EXIT:
err := 217;
STATUS_PRIVILEGED_INSTRUCTION:
begin
err := 218;
must_reset_fpu := false;
end;
else
begin
if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
err := 217
else
err := 255;
end;
var
rip, rbp, error : int64;
begin
// save ebp
asm
movq (%rbp),%rax
movq %rax,rbp
end;
if exceptLevel>0 then
dec(exceptLevel);
if (err <> 0) and (exceptLevel < MaxExceptionLevel) then begin
exceptEip[exceptLevel] := excep^.ContextRecord^.Eip;
exceptError[exceptLevel] := err;
resetFPU[exceptLevel] := must_reset_fpu;
inc(exceptLevel);
excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame);
excep^.ExceptionRecord^.ExceptionCode := 0;
res := EXCEPTION_CONTINUE_EXECUTION;
{$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then begin
writeln(stderr,'Exception Continue Exception set at ',
hexstr(exceptEip[exceptLevel],8));
writeln(stderr,'Eip changed to ',
hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error);
rip:=exceptRip[exceptLevel];
error:=exceptError[exceptLevel];
{$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then
writeln(stderr,'In JumpToHandleErrorFrame error=',error);
{$endif SYSTEMEXCEPTIONDEBUG}
if resetFPU[exceptLevel] then
asm
fninit
fldcw fpucw
end;
{$endif SYSTEMEXCEPTIONDEBUG}
{ build a fake stack }
asm
movq rbp,%r8
movq rip,%rdx
movq error,%rcx
pushq rip
movq rbp,%rbp // Change frame pointer
{$ifdef SYSTEMEXCEPTIONDEBUG}
jmpl DebugHandleErrorAddrFrame
{$else not SYSTEMEXCEPTIONDEBUG}
jmpl HandleErrorAddrFrame
{$endif SYSTEMEXCEPTIONDEBUG}
end;
end;
syswin32_i386_exception_handler := res;
end;
function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
var
res: longint;
err: byte;
must_reset_fpu: boolean;
begin
res := EXCEPTION_CONTINUE_SEARCH;
if excep^.ContextRecord^.SegSs=_SS then
begin
err := 0;
must_reset_fpu := true;
{$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then Writeln(stderr,'Exception ',
hexstr(excep^.ExceptionRecord^.ExceptionCode,8));
{$endif SYSTEMEXCEPTIONDEBUG}
case cardinal(excep^.ExceptionRecord^.ExceptionCode) of
STATUS_INTEGER_DIVIDE_BY_ZERO,
STATUS_FLOAT_DIVIDE_BY_ZERO :
err := 200;
STATUS_ARRAY_BOUNDS_EXCEEDED :
begin
err := 201;
must_reset_fpu := false;
end;
STATUS_STACK_OVERFLOW :
begin
err := 202;
must_reset_fpu := false;
end;
STATUS_FLOAT_OVERFLOW :
err := 205;
STATUS_FLOAT_DENORMAL_OPERAND,
STATUS_FLOAT_UNDERFLOW :
err := 206;
{ excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
STATUS_FLOAT_INEXACT_RESULT,
STATUS_FLOAT_INVALID_OPERATION,
STATUS_FLOAT_STACK_CHECK :
err := 207;
STATUS_INTEGER_OVERFLOW :
begin
err := 215;
must_reset_fpu := false;
end;
STATUS_ILLEGAL_INSTRUCTION:
err := 216;
STATUS_ACCESS_VIOLATION:
{ Athlon prefetch bug? }
if is_prefetch(pointer(excep^.ContextRecord^.rip)) then
begin
{ if yes, then retry }
excep^.ExceptionRecord^.ExceptionCode := 0;
res:=EXCEPTION_CONTINUE_EXECUTION;
end
else
err := 216;
STATUS_CONTROL_C_EXIT:
err := 217;
STATUS_PRIVILEGED_INSTRUCTION:
begin
err := 218;
must_reset_fpu := false;
end;
else
begin
if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
err := 217
else
err := 255;
end;
end;
if (err <> 0) and (exceptLevel < MaxExceptionLevel) then
begin
exceptRip[exceptLevel] := excep^.ContextRecord^.Rip;
exceptError[exceptLevel] := err;
resetFPU[exceptLevel] := must_reset_fpu;
inc(exceptLevel);
excep^.ContextRecord^.Rip := Int64(@JumpToHandleErrorFrame);
excep^.ExceptionRecord^.ExceptionCode := 0;
res := EXCEPTION_CONTINUE_EXECUTION;
{$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);
end;
{$endif SYSTEMEXCEPTIONDEBUG}
end;
end;
syswin64_x86_64_exception_handler := res;
end;
procedure install_exception_handlers;
{$ifdef SYSTEMEXCEPTIONDEBUG}
var
oldexceptaddr,
newexceptaddr : Longint;
var
oldexceptaddr,
newexceptaddr : Longint;
{$endif SYSTEMEXCEPTIONDEBUG}
begin
begin
{$ifdef SYSTEMEXCEPTIONDEBUG}
asm
movl $0,%eax
movl %fs:(%eax),%eax
movl %eax,oldexceptaddr
end;
asm
movl $0,%eax
movl %fs:(%eax),%eax
movl %eax,oldexceptaddr
end;
{$endif SYSTEMEXCEPTIONDEBUG}
SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
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));
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;
begin
SetUnhandledExceptionFilter(nil);
end;
begin
SetUnhandledExceptionFilter(nil);
end;
{$else not cpui386 (Processor specific !!)}
procedure install_exception_handlers;
begin
end;
procedure remove_exception_handlers;
begin
end;
{$endif Set_i386_Exception_handler}
{ because of the brain dead sse detection on x86, this test is post poned }
procedure fpc_cpucodeinit;
begin
end;

37
rtl/x86_64/setjump.inc
View File

@ -16,6 +16,22 @@
function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe;
asm
{$ifdef win64}
// Save registers.
movq %rbx,(%rcx)
movq %rbp,8(%rcx)
movq %r12,16(%rcx)
movq %r13,24(%rcx)
movq %r14,32(%rcx)
movq %r15,40(%rcx)
movq %rsi,64(%rcx)
movq %rdi,72(%rcx)
leaq 8(%rsp),%rdx // Save SP as it will be after we return.
movq %rdx,48(%rcx)
movq 0(%rsp),%r8 // Save PC we are returning to now.
movq %r8,56(%rcx)
xorq %rax,%rax
{$else win64}
// Save registers.
movq %rbx,(%rdi)
movq %rbp,8(%rdi)
@ -28,11 +44,31 @@ function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJM
movq 0(%rsp),%rsi // Save PC we are returning to now.
movq %rsi,56(%rdi)
xorq %rax,%rax
{$endif win64}
end;
procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP'];
asm
{$ifdef win64}
// Restore registers.
movq (%rcx),%rbx
movq 8(%rcx),%rbp
movq 16(%rcx),%r12
movq 24(%rcx),%r13
movq 32(%rcx),%r14
movq 40(%rcx),%r15
// Set return value for setjmp.
test %edx,%edx
mov $01,%eax
cmove %eax,%edx
mov %edx,%eax
movq 48(%rcx),%rsp
movq 56(%rcx),%rdx
movq 64(%rcx),%rsi
movq 72(%rcx),%rdi
jmpq *%rdx
{$else win64}
// Restore registers.
movq (%rdi),%rbx
movq 8(%rdi),%rbp
@ -48,5 +84,6 @@ procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'F
movq 56(%rdi),%rdx
movq 48(%rdi),%rsp
jmpq *%rdx
{$endif win64}
end;

3
rtl/x86_64/setjumph.inc
View File

@ -17,6 +17,9 @@
type
jmp_buf = packed record
rbx,rbp,r12,r13,r14,r15,rsp,rip : qword;
{$ifdef win64}
rsi,rdi : qword;
{$endif win64}
end;
pjmp_buf = ^jmp_buf;