;; 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
sb!alien:void
(where sb!alien:unsigned-long)
(old sb!alien:unsigned-long))
+#!-sb-safepoint
(sb!alien:define-alien-routine ("unblock_gc_signals" %unblock-gc-signals)
sb!alien:void
(where sb!alien:unsigned-long)
(defun unblock-deferrable-signals ()
(%unblock-deferrable-signals 0 0))
+#!-sb-safepoint
(defun unblock-gc-signals ()
(%unblock-gc-signals 0 0))
(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-safepoint
+ (let ((target (sb!thread::foreground-thread)))
+ ;; Note that INTERRUPT-THREAD on *CURRENT-THREAD* doesn't actually
+ ;; interrupt right away, because deferrables are blocked. Rather,
+ ;; the kernel would arrange for the SIGPIPE to hit when the SIGINT
+ ;; handler is done. However, on safepoint builds, we don't use
+ ;; SIGPIPE and lack an appropriate mechanism to handle pending
+ ;; thruptions upon exit from signal handlers (and this situation is
+ ;; unlike WITHOUT-INTERRUPTS, which handles pending interrupts
+ ;; explicitly at the end). Only as long as safepoint builds pretend
+ ;; to cooperate with signals -- that is, as long as SIGINT-HANDLER
+ ;; is used at all -- detect this situation and work around it.
+ (if (eq target sb!thread:*current-thread*)
+ (interrupt-it)
+ (sb!thread:interrupt-thread target #'interrupt-it)))
+ #!-sb-safepoint
(sb!thread:interrupt-thread (sb!thread::foreground-thread)
#'interrupt-it)))
+#!-sb-wtimer
(defun sigalrm-handler (signal info context)
(declare (ignore signal info context))
(declare (type system-area-pointer context))
(defun sigterm-handler (signal code context)
(declare (ignore signal code context))
- (sb!thread::terminate-session)
- (sb!ext:quit))
+ (sb!ext:exit))
+#!-sb-thruption
;;; SIGPIPE is not used in SBCL for its original purpose, instead it's
;;; for signalling a thread that it should look at its interruption
;;; queue. The handler (RUN_INTERRUPTION) just returns if there is
(enable-interrupt sigbus #'sigbus-handler)
#!-linux
(enable-interrupt sigsys #'sigsys-handler)
+ #!-sb-wtimer
(enable-interrupt sigalrm #'sigalrm-handler)
+ #!-sb-thruption
(enable-interrupt sigpipe #'sigpipe-handler)
(enable-interrupt sigchld #'sigchld-handler)
#!+hpux (ignore-interrupt sigxcpu)
- (unblock-gc-signals)
+ #!-sb-safepoint (unblock-gc-signals)
(unblock-deferrable-signals)
(values))
\f