(in-package "SB!UNIX")
+(defun invoke-interruption (function)
+ (without-interrupts
+ (sb!unix::reset-signal-mask)
+ (funcall function)))
+
+(defmacro in-interruption ((&rest args) &body body)
+ #!+sb-doc
+ "Convenience macro on top of INVOKE-INTERRUPTION."
+ `(invoke-interruption (lambda () ,@body) ,@args))
+
;;; These should probably be somewhere, but I don't know where.
(defconstant sig_dfl 0)
(defconstant sig_ign 1)
(defun enable-interrupt (signal handler)
(declare (type (or function fixnum (member :default :ignore)) handler))
(/show0 "enable-interrupt")
- (without-gcing
- (let ((result (install-handler signal
- (case handler
- (:default sig_dfl)
- (:ignore sig_ign)
- (t
- (sb!kernel:get-lisp-obj-address
- handler))))))
- (cond ((= result sig_dfl) :default)
- ((= result sig_ign) :ignore)
- (t (the (or function fixnum) (sb!kernel:make-lisp-obj result)))))))
+ (flet ((run-handler (&rest args)
+ (in-interruption ()
+ (apply handler args))))
+ (without-gcing
+ (let ((result (install-handler signal
+ (case handler
+ (:default sig_dfl)
+ (:ignore sig_ign)
+ (t
+ (sb!kernel:get-lisp-obj-address
+ #'run-handler))))))
+ (cond ((= result sig_dfl) :default)
+ ((= result sig_ign) :ignore)
+ (t (the (or function fixnum)
+ (sb!kernel:make-lisp-obj result))))))))
(defun default-interrupt (signal)
(enable-interrupt signal :default))
;;; SIGINT in --disable-debugger mode will cleanly terminate the system
;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
(defun sigint-%break (format-string &rest format-arguments)
- #!+sb-thread
- (let ((foreground-thread (sb!thread::foreground-thread)))
- (if (eq foreground-thread sb!thread:*current-thread*)
- (apply #'%break 'sigint format-string format-arguments)
- (sb!thread:interrupt-thread
- foreground-thread
- (lambda () (apply #'%break 'sigint format-string format-arguments)))))
- #!-sb-thread
- (apply #'%break 'sigint format-string format-arguments))
+ (flet ((break-it ()
+ (apply #'%break 'sigint format-string format-arguments)))
+ (sb!thread:interrupt-thread (sb!thread::foreground-thread) #'break-it)))
(eval-when (:compile-toplevel :execute)
(sb!xc:defmacro define-signal-handler (name
`(defun ,name (signal info context)
(declare (ignore signal info))
(declare (type system-area-pointer context))
- (/show "in Lisp-level signal handler" ,(symbol-name name) (sap-int context))
- (,function ,(concatenate 'simple-string what " at #X~X")
- (with-alien ((context (* os-context-t) context))
- (sap-int (sb!vm:context-pc context)))))))
+ (/show "in Lisp-level signal handler" ,(symbol-name name)
+ (sap-int context))
+ (with-interrupts
+ (,function ,(concatenate 'simple-string what " at #X~X")
+ (with-alien ((context (* os-context-t) context))
+ (sap-int (sb!vm:context-pc context))))))))
(define-signal-handler sigint-handler "interrupted" sigint-%break)
(define-signal-handler sigill-handler "illegal instruction")
(define-signal-handler sigtrap-handler "breakpoint/trap")
-(define-signal-handler sigiot-handler "SIGIOT")
#!-linux
(define-signal-handler sigemt-handler "SIGEMT")
(define-signal-handler sigbus-handler "bus error")
(define-signal-handler sigsegv-handler "segmentation violation")
#!-linux
(define-signal-handler sigsys-handler "bad argument to a system call")
-(define-signal-handler sigpipe-handler "SIGPIPE")
(defun sigalrm-handler (signal info context)
(declare (ignore signal info context))
(declare (type system-area-pointer context))
- (cerror "Continue" 'sb!ext::timeout))
+ (sb!impl::run-expired-timers))
+
+(defun sigterm-handler (signal code context)
+ (declare (ignore signal code context))
+ (sb!thread::terminate-session)
+ (sb!ext:quit))
-(defun sigquit-handler (signal code context)
+;; Also known as SIGABRT.
+(defun sigiot-handler (signal code context)
(declare (ignore signal code context))
- (throw 'toplevel-catcher nil))
+ (sb!impl::%halt))
(defun sb!kernel:signal-cold-init-or-reinit ()
#!+sb-doc
"Enable all the default signals that Lisp knows how to deal with."
(enable-interrupt sigint #'sigint-handler)
- (enable-interrupt sigquit #'sigquit-handler)
+ (enable-interrupt sigterm #'sigterm-handler)
(enable-interrupt sigill #'sigill-handler)
(enable-interrupt sigtrap #'sigtrap-handler)
(enable-interrupt sigiot #'sigiot-handler)
(enable-interrupt sigsegv #'sigsegv-handler)
#!-linux
(enable-interrupt sigsys #'sigsys-handler)
- (enable-interrupt sigpipe #'sigpipe-handler)
+ (ignore-interrupt sigpipe)
(enable-interrupt sigalrm #'sigalrm-handler)
+ (sb!unix::reset-signal-mask)
(values))
\f
;;;; etc.