X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-exception.lisp;h=803a7589775937ecc7d7caa65abc915fcdf0f998;hb=1d881f74d4c2c6099107544a5f337837eb281865;hp=397bf538f7236ab115f583f3cf43c137fe0a0c0d;hpb=0395b7894e8dbb056262ca59a816963733623c34;p=sbcl.git

diff --git a/src/code/target-exception.lisp b/src/code/target-exception.lisp
index 397bf53..803a758 100644
--- a/src/code/target-exception.lisp
+++ b/src/code/target-exception.lisp
@@ -34,25 +34,42 @@
 ;;;
 ;;; This specific bit of functionality may well be implemented entirely
 ;;; in the runtime.
-#|
+#||
 (defun sigint-%break (format-string &rest format-arguments)
   (flet ((break-it ()
            (apply #'%break 'sigint format-string format-arguments)))
     (sb!thread:interrupt-thread (sb!thread::foreground-thread) #'break-it)))
-|#
+||#
 
-;;; Map Windows Exception code to condition names
+;;; Map Windows Exception code to condition names: symbols or strings
 (defvar *exception-code-map*
-  (list
-   ;; Floating point exceptions
-   (cons +exception-flt-divide-by-zero+    'division-by-zero)
-   (cons +exception-flt-invalid-operation+ 'floating-point-invalid-operation)
-   (cons +exception-flt-underflow+         'floating-point-underflow)
-   (cons +exception-flt-overflow+          'floating-point-overflow)
-   (cons +exception-flt-inexact-result+    'floating-point-inexact)
-   (cons +exception-flt-denormal-operand+  'floating-point-exception)
-   (cons +exception-flt-stack-check+       'floating-point-exception)
-   (cons +exception-stack-overflow+        'sb!kernel::control-stack-exhausted)))
+  (macrolet ((cons-name (symbol)
+               `(cons ,symbol ,(remove #\+ (substitute #\_ #\- (string symbol))))))
+    (list
+     ;; Floating point exceptions
+     (cons +exception-flt-divide-by-zero+    'division-by-zero)
+     (cons +exception-flt-invalid-operation+ 'floating-point-invalid-operation)
+     (cons +exception-flt-underflow+         'floating-point-underflow)
+     (cons +exception-flt-overflow+          'floating-point-overflow)
+     (cons +exception-flt-inexact-result+    'floating-point-inexact)
+     (cons +exception-flt-denormal-operand+  'floating-point-exception)
+     (cons +exception-flt-stack-check+       'floating-point-exception)
+     ;; Stack overflow
+     (cons +exception-stack-overflow+        'sb!kernel::control-stack-exhausted)
+     ;; Various
+     (cons-name +exception-single-step+)
+     (cons-name +exception-access-violation+) ; FIXME: should turn into MEMORY-FAULT-ERROR
+                                              ; plus the faulting address
+     (cons-name +exception-array-bounds-exceeded+)
+     (cons-name +exception-breakpoint+)
+     (cons-name +exception-datatype-misalignment+)
+     (cons-name +exception-illegal-instruction+)
+     (cons-name +exception-in-page-error+)
+     (cons-name +exception-int-divide-by-zero+)
+     (cons-name +exception-int-overflow+)
+     (cons-name +exception-invalid-disposition+)
+     (cons-name +exception-noncontinuable-exception+)
+     (cons-name +exception-priv-instruction+))))
 
 (define-alien-type ()
     (struct exception-record