X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Finterr.lisp;h=8fb4657fe01d0db730fc89f107a5e9170abb85f9;hb=975f1932acc3a8e90fb31d2b055bfbdde78ea927;hp=260e105e1107963325563ddf4feb759c90b93f6f;hpb=23124951022f995aace9e7f17e650cd23b83c591;p=sbcl.git diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 260e105..8fb4657 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -390,6 +390,7 @@ (values "" nil))))) + ;;;; 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*)) @@ -484,10 +493,11 @@ ;;; 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 this portably. +;;; 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 "Unhandled breakpoint/trap at #x~X." - (sap-int (sb!vm:context-pc context)))))) + (error 'breakpoint-error + :context context + :address (sap-int (sb!vm:context-pc context))))))