X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftarget-signal.lisp;h=7394695713d07dc98e9e7ba53a91491d64c2a24d;hb=892a8350afb02baabef38c4cba48c25a82d9d679;hp=f23f2a4b0ac354e3034f95f16ab13e44199139fa;hpb=d4a07c5481b3a0692963e018753089f1e5203d10;p=sbcl.git diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index f23f2a4..7394695 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -44,10 +44,10 @@ ;; mechanism there are no extra frames on the stack from a ;; previous signal handler when the next signal is delivered ;; provided there is no WITH-INTERRUPTS. - (let ((*unblock-deferrables-on-enabling-interrupts-p* t)) + (let ((*unblock-deferrables-on-enabling-interrupts-p* t) + (sb!debug:*stack-top-hint* (or sb!debug:*stack-top-hint* 'invoke-interruption))) (with-interrupt-bindings - (let ((sb!debug:*stack-top-hint* - (nth-value 1 (sb!kernel:find-interrupted-name-and-frame)))) + (sb!thread::without-thread-waiting-for (:already-without-interrupts t) (allow-with-interrupts (nlx-protect (funcall function) ;; We've been running with deferrables @@ -179,9 +179,13 @@ (flet ((interrupt-it () (with-alien ((context (* os-context-t) context)) (with-interrupts - (%break 'sigint 'interactive-interrupt - :context context - :address (sap-int (sb!vm:context-pc context))))))) + (let ((int (make-condition 'interactive-interrupt + :context context + :address (sap-int (sb!vm:context-pc context))))) + ;; First SIGNAL, so that handlers can run. + (signal int) + ;; Then enter the debugger like BREAK. + (%break 'sigint int)))))) (sb!thread:interrupt-thread (sb!thread::foreground-thread) #'interrupt-it))) @@ -192,8 +196,7 @@ (defun sigterm-handler (signal code context) (declare (ignore signal code context)) - (sb!thread::terminate-session) - (sb!ext:quit)) + (sb!ext:exit)) ;;; SIGPIPE is not used in SBCL for its original purpose, instead it's ;;; for signalling a thread that it should look at its interruption