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 ;;; These should probably be somewhere, but I don't know where.
15 (defconstant sig_dfl
0)
16 (defconstant sig_ign
1)
18 ;;;; system calls that deal with signals
20 #!-sb-fluid
(declaim (inline real-unix-kill
))
21 (sb!alien
:define-alien-routine
("kill" real-unix-kill
) sb
!alien
:int
23 (signal sb
!alien
:int
))
25 ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
26 ;;; should be a valid signal number or a keyword of the standard UNIX
28 (defun unix-kill (pid signal
)
29 (real-unix-kill pid
(unix-signal-number signal
)))
31 #!-sb-fluid
(declaim (inline real-unix-killpg
))
32 (sb!alien
:define-alien-routine
("killpg" real-unix-killpg
) sb
!alien
:int
34 (signal sb
!alien
:int
))
36 ;;; Send the signal SIGNAL to the all the process in process group
37 ;;; PGRP. SIGNAL should be a valid signal number or a keyword of the
38 ;;; standard UNIX signal name.
39 (defun unix-killpg (pgrp signal
)
40 (real-unix-killpg pgrp
(unix-signal-number signal
)))
42 ;;; Set the current set of masked signals (those being blocked from
45 ;;; (Note: CMU CL had a SIGMASK operator to create masks, but since
46 ;;; SBCL only uses 0, we no longer support it. If you need it, you
47 ;;; can pull it out of the CMU CL sources, or the old SBCL sources;
48 ;;; but you might also consider doing things the SBCL way and moving
49 ;;; this kind of C-level work down to C wrapper functions.)
51 (sb!alien
:define-alien-routine
("sigsetmask" unix-sigsetmask
)
52 sb
!alien
:unsigned-long
53 (mask sb
!alien
:unsigned-long
))
55 ;;;; C routines that actually do all the work of establishing signal handlers
56 (sb!alien
:define-alien-routine
("install_handler" install-handler
)
57 sb
!alien
:unsigned-long
59 (handler sb
!alien
:unsigned-long
))
61 ;;;; interface to enabling and disabling signal handlers
63 (defun enable-interrupt (signal-designator handler
)
64 (declare (type (or function
(member :default
:ignore
)) handler
))
66 (let ((result (install-handler (unix-signal-number signal-designator
)
71 (sb!kernel
:get-lisp-obj-address
73 (cond ((= result sig_dfl
) :default
)
74 ((= result sig_ign
) :ignore
)
75 (t (the function
(sb!kernel
:make-lisp-obj result
)))))))
77 (defun default-interrupt (signal)
78 (enable-interrupt signal
:default
))
80 (defun ignore-interrupt (signal)
81 (enable-interrupt signal
:ignore
))
83 ;;;; default LISP signal handlers
85 ;;;; Most of these just call ERROR to report the presence of the signal.
87 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
88 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
89 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
90 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
91 (defun sigint-%break
(format-string &rest format-arguments
)
92 (apply #'%break
'sigint format-string format-arguments
))
94 (eval-when (:compile-toplevel
:execute
)
95 (sb!xc
:defmacro define-signal-handler
(name
97 &optional
(function 'error
))
98 `(defun ,name
(signal info context
)
99 (declare (ignore signal info
))
100 (declare (type system-area-pointer context
))
101 (/show
"in Lisp-level signal handler" (sap-int context
))
102 (,function
,(concatenate 'simple-string what
" at #X~X")
103 (with-alien ((context (* os-context-t
) context
))
104 (sap-int (sb!vm
:context-pc context
)))))))
106 (define-signal-handler sigint-handler
"interrupted" sigint-%break
)
107 (define-signal-handler sigill-handler
"illegal instruction")
108 (define-signal-handler sigtrap-handler
"breakpoint/trap")
109 (define-signal-handler sigiot-handler
"SIGIOT")
111 (define-signal-handler sigemt-handler
"SIGEMT")
112 (define-signal-handler sigbus-handler
"bus error")
113 (define-signal-handler sigsegv-handler
"segmentation violation")
115 (define-signal-handler sigsys-handler
"bad argument to a system call")
116 (define-signal-handler sigpipe-handler
"SIGPIPE")
118 (defun sigalrm-handler (signal info context
)
119 (declare (ignore signal info context
))
120 (declare (type system-area-pointer context
))
121 (cerror "Continue" 'sb
!ext
::timeout
))
123 (defun sigquit-handler (signal code context
)
124 (declare (ignore signal code context
))
125 (throw 'sb
!impl
::toplevel-catcher nil
))
127 (defun sb!kernel
:signal-cold-init-or-reinit
()
129 "Enable all the default signals that Lisp knows how to deal with."
130 (enable-interrupt :sigint
#'sigint-handler
)
131 (enable-interrupt :sigquit
#'sigquit-handler
)
132 (enable-interrupt :sigill
#'sigill-handler
)
133 (enable-interrupt :sigtrap
#'sigtrap-handler
)
134 (enable-interrupt :sigiot
#'sigiot-handler
)
136 (enable-interrupt :sigemt
#'sigemt-handler
)
137 (enable-interrupt :sigfpe
#'sb
!vm
:sigfpe-handler
)
138 (enable-interrupt :sigbus
#'sigbus-handler
)
139 (enable-interrupt :sigsegv
#'sigsegv-handler
)
141 (enable-interrupt :sigsys
#'sigsys-handler
)
142 (enable-interrupt :sigpipe
#'sigpipe-handler
)
143 (enable-interrupt :sigalrm
#'sigalrm-handler
)
149 ;;; Magically converted by the compiler into a break instruction.
150 (defun receive-pending-interrupt ()
151 (receive-pending-interrupt))
153 ;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
155 ;;;; WITH-ENABLED-INTERRUPTS
157 (defmacro with-enabled-interrupts
(interrupt-list &body body
)
159 "With-enabled-interrupts ({(interrupt function)}*) {form}*
160 Establish function as a handler for the Unix signal interrupt which
161 should be a number between 1 and 31 inclusive."
167 ,@(do* ((item interrupt-list
(cdr item
))
168 (intr (caar item
) (caar item
))
169 (ifcn (cadar item
) (cadar item
))
171 ((null item
) (nreverse forms
))
173 (setq intr
(symbol-value intr
)))
174 (push `(push `(,,intr
,(enable-interrupt ,intr
,ifcn
)) ,il
)
177 (dolist (,it
(nreverse ,il
))
178 (enable-interrupt (car ,it
) (cadr ,it
)))))))