1.0.12.42: Fix minor regression in RUN-PROGRAM on win32

[sbcl.git] / src / code / interr.lisp

diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 8614280..8fb4657 100644 (file)
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -390,6 +390,7 @@
           (values "<error finding interrupted name -- trapped debug-condition>"
                   nil)))))
 \f
+
 ;;;; INTERNAL-ERROR signal handler
 
 (defun internal-error (context continuable)
@@ -400,7 +401,7 @@
   (infinite-error-protect
    (/show0 "about to bind ALIEN-CONTEXT")
    (let ((alien-context (locally
-                          (declare (optimize (inhibit-warnings 3)))
+                            (declare (optimize (inhibit-warnings 3)))
                           (sb!alien:sap-alien context (* os-context-t)))))
      (/show0 "about to bind ERROR-NUMBER and ARGUMENTS")
      (multiple-value-bind (error-number arguments)
@@ -420,6 +421,14 @@
        (multiple-value-bind (name sb!debug:*stack-top-hint*)
            (find-interrupted-name-and-frame)
          (/show0 "back from FIND-INTERRUPTED-NAME")
+         ;; Unblock trap signal here, we unwound the stack and can't return.
+         ;; FIXME: Should we not reset the _entire_ mask, but just
+         ;; restore it to the state before we got the condition?
+         ;; FIXME 2: Signals are currently unblocked in
+         ;; interrupt.c:internal_error before we do stack unwinding, can this
+         ;; introduce a race condition?
+         #!+(and linux mips)
+         (sb!unix::reset-signal-mask)
          (let ((fp (int-sap (sb!vm:context-register alien-context
                                                     sb!vm::cfp-offset)))
                (handler (and (< -1 error-number (length *internal-errors*))
@@ -481,3 +490,14 @@
 (defun memory-fault-error ()
   (error 'memory-fault-error
          :address current-memory-fault-address))
+
+;;; This is SIGTRAP / EXCEPTION_BREAKPOINT that runtime could not deal
+;;; with. Prior to Windows we just had a Lisp side handler for
+;;; SIGTRAP, but now we need to deal with this portably.
+(defun unhandled-trap-error (context-sap)
+  (declare (type system-area-pointer context-sap))
+  (infinite-error-protect
+   (let ((context (sap-alien context-sap (* os-context-t))))
+     (error 'breakpoint-error
+            :context context
+            :address (sap-int (sb!vm:context-pc context))))))