diff --git a/rtl/win64/system.pp b/rtl/win64/system.pp index f5cca96caa..f23c5cddba 100644 --- a/rtl/win64/system.pp +++ b/rtl/win64/system.pp @@ -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; diff --git a/rtl/x86_64/setjump.inc b/rtl/x86_64/setjump.inc index 4b2cdb9bdf..129f084524 100644 --- a/rtl/x86_64/setjump.inc +++ b/rtl/x86_64/setjump.inc @@ -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; diff --git a/rtl/x86_64/setjumph.inc b/rtl/x86_64/setjumph.inc index 794104f071..1a0ce9eb03 100644 --- a/rtl/x86_64/setjumph.inc +++ b/rtl/x86_64/setjumph.inc @@ -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;