src/code/target-exception.lisp

   1 ;;;; code for handling Win32 exceptions
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!WIN32")
  13
  14 ;;;
  15 ;;; An awful lot of this stuff is stubbed out for now. We basically
  16 ;;; only handle inbound exceptions (the local equivalent to unblockable
  17 ;;; signals), and we're only picking off the sigsegv and sigfpe traps.
  18 ;;;
  19 ;;; This file is based on target-signal.lisp, but most of that went
  20 ;;; away. Some of it might want to be put back or emulated.
  21 ;;;
  22 \f
  23 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
  24 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
  25 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
  26 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
  27 ;;;
  28 ;;; We'd like to have this work, but that would require some method of
  29 ;;; delivering a "blockable signal". Windows doesn't really have the
  30 ;;; concept, so we need to play with the threading functions to emulate
  31 ;;; it (especially since the local equivalent of SIGINT comes in on a
  32 ;;; separate thread). This is on the list for fixing later on, and will
  33 ;;; be required before we implement threads (because of stop-for-gc).
  34 ;;;
  35 ;;; This specific bit of functionality may well be implemented entirely
  36 ;;; in the runtime.
  37 #|
  38 (defun sigint-%break (format-string &rest format-arguments)
  39   (flet ((break-it ()
  40            (apply #'%break 'sigint format-string format-arguments)))
  41     (sb!thread:interrupt-thread (sb!thread::foreground-thread) #'break-it)))
  42 |#
  43 \f
  44 ;;; Map Windows Exception code to condition names
  45 (defvar *exception-code-map*
  46   (list
  47    ;; Floating point exceptions
  48    (cons +exception-flt-divide-by-zero+    'division-by-zero)
  49    (cons +exception-flt-invalid-operation+ 'floating-point-invalid-operation)
  50    (cons +exception-flt-underflow+         'floating-point-underflow)
  51    (cons +exception-flt-overflow+          'floating-point-overflow)
  52    (cons +exception-flt-inexact-result+    'floating-point-inexact)
  53    (cons +exception-flt-denormal-operand+  'floating-point-exception)
  54    (cons +exception-flt-stack-check+       'floating-point-exception)
  55    (cons +exception-stack-overflow+        'sb!kernel::control-stack-exhausted)))
  56
  57 (define-alien-type ()
  58     (struct exception-record
  59             (exception-code dword)
  60             (exception-flags dword)
  61             (exception-record system-area-pointer)
  62             (exception-address system-area-pointer)
  63             (number-parameters dword)
  64             (exception-information system-area-pointer)))
  65
  66 ;;; Actual exception handler. We hit something the runtime doesn't
  67 ;;; want to or know how to deal with (that is, not a sigtrap or gc wp
  68 ;;; violation), so it calls us here.
  69 (defun sb!kernel:handle-win32-exception (context-sap exception-record-sap)
  70   (let* ((record (deref (sap-alien exception-record-sap (* (struct exception-record)))))
  71          (code (slot record 'exception-code))
  72          (condition-name (cdr (assoc code *exception-code-map*)))
  73          (sb!debug:*stack-top-hint* (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
  74     (if condition-name
  75         (error condition-name)
  76         (error "An exception occurred in context ~S: ~S. (Exception code: ~S)"
  77                context-sap exception-record-sap code))))
  78 \f
  79 ;;;; etc.
  80
  81 ;;; CMU CL comment:
  82 ;;;   Magically converted by the compiler into a break instruction.
  83 ;;; SBCL/Win32 comment:
  84 ;;;   I don't know if we still need this or not. Better safe for now.
  85 (defun receive-pending-interrupt ()
  86   (receive-pending-interrupt))