1 ;;;; code for handling UNIX signals
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!UNIX")
14 (defmacro with-interrupt-bindings
(&body body
)
16 ;; KLUDGE: Whatever is on the PCL stacks before the interrupt
17 ;; handler runs doesn't really matter, since we're not on the
18 ;; same call stack, really -- and if we don't bind these (esp.
19 ;; the cache one) we can get a bogus metacircle if an interrupt
20 ;; handler calls a GF that was being computed when the interrupt
22 ((sb!pcl
::*cache-miss-values-stack
* nil
)
23 (sb!pcl
::*dfun-miss-gfs-on-stack
* nil
))
26 (defun invoke-interruption (function)
27 (with-interrupt-bindings
29 ;; Reset signal mask: the C-side handler has blocked all
30 ;; deferrable interrupts before arranging return to lisp. This is
31 ;; safe because we can't get a pending interrupt before we unblock
34 ;; FIXME: Should we not reset the _entire_ mask, but just
35 ;; restore it to the state before we got the interrupt?
37 (allow-with-interrupts (funcall function
)))))
39 (defmacro in-interruption
((&key
) &body body
)
41 "Convenience macro on top of INVOKE-INTERRUPTION."
42 `(dx-flet ((interruption () ,@body
))
43 (invoke-interruption #'interruption
)))
45 ;;;; system calls that deal with signals
47 ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
48 ;;; should be a valid signal number
49 #!-sb-fluid
(declaim (inline real-unix-kill
))
50 (sb!alien
:define-alien-routine
("kill" unix-kill
) sb
!alien
:int
52 (signal sb
!alien
:int
))
54 ;;; Send the signal SIGNAL to the all the process in process group
55 ;;; PGRP. SIGNAL should be a valid signal number
56 #!-sb-fluid
(declaim (inline real-unix-killpg
))
57 (sb!alien
:define-alien-routine
("killpg" unix-killpg
) sb
!alien
:int
59 (signal sb
!alien
:int
))
61 ;;; Reset the current set of masked signals (those being blocked from
64 ;;; (Note: CMU CL had a more general SIGSETMASK call and a SIGMASK
65 ;;; operator to create masks, but since we only ever reset to 0, we no
66 ;;; longer support it. If you need it, you can pull it out of the CMU
67 ;;; CL sources, or the old SBCL sources; but you might also consider
68 ;;; doing things the SBCL way and moving this kind of C-level work
69 ;;; down to C wrapper functions.)
71 ;;; When inappropriate build options are used, this also prints messages
72 ;;; listing the signals that were masked
73 (sb!alien
:define-alien-routine
"reset_signal_mask" sb
!alien
:void
)
76 ;;;; C routines that actually do all the work of establishing signal handlers
77 (sb!alien
:define-alien-routine
("install_handler" install-handler
)
78 sb
!alien
:unsigned-long
80 (handler sb
!alien
:unsigned-long
))
82 ;;;; interface to enabling and disabling signal handlers
84 (defun enable-interrupt (signal handler
)
85 (declare (type (or function fixnum
(member :default
:ignore
)) handler
))
86 (/show0
"enable-interrupt")
87 (flet ((run-handler (&rest args
)
89 (apply handler args
))))
91 (let ((result (install-handler signal
96 (sb!kernel
:get-lisp-obj-address
98 (cond ((= result sig-dfl
) :default
)
99 ((= result sig-ign
) :ignore
)
100 (t (the (or function fixnum
)
101 (sb!kernel
:make-lisp-obj result
))))))))
103 (defun default-interrupt (signal)
104 (enable-interrupt signal
:default
))
106 (defun ignore-interrupt (signal)
107 (enable-interrupt signal
:ignore
))
109 ;;;; default LISP signal handlers
111 ;;;; Most of these just call ERROR to report the presence of the signal.
113 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
114 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
115 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
116 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
117 (eval-when (:compile-toplevel
:execute
)
118 (sb!xc
:defmacro define-signal-handler
(name what
&optional
(function 'error
))
119 `(defun ,name
(signal info context
)
120 (declare (ignore signal info
))
121 (declare (type system-area-pointer context
))
122 (/show
"in Lisp-level signal handler" ,(symbol-name name
)
125 (,function
,(concatenate 'simple-string what
" at #X~X")
126 (with-alien ((context (* os-context-t
) context
))
127 (sap-int (sb!vm
:context-pc context
))))))))
129 (define-signal-handler sigill-handler
"illegal instruction")
131 (define-signal-handler sigemt-handler
"SIGEMT")
132 (define-signal-handler sigbus-handler
"bus error")
133 (define-signal-handler sigsegv-handler
"segmentation violation")
135 (define-signal-handler sigsys-handler
"bad argument to a system call")
137 (defun sigint-handler (signal info context
)
138 (declare (ignore signal info
))
139 (declare (type system-area-pointer context
))
140 (/show
"in Lisp-level SIGINT handler" (sap-int context
))
141 (flet ((interrupt-it ()
142 (with-alien ((context (* os-context-t
) context
))
143 (%break
'sigint
'interactive-interrupt
145 :address
(sap-int (sb!vm
:context-pc context
))))))
146 (sb!thread
:interrupt-thread
(sb!thread
::foreground-thread
)
149 (defun sigalrm-handler (signal info context
)
150 (declare (ignore signal info context
))
151 (declare (type system-area-pointer context
))
152 (sb!impl
::run-expired-timers
))
154 (defun sigterm-handler (signal code context
)
155 (declare (ignore signal code context
))
156 (sb!thread
::terminate-session
)
159 ;; Also known as SIGABRT.
160 (defun sigiot-handler (signal code context
)
161 (declare (ignore signal code context
))
164 (defun sb!kernel
:signal-cold-init-or-reinit
()
166 "Enable all the default signals that Lisp knows how to deal with."
167 (enable-interrupt sigint
#'sigint-handler
)
168 (enable-interrupt sigterm
#'sigterm-handler
)
169 (enable-interrupt sigill
#'sigill-handler
)
170 (enable-interrupt sigiot
#'sigiot-handler
)
172 (enable-interrupt sigemt
#'sigemt-handler
)
173 (enable-interrupt sigfpe
#'sb
!vm
:sigfpe-handler
)
174 (enable-interrupt sigbus
#'sigbus-handler
)
175 (enable-interrupt sigsegv
#'sigsegv-handler
)
177 (enable-interrupt sigsys
#'sigsys-handler
)
178 (ignore-interrupt sigpipe
)
179 (enable-interrupt sigalrm
#'sigalrm-handler
)
180 (sb!unix
::reset-signal-mask
)
185 ;;; extract si_code from siginfo_t
186 (sb!alien
:define-alien-routine
("siginfo_code" siginfo-code
) sb
!alien
:int
187 (info system-area-pointer
))
190 ;;; Magically converted by the compiler into a break instruction.
191 (defun receive-pending-interrupt ()
192 (receive-pending-interrupt))