paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 18:29:09 +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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

206
rtl/win64/system.pp
View File

@ -20,10 +20,6 @@ interface
{$define SYSTEMEXCEPTIONDEBUG} {$define SYSTEMEXCEPTIONDEBUG}
{$endif SYSTEMDEBUG} {$endif SYSTEMDEBUG}
{$ifdef cpui386}
{$define Set_i386_Exception_handler}
{$endif cpui386}
{ include system-independent routine headers } { include system-independent routine headers }
{$I systemh.inc} {$I systemh.inc}
@ -589,8 +585,6 @@ function is_prefetch(p : pointer) : boolean;
// Hardware exception handling // Hardware exception handling
// //
{$ifdef Set_i386_Exception_handler}
{ {
Error code definitions for the Win32 API functions Error code definitions for the Win32 API functions
@ -690,57 +684,76 @@ type
Cr0NpxState : Cardinal; Cr0NpxState : Cardinal;
end; end;
M128A = record
Low : QWord;
High : Int64;
end;
PContext = ^TContext; PContext = ^TContext;
TContext = packed record TContext = record
// P1Home : QWord;
// The flags values within this flag control the contents of P2Home : QWord;
// a CONTEXT record. P3Home : QWord;
// P4Home : QWord;
ContextFlags : Cardinal; P5Home : QWord;
P6Home : QWord;
// ContextFlags : DWord;
// This section is specified/returned if CONTEXT_DEBUG_REGISTERS is MxCsr : DWord;
// set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT SegCs : word;
// included in CONTEXT_FULL. SegDs : word;
// SegEs : word;
Dr0, Dr1, Dr2, SegFs : word;
Dr3, Dr6, Dr7 : Cardinal; SegGs : word;
SegSs : word;
// EFlags : DWord;
// This section is specified/returned if the Dr0 : QWord;
// ContextFlags word contains the flag CONTEXT_FLOATING_POINT. Dr1 : QWord;
// Dr2 : QWord;
FloatSave : TFloatingSaveArea; Dr3 : QWord;
Dr6 : QWord;
// Dr7 : QWord;
// This section is specified/returned if the Rax : QWord;
// ContextFlags word contains the flag CONTEXT_SEGMENTS. Rcx : QWord;
// Rdx : QWord;
SegGs, SegFs, Rbx : QWord;
SegEs, SegDs : Cardinal; Rsp : QWord;
Rbp : QWord;
// Rsi : QWord;
// This section is specified/returned if the Rdi : QWord;
// ContextFlags word contains the flag CONTEXT_INTEGER. R8 : QWord;
// R9 : QWord;
Edi, Esi, Ebx, R10 : QWord;
Edx, Ecx, Eax : Cardinal; R11 : QWord;
R12 : QWord;
// R13 : QWord;
// This section is specified/returned if the R14 : QWord;
// ContextFlags word contains the flag CONTEXT_CONTROL. R15 : QWord;
// Rip : QWord;
Ebp : Cardinal; Header : array[0..1] of M128A;
Eip : Cardinal; Legacy : array[0..7] of M128A;
SegCs : Cardinal; Xmm0 : M128A;
EFlags, Esp, SegSs : Cardinal; Xmm1 : M128A;
Xmm2 : M128A;
// Xmm3 : M128A;
// This section is specified/returned if the ContextFlags word Xmm4 : M128A;
// contains the flag CONTEXT_EXTENDED_REGISTERS. Xmm5 : M128A;
// The format and contexts are processor specific Xmm6 : M128A;
// Xmm7 : M128A;
ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte; 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; end;
type type
@ -771,7 +784,7 @@ const
exceptLevel : Byte = 0; exceptLevel : Byte = 0;
var var
exceptEip : array[0..MaxExceptionLevel-1] of Longint; exceptRip : array[0..MaxExceptionLevel-1] of Int64;
exceptError : array[0..MaxExceptionLevel-1] of Byte; exceptError : array[0..MaxExceptionLevel-1] of Byte;
resetFPU : array[0..MaxExceptionLevel-1] of Boolean; resetFPU : array[0..MaxExceptionLevel-1] of Boolean;
@ -790,45 +803,34 @@ end;
procedure JumpToHandleErrorFrame; procedure JumpToHandleErrorFrame;
var var
eip, ebp, error : Longint; rip, rbp, error : int64;
begin begin
// save ebp // save ebp
asm asm
movl (%ebp),%eax movq (%rbp),%rax
movl %eax,ebp movq %rax,rbp
end; end;
if (exceptLevel > 0) then if exceptLevel>0 then
dec(exceptLevel); dec(exceptLevel);
eip:=exceptEip[exceptLevel]; rip:=exceptRip[exceptLevel];
error:=exceptError[exceptLevel]; error:=exceptError[exceptLevel];
{$ifdef SYSTEMEXCEPTIONDEBUG} {$ifdef SYSTEMEXCEPTIONDEBUG}
if IsConsole then if IsConsole then
writeln(stderr,'In JumpToHandleErrorFrame error=',error); writeln(stderr,'In JumpToHandleErrorFrame error=',error);
{$endif SYSTEMEXCEPTIONDEBUG} {$endif SYSTEMEXCEPTIONDEBUG}
if resetFPU[exceptLevel] then asm if resetFPU[exceptLevel] then
asm
fninit fninit
fldcw fpucw fldcw fpucw
end; end;
{ build a fake stack } { build a fake stack }
asm asm
{$ifdef REGCALL} movq rbp,%r8
movl ebp,%ecx movq rip,%rdx
movl eip,%edx movq error,%rcx
movl error,%eax pushq rip
pushl eip movq rbp,%rbp // Change frame pointer
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} {$ifdef SYSTEMEXCEPTIONDEBUG}
jmpl DebugHandleErrorAddrFrame jmpl DebugHandleErrorAddrFrame
@ -838,18 +840,16 @@ begin
end; end;
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; function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
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;
if excep^.ContextRecord^.SegSs=_SS then begin if excep^.ContextRecord^.SegSs=_SS then
begin
err := 0; err := 0;
must_reset_fpu := true; must_reset_fpu := true;
{$ifdef SYSTEMEXCEPTIONDEBUG} {$ifdef SYSTEMEXCEPTIONDEBUG}
@ -886,19 +886,10 @@ begin
must_reset_fpu := false; must_reset_fpu := false;
end; end;
STATUS_ILLEGAL_INSTRUCTION: 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; err := 216;
STATUS_ACCESS_VIOLATION: STATUS_ACCESS_VIOLATION:
{ Athlon prefetch bug? } { Athlon prefetch bug? }
if is_prefetch(pointer(excep^.ContextRecord^.Eip)) then if is_prefetch(pointer(excep^.ContextRecord^.rip)) then
begin begin
{ if yes, then retry } { if yes, then retry }
excep^.ExceptionRecord^.ExceptionCode := 0; excep^.ExceptionRecord^.ExceptionCode := 0;
@ -923,13 +914,14 @@ begin
end; end;
end; end;
if (err <> 0) and (exceptLevel < MaxExceptionLevel) then begin if (err <> 0) and (exceptLevel < MaxExceptionLevel) then
exceptEip[exceptLevel] := excep^.ContextRecord^.Eip; begin
exceptRip[exceptLevel] := excep^.ContextRecord^.Rip;
exceptError[exceptLevel] := err; exceptError[exceptLevel] := err;
resetFPU[exceptLevel] := must_reset_fpu; resetFPU[exceptLevel] := must_reset_fpu;
inc(exceptLevel); inc(exceptLevel);
excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame); excep^.ContextRecord^.Rip := Int64(@JumpToHandleErrorFrame);
excep^.ExceptionRecord^.ExceptionCode := 0; excep^.ExceptionRecord^.ExceptionCode := 0;
res := EXCEPTION_CONTINUE_EXECUTION; res := EXCEPTION_CONTINUE_EXECUTION;
@ -938,12 +930,12 @@ begin
writeln(stderr,'Exception Continue Exception set at ', writeln(stderr,'Exception Continue Exception set at ',
hexstr(exceptEip[exceptLevel],8)); hexstr(exceptEip[exceptLevel],8));
writeln(stderr,'Eip changed to ', writeln(stderr,'Eip changed to ',
hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error); hexstr(int64(@JumpToHandleErrorFrame),16), ' error=', error);
end; end;
{$endif SYSTEMEXCEPTIONDEBUG} {$endif SYSTEMEXCEPTIONDEBUG}
end; end;
end; end;
syswin32_i386_exception_handler := res; syswin64_x86_64_exception_handler := res;
end; end;
procedure install_exception_handlers; procedure install_exception_handlers;
@ -961,7 +953,7 @@ begin
movl %eax,oldexceptaddr movl %eax,oldexceptaddr
end; end;
{$endif SYSTEMEXCEPTIONDEBUG} {$endif SYSTEMEXCEPTIONDEBUG}
SetUnhandledExceptionFilter(@syswin32_i386_exception_handler); SetUnhandledExceptionFilter(@syswin64_x86_64_exception_handler);
{$ifdef SYSTEMEXCEPTIONDEBUG} {$ifdef SYSTEMEXCEPTIONDEBUG}
asm asm
movl $0,%eax movl $0,%eax
@ -974,23 +966,13 @@ begin
{$endif SYSTEMEXCEPTIONDEBUG} {$endif SYSTEMEXCEPTIONDEBUG}
end; end;
procedure remove_exception_handlers; procedure remove_exception_handlers;
begin begin
SetUnhandledExceptionFilter(nil); SetUnhandledExceptionFilter(nil);
end; 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; procedure fpc_cpucodeinit;
begin begin
end; 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; function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe;
asm 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. // Save registers.
movq %rbx,(%rdi) movq %rbx,(%rdi)
movq %rbp,8(%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 0(%rsp),%rsi // Save PC we are returning to now.
movq %rsi,56(%rdi) movq %rsi,56(%rdi)
xorq %rax,%rax xorq %rax,%rax
{$endif win64}
end; end;
procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP'];
asm 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. // Restore registers.
movq (%rdi),%rbx movq (%rdi),%rbx
movq 8(%rdi),%rbp 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 56(%rdi),%rdx
movq 48(%rdi),%rsp movq 48(%rdi),%rsp
jmpq *%rdx jmpq *%rdx
{$endif win64}
end; end;

3
rtl/x86_64/setjumph.inc
View File

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