Handle DBG_PRINTEXCEPTION_C on Windows.

Turn it into a warning using its message.

Based on a patch by Bart Botta.
Closes lp#1437947

NEWS

@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+changes relative to sbcl-1.2.12:
+ * enhancement: On Windows DBG_PRINTEXCEPTION_C is handled and its message is
+ printed. (lp#1437947)
+
 changes in sbcl-1.2.12 relative to sbcl-1.2.11:
  * minor incompatible change: the SB-C::*POLICY* variable is no longer
  a list. Code which manipulated it as such (including but not limited

src/code/target-exception.lisp

@@ -78,7 +78,19 @@
  (exception-record system-area-pointer)
  (exception-address system-area-pointer)
  (number-parameters dword)
- (exception-information system-area-pointer)))
+ (exception-information (array system-area-pointer
+ #.+exception-maximum-parameters+))))
+
+;;; DBG_PRINTEXCEPTION_C shouldn'tbe fatal, and even if it is related to
+;;; something bad, better to print the message than just fail with no info
+(defun dbg-printexception-c (record)
+ (when (= (slot record 'number-parameters) 2)
+ ;; (sap-int (deref (slot record 'exception-information) 0)) =
+ ;; length of string including 0-terminator
+ (warn (cast
+ (sap-alien (deref (slot record 'exception-information) 1)
+ (* char))
+ c-string))))
 
 ;;; Actual exception handler. We hit something the runtime doesn't
 ;;; want to or know how to deal with (that is, not a sigtrap or gc wp
@@ -88,10 +100,13 @@
  (code (slot record 'exception-code))
  (condition-name (cdr (assoc code *exception-code-map*)))
  (sb!debug:*stack-top-hint* (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
- (if condition-name
- (error condition-name)
- (error "An exception occurred in context ~S: ~S. (Exception code: ~S)"
- context-sap exception-record-sap code))))
+ (cond (condition-name
+ (error condition-name))
+ ((= code +dbg-printexception-c+)
+ (dbg-printexception-c record))
+ (t
+ (error "An exception occurred in context ~S: ~S. (Exception code: ~S)"
+ context-sap exception-record-sap code)))))
 
 ;;;; etc.
 

tests/win32.impure.lisp

@@ -0,0 +1,19 @@
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+#-win32 (exit :code 104)
+
+(with-test (:name :dbg-print-exception-c)
+ (handler-case
+ (alien-funcall (extern-alien "OutputDebugStringA" (function (values) c-string)) "debug-test")
+ (warning (c)
+ (assert (equal (princ-to-string c)
+ "DBG_PRINTEXCEPTION_C: debug-test")))))

tools-for-build/grovel-headers.c

@@ -184,7 +184,7 @@ main(int argc, char *argv[])
  defconstant ("CSIDL_FLAG_CREATE", CSIDL_FLAG_CREATE);
  defconstant ("CSIDL_FLAG_MASK", CSIDL_FLAG_MASK);
 
- printf(";;; Exception codes\n");
+ printf(";;; Exceptions\n");
  defconstant("+exception-access-violation+", EXCEPTION_ACCESS_VIOLATION);
  defconstant("+exception-array-bounds-exceeded+", EXCEPTION_ARRAY_BOUNDS_EXCEEDED);
  defconstant("+exception-breakpoint+", EXCEPTION_BREAKPOINT);
@@ -205,6 +205,9 @@ main(int argc, char *argv[])
  defconstant("+exception-priv-instruction+", EXCEPTION_PRIV_INSTRUCTION);
  defconstant("+exception-single-step+", EXCEPTION_SINGLE_STEP);
  defconstant("+exception-stack-overflow+", EXCEPTION_STACK_OVERFLOW);
+ defconstant("+dbg-printexception-c+", DBG_PRINTEXCEPTION_C);
+
+ defconstant("+exception-maximum-parameters+", EXCEPTION_MAXIMUM_PARAMETERS);
 
  printf(";;; FormatMessage\n");