X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-signal.lisp;h=7394695713d07dc98e9e7ba53a91491d64c2a24d;hb=a6a12ed609d5467ec43b411283e5b3568fee81df;hp=2ae4a88feaf5ce67b33852ad56662debc96f4ee9;hpb=5abf3b4b94c8c2315777e63729293395dc54992c;p=sbcl.git diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index 2ae4a88..7394695 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -44,23 +44,22 @@ ;; 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 - ;; blocked in Lisp called by a C signal - ;; handler. If we return normally the sigmask - ;; in the interrupted context is restored. - ;; However, if we do an nlx the operating - ;; system will not restore it for us. - (when *unblock-deferrables-on-enabling-interrupts-p* - ;; This means that storms of interrupts - ;; doing an nlx can still run out of stack. - (unblock-deferrable-signals)))))))))) + (sb!thread::without-thread-waiting-for (:already-without-interrupts t) + (allow-with-interrupts + (nlx-protect (funcall function) + ;; We've been running with deferrables + ;; blocked in Lisp called by a C signal + ;; handler. If we return normally the sigmask + ;; in the interrupted context is restored. + ;; However, if we do an nlx the operating + ;; system will not restore it for us. + (when *unblock-deferrables-on-enabling-interrupts-p* + ;; This means that storms of interrupts + ;; doing an nlx can still run out of stack. + (unblock-deferrable-signals))))))))) (defmacro in-interruption ((&key) &body body) #!+sb-doc @@ -197,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