win64: use vectored exception handler only when necessary

Windows exceptions can originate in both software and hardware and can
be handled by vectored exception handlers and frame-based exception
handlers.

Vectored exception handlers are triggered first in a fashion similar
to UNIX signal handlers. They are established globally for the SBCL
process and catch exceptions signalled in any thread. Afterwards,
frame-based exception handlers are searched starting in the current
stack frame, continuing through to preceding frames until an
applicable handler is found.

SBCL's vectored exception handler was handling virtually all
exceptions, with unknown exceptions yielding a Lisp error. This is
problematic with FFI, since the handler would catch every exception,
including those that would otherwise be gracefully handled within
foreign code. (Notably, win32's open file dialog will raise and handle
exceptions internally.) This commit restricts our vectored exception
handler to EXCEPTION_ACCESS_VIOLATION and exceptions that are
triggered by Lisp code.

In the interest of interactive development and/or error logging, we
need to do something about unhandled exceptions coming from foreign
code which by default would cause the kernel to terminate our
process. This is handled by a frame-based exception handler
established by set_up_win64_seh_thunk() in coordination with
EMIT-C-CALL, both of which contain comments explaining how the
(somewhat convoluted) mechanism works.

package-data-list.lisp-expr

@@ -3256,6 +3256,7 @@ structure representations"
                "VECTOR-WEAK-VISITED-FLAG"
                "VECTOR-HASHING-FLAG"
                "VECTOR-ADDR-HASHING-FLAG"
+               #+(and win32 x86-64) "WIN64-SEH-DATA-ADDR"
                "WEAK-POINTER-NEXT-SLOT"
                "WEAK-POINTER-SIZE" "WEAK-POINTER-WIDETAG"
                "WEAK-POINTER-VALUE-SLOT"

src/assembly/x86-64/tramps.lisp

@@ -77,6 +77,13 @@
   (inst push (ea n-word-bytes rbp-tn))
   (inst jmp (ea (- (* closure-fun-slot n-word-bytes) fun-pointer-lowtag) rax)))
 
+#+win32
+(define-assembly-routine
+    (undefined-alien-tramp (:return-style :none))
+    ()
+  (error-call nil 'undefined-alien-fun-error rbx-tn))
+
+#-win32
 (define-assembly-routine
     (undefined-alien-tramp (:return-style :none))
     ()

src/compiler/generic/genesis.lisp

@@ -3007,6 +3007,10 @@ Legal values for OFFSET are -4, -8, -12, ..."
 
   (terpri)
 
+  #+(and win32 x86-64)
+  (format t "#define WIN64_SEH_DATA_ADDR ((void*)~DUL) /* ~:*0x~X */~%"
+            sb-vm:win64-seh-data-addr)
+
   ;; FIXME: The SPARC has a PSEUDO-ATOMIC-TRAP that differs between
   ;; platforms. If we export this from the SB-VM package, it gets
   ;; written out as #define trap_PseudoAtomic, which is confusing as

src/compiler/generic/parms.lisp

@@ -79,6 +79,8 @@
                )))
     (let*
         ((spaces (append `((read-only ,ro-space-size)
+                           #+(and win32 x86-64)
+                           (seh-data ,(symbol-value '+backend-page-bytes+) win64-seh-data-addr)
                            (linkage-table ,small-space-size)
                            #+sb-safepoint
                            ;; Must be just before NIL.

src/compiler/x86-64/c-call.lisp

@@ -281,13 +281,17 @@
   (:temporary (:sc unsigned-reg :offset rax-offset :to :result) rax)
   #+sb-safepoint
   (:temporary (:sc unsigned-stack :from :eval :to :result) pc-save)
+  #+win32
+  (:temporary (:sc unsigned-reg :offset r15-offset :from :eval :to :result) r15)
   (:ignore results)
   (:vop-var vop)
   (:generator 0
     (move rbx function)
     (emit-c-call vop rax rbx args
                  sb-alien::*alien-fun-type-varargs-default*
-                 #+sb-safepoint pc-save))
+                 #+sb-safepoint pc-save
+                 #+win32 rbx))
+  #+win32 (:ignore r15)
   . #.(destroyed-c-registers))
 
 ;;; Calls to C can generally be made without loading a register
@@ -299,13 +303,26 @@
   (:temporary (:sc unsigned-reg :offset rax-offset :to :result) rax)
   #+sb-safepoint
   (:temporary (:sc unsigned-stack :from :eval :to :result) pc-save)
+  #+win32
+  (:temporary (:sc unsigned-reg :offset r15-offset :from :eval :to :result) r15)
+  #+win32
+  (:ignore r15)
+  #+win32
+  (:temporary (:sc unsigned-reg :offset rbx-offset :from :eval :to :result) rbx)
   (:ignore results)
   (:vop-var vop)
   (:generator 0
-    (emit-c-call vop rax c-symbol args varargsp #+sb-safepoint pc-save))
+    (emit-c-call vop rax c-symbol args varargsp
+                 #+sb-safepoint pc-save
+                 #+win32 rbx))
   . #.(destroyed-c-registers))
 
-(defun emit-c-call (vop rax fun args varargsp #+sb-safepoint pc-save)
+#+win32
+(defconstant win64-seh-direct-thunk-addr win64-seh-data-addr)
+#+win32
+(defconstant win64-seh-indirect-thunk-addr (+ win64-seh-data-addr 8))
+
+(defun emit-c-call (vop rax fun args varargsp #+sb-safepoint pc-save #+win32 rbx)
   (declare (ignorable varargsp))
   ;; Current PC - don't rely on function to keep it in a form that
   ;; GC understands
@@ -349,9 +366,24 @@
   ;; where ea is the address of the linkage table entry's operand.
   ;; So while the former is a jump to a jump, we can optimize out
   ;; one jump in a statically linked executable.
+  #-win32
   (inst call (cond ((tn-p fun) fun)
                    ((sb-c::code-immobile-p vop) (make-fixup fun :foreign))
                    (t (ea (make-fixup fun :foreign 8)))))
+  ;; On win64, we don't support immobile space (yet) and calls go through one of
+  ;; the thunks defined in set_up_win64_seh_data(). If the linkage table is
+  ;; involved, RBX either points to a linkage table trampoline or to the linkage
+  ;; table operand; this simplifies UNDEFINED-ALIEN-TRAMP's job.
+  #+win32
+  (cond ((tn-p fun)
+         (move rbx fun)
+         (inst mov rax win64-seh-direct-thunk-addr)
+         (inst call rax))
+        (t
+         (inst mov rbx (make-fixup fun :foreign 8))
+         (inst mov rax win64-seh-indirect-thunk-addr)
+         (inst call rax)))
+
   ;; For the undefined alien error
   (note-this-location vop :internal-error)
   #+win32 (inst add rsp-tn #x20)       ;MS_ABI: remove shadow space

src/runtime/win32-os.c

@@ -58,6 +58,7 @@
 #include "validate.h"
 #include "thread.h"
 #include "align.h"
+#include "unaligned.h"
 
 #include "gc.h"
 #include "gencgc-internal.h"
@@ -715,6 +716,127 @@ intptr_t win32_get_module_handle_by_address(os_vm_address_t addr)
                       ? result : 0);
 }
 
+/*
+ * x86-64 exception handling around foreign function calls.
+ *
+ * On x86-64, when an exception is raised, the Windows kernel looks up the RIP
+ * to retrieve an associated UNWIND_INFO object. This object informs the kernel
+ * whether there's an exception handler and how to find the start of the current
+ * frame. If there's no exception handler or it has declined to handle the
+ * exception, the frame's return address is looked up and the process is
+ * repeated, walking the stack until an exception handler handles the exception.
+ * If the exception goes unhandled, the process is usually terminated. Our goal,
+ * then, is to associate an appropriate UNWIND_INFO object with return addresses
+ * that point to Lisp code. We don't need to inform the kernel how to walk a
+ * Lisp frame, since our exception handler will always handle the exception.
+ *
+ * UNWIND_INFO objects are mapped onto their respective address ranges by
+ * RUNTIME_FUNCTION objects. These objects are usually stored in the .pdata
+ * section of an executable file, but can also be mapped dynamically via
+ * RtlAddFunctionTable().
+ *
+ * A major constraint imposed by UNWIND_INFO and RUNTIME_FUNCTION is that the
+ * code's address range is specified by 32-bit relative addresses, which means
+ * we can only establish a frame-based handler for a 4 GB region at most. This
+ * is problematic because most Lisp code lives in dynamic space which can be
+ * much larger than 4 GB. Furthermore, the exception handler is also specified
+ * as a 32-bit relative address, so we can't directly reference our
+ * handle_exception() function.
+ *
+ * We work around this constraint by allocating these data structures in a fixed
+ * memory region at WIN64_SEH_DATA_ADDR and map an UNWIND_INFO to this region
+ * using RtlAddFunctionTable(). Foreign calls (see EMIT-C-CALL) place the target
+ * address in RBX and call a thunk within this region. The thunk swaps out the
+ * return address with the thunk's return address thereby establishing a
+ * frame-based exception handler. The original address (pointing into Lisp code)
+ * is stored in a non-volatile, callee-saved register, allowing the thunk to
+ * jump back to Lisp. The exception handler is a trampoline to
+ * handle_exception().
+ *
+ * In the future, should we segregate code objects into dedicated code areas
+ * smaller than 4 GB, these thunks could be removed, and UNWIND_INFO could be
+ * associated directly with such areas.
+ */
+
+#ifdef LISP_FEATURE_X86_64
+typedef struct _UNWIND_INFO {
+  uint8_t Version : 3;
+  uint8_t Flags : 5;
+  uint8_t SizeOfProlog;
+  uint8_t CountOfCodes;
+  uint8_t FrameRegister : 4;
+  uint8_t FrameOffset : 4;
+  ULONG ExceptionHandler;
+  ULONG ExceptionData[1];
+} UNWIND_INFO;
+
+struct win64_seh_data {
+    uint8_t direct_thunk[8];
+    uint8_t indirect_thunk[8];
+    uint8_t handler_trampoline[16];
+    UNWIND_INFO ui; // needs to be DWORD-aligned
+    RUNTIME_FUNCTION rt;
+};
+
+static void
+set_up_win64_seh_thunk(size_t page_size)
+{
+    if (page_size < sizeof(struct win64_seh_data))
+        lose("Not enough space to allocate struct win64_seh_data");
+
+    AVER(VirtualAlloc(WIN64_SEH_DATA_ADDR, page_size,
+                      MEM_RESERVE | MEM_COMMIT, PAGE_EXECUTE_READWRITE));
+
+    struct win64_seh_data *seh_data = (void *) WIN64_SEH_DATA_ADDR;
+    DWORD64 base = (DWORD64) seh_data;
+
+    uint8_t *dthunk = seh_data->direct_thunk;
+    dthunk[0] = 0x41; // pop r15
+    dthunk[1] = 0x5F;
+    dthunk[2] = 0xFF; // call rbx
+    dthunk[3] = 0xD3;
+    dthunk[4] = 0x41; // push r15
+    dthunk[5] = 0x57;
+    dthunk[6] = 0xC3; // ret
+    dthunk[7] = 0x90; // nop (padding)
+
+    uint8_t *ithunk = seh_data->indirect_thunk;
+    ithunk[0] = 0x41; // pop r15
+    ithunk[1] = 0x5F;
+    ithunk[2] = 0xFF; // call qword ptr [rbx]
+    ithunk[3] = 0x13;
+    ithunk[4] = 0x41; // push r15
+    ithunk[5] = 0x57;
+    ithunk[6] = 0xC3; // ret
+    ithunk[7] = 0x90; // nop (padding)
+
+    uint8_t *tramp = seh_data->handler_trampoline;
+    tramp[0] = 0xFF; // jmp qword ptr [rip+2]
+    tramp[1] = 0x25;
+    UNALIGNED_STORE32((tramp+2), 2);
+    tramp[6] = 0x66; // 2-byte nop
+    tramp[7] = 0x90;
+    *(void **)(tramp+8) = handle_exception;
+
+    UNWIND_INFO *ui = &seh_data->ui;
+    ui->Version = 1;
+    ui->Flags = UNW_FLAG_EHANDLER;
+    ui->SizeOfProlog = 0;
+    ui->CountOfCodes = 0;
+    ui->FrameRegister = 0;
+    ui->FrameOffset = 0;
+    ui->ExceptionHandler = (DWORD64) tramp - base;
+    ui->ExceptionData[0] = 0;
+
+    RUNTIME_FUNCTION *rt = &seh_data->rt;
+    rt->BeginAddress = 0;
+    rt->EndAddress = 16;
+    rt->UnwindData = (DWORD64) ui - base;
+
+    AVER(RtlAddFunctionTable(rt, 1, base));
+}
+#endif
+
 static LARGE_INTEGER lisp_init_time;
 static double qpcMultiplier;
 
@@ -743,6 +865,10 @@ void os_init(char __attribute__((__unused__)) *argv[],
 #endif
     os_number_of_processors = system_info.dwNumberOfProcessors;
 
+#ifdef LISP_FEATURE_X86_64
+    set_up_win64_seh_thunk(os_vm_page_size);
+#endif
+
     resolve_optional_imports();
     runtime_module_handle = (HMODULE)win32_get_module_handle_by_address(&runtime_module_handle);
 }
@@ -1105,18 +1231,11 @@ signal_internal_error_or_lose(os_context_t *ctx,
     lose("Exception too early in cold init, cannot continue.");
 }
 
-/*
- * A good explanation of the exception handling semantics is
- *   http://win32assembly.online.fr/Exceptionhandling.html (possibly defunct)
- * or:
- *   http://www.microsoft.com/msj/0197/exception/exception.aspx
- */
-
-EXCEPTION_DISPOSITION
-handle_exception(EXCEPTION_RECORD *exception_record,
-                 struct lisp_exception_frame *exception_frame,
-                 CONTEXT *win32_context,
-                 void __attribute__((__unused__)) *dispatcher_context)
+static EXCEPTION_DISPOSITION
+handle_exception_ex(EXCEPTION_RECORD *exception_record,
+                    struct lisp_exception_frame *exception_frame,
+                    CONTEXT *win32_context,
+                    BOOL continue_search_on_unhandled_access_violation)
 {
     if (!win32_context)
         /* Not certain why this should be possible, but let's be safe... */
@@ -1176,10 +1295,14 @@ handle_exception(EXCEPTION_RECORD *exception_record,
      * isn't happy: */
 
     int rc;
+    EXCEPTION_DISPOSITION disp = ExceptionContinueExecution;
     switch (code) {
     case EXCEPTION_ACCESS_VIOLATION:
-        rc = handle_access_violation(
-            ctx, exception_record, fault_address, self);
+        rc = handle_access_violation(ctx, exception_record, fault_address, self);
+        if (rc && continue_search_on_unhandled_access_violation) {
+            rc = 0;
+            disp = ExceptionContinueSearch;
+        }
         break;
 
     case SBCL_EXCEPTION_BREAKPOINT:
@@ -1203,7 +1326,35 @@ handle_exception(EXCEPTION_RECORD *exception_record,
 
     errno = lastErrno;
     SetLastError(lastError);
-    return ExceptionContinueExecution;
+    return disp;
+}
+
+/*
+ * A good explanation of the exception handling semantics is
+ *   https://web.archive.org/web/20120628151428/http://win32assembly.online.fr/Exceptionhandling.html
+ *   (x86-specific)
+ * or:
+ *   https://docs.microsoft.com/en-us/windows/win32/debug/structured-exception-handling
+ * or:
+ *   James McNellis's CppCon 2018 talk: "Unwinding the Stack: Exploring How C++
+ *   Exceptions Work on Windows"
+ *
+ * On x86, this function is always invoked by frame-based exception handlers,
+ * either the one established by call_into_lisp in x86-assem.S or the top-level
+ * handler established by wos_install_interrupt_handlers().
+ *
+ * On x86-64, this function may be invoked by the frame-based exception handler
+ * established by set_up_win64_seh_thunk(). Our vectored exception handler,
+ * veh(), invokes handle_exception_ex directly.
+ */
+
+EXCEPTION_DISPOSITION
+handle_exception(EXCEPTION_RECORD *exception_record,
+                 struct lisp_exception_frame *exception_frame,
+                 CONTEXT *win32_context,
+                 void __attribute__((__unused__)) *dispatcher_context)
+{
+    return handle_exception_ex(exception_record, exception_frame, win32_context, FALSE);
 }
 
 #ifdef LISP_FEATURE_X86_64
@@ -1212,26 +1363,50 @@ handle_exception(EXCEPTION_RECORD *exception_record,
     int sbcl__lastErrno = errno;                                \
     RUN_BODY_ONCE(restoring_errno, errno = sbcl__lastErrno)
 
+/*
+ * This vectored exception handler runs before frame-based handlers, so we only
+ * want to handle exceptions triggered by Lisp code. Exceptions raised by
+ * foreign function calls are handled by the frame-based handler established by
+ * set_up_win64_seh_thunk().
+ *
+ * Access violation exceptions can be triggered by the runtime as well, and
+ * that's neither Lisp code nor is it covered the SEH thunk, so we handle those
+ * exceptions differently.
+ */
 LONG
 veh(EXCEPTION_POINTERS *ep)
 {
-    EXCEPTION_DISPOSITION disp;
+    EXCEPTION_DISPOSITION disp = ExceptionContinueSearch;
 
     RESTORING_ERRNO() {
         if (!get_sb_vm_thread())
             return EXCEPTION_CONTINUE_SEARCH;
     }
 
-    disp = handle_exception(ep->ExceptionRecord,0,ep->ContextRecord,0);
-
-    switch (disp)
-    {
+    DWORD64 rip = ep->ContextRecord->Rip;
+    DWORD code = ep->ExceptionRecord->ExceptionCode;
+    BOOL from_lisp =
+        (rip >= READ_ONLY_SPACE_START &&
+         rip <= READ_ONLY_SPACE_END) ||
+        (rip >= DYNAMIC_SPACE_START &&
+         rip <= DYNAMIC_SPACE_START+dynamic_space_size);
+
+    if (code == EXCEPTION_ACCESS_VIOLATION || from_lisp)
+        disp = handle_exception_ex(ep->ExceptionRecord, 0, ep->ContextRecord,
+                                   // continue search on unhandled memory faults
+                                   // if not in Lisp code. This gives foreign
+                                   // handlers a chance to handle the
+                                   // exception. If nothing handles it, our
+                                   // frame-based handler will.
+                                   !from_lisp);
+
+    switch (disp) {
     case ExceptionContinueExecution:
         return EXCEPTION_CONTINUE_EXECUTION;
     case ExceptionContinueSearch:
         return EXCEPTION_CONTINUE_SEARCH;
     default:
-        fprintf(stderr,"Exception handler is mad\n");
+        fprintf(stderr, "Exception handler is mad\n"); fflush(stderr);
         ExitProcess(0);
     }
 }