* system exception handling cleaned up

* fixed setjmp for win64

git-svn-id: trunk@3228 -

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);
+  var
+    rip, rbp, error : int64;
+  begin
+    // save ebp
+    asm
+      movq (%rbp),%rax
+      movq %rax,rbp
+    end;
+    if exceptLevel>0 then
+      dec(exceptLevel);
 
-        eip:=exceptEip[exceptLevel];
-        error:=exceptError[exceptLevel];
+    rip:=exceptRip[exceptLevel];
+    error:=exceptError[exceptLevel];
 {$ifdef SYSTEMEXCEPTIONDEBUG}
-        if IsConsole then
-          writeln(stderr,'In JumpToHandleErrorFrame error=',error);
+    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}
+    if resetFPU[exceptLevel] then
+      asm
+        fninit
+        fldcw   fpucw
+      end;
+    { 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
+      jmpl   DebugHandleErrorAddrFrame
 {$else not SYSTEMEXCEPTIONDEBUG}
-                jmpl   HandleErrorAddrFrame
+      jmpl   HandleErrorAddrFrame
 {$endif SYSTEMEXCEPTIONDEBUG}
-        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;
-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;
+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;
-      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
+
+        if (err <> 0) and (exceptLevel < MaxExceptionLevel) then
           begin
-            { if yes, then retry }
+            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;
-          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
-      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);
-      end;
-    {$endif SYSTEMEXCEPTIONDEBUG}
+            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;
-  syswin32_i386_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;
-
-procedure remove_exception_handlers;
-begin
-        SetUnhandledExceptionFilter(nil);
-end;
+  end;
 
-{$else not cpui386 (Processor specific !!)}
-procedure install_exception_handlers;
-begin
-end;
 
 procedure remove_exception_handlers;
-begin
-end;
+  begin
+    SetUnhandledExceptionFilter(nil);
+  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;

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;
 

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;