0.pre7.77:
[sbcl.git] / src / code / signal.lisp
1 ;;;; handling UNIX signals
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!UNIX")
13 \f
14 ;;;; macros for dynamically enabling and disabling signal handling
15
16 ;;; Notes on how the without-interrupts/with-interrupts stuff works:
17 ;;;
18 ;;; Before invoking the supplied handler for any of the signals that
19 ;;; can be blocked, the C interrupt support code checks to see whether
20 ;;; *interrupts-enabled* has been bound to NIL. If so, it saves the
21 ;;; signal number and the value of the signal mask (from the signal
22 ;;; context), sets the signal mask to block all blockable signals,
23 ;;; sets *interrupt-pending* and returns without handling the signal.
24 ;;;
25 ;;; When we drop out the without interrupts, we check to see whether
26 ;;; *interrupt-pending* has been set. If so, we call
27 ;;; do-pending-interrupt, which generates a SIGTRAP. The C code
28 ;;; invokes the handler for the saved signal instead of the SIGTRAP
29 ;;; after replacing the signal mask in the signal context with the
30 ;;; saved value. When that hander returns, the original signal mask is
31 ;;; installed, allowing any other pending signals to be handled.
32 ;;;
33 ;;; This means that the cost of WITHOUT-INTERRUPTS is just a special
34 ;;; binding in the case when no signals are delivered (the normal
35 ;;; case). It's only when a signal is actually delivered that we use
36 ;;; any system calls, and by then the cost of the extra system calls
37 ;;; are lost in the noise when compared with the cost of delivering
38 ;;; the signal in the first place.
39
40 (defvar *interrupts-enabled* t)
41 (defvar *interrupt-pending* nil)
42
43 (sb!xc:defmacro without-interrupts (&body body)
44   #!+sb-doc
45   "Execute BODY in a context impervious to interrupts."
46   (let ((name (gensym)))
47     `(flet ((,name () ,@body))
48        (if *interrupts-enabled*
49            (unwind-protect
50                (let ((*interrupts-enabled* nil))
51                  (,name))
52              ;; FIXME: Does it matter that an interrupt coming in here
53              ;; could be executed before any of the pending interrupts?
54              ;; Or do incoming interrupts have the good grace to check
55              ;; whether interrupts are pending before executing themselves
56              ;; immediately?
57              (when *interrupt-pending*
58                (do-pending-interrupt)))
59            (,name)))))
60
61 (sb!xc:defmacro with-interrupts (&body body)
62   #!+sb-doc
63   "Allow interrupts while executing BODY. As interrupts are normally allowed,
64   this is only useful inside a WITHOUT-INTERRUPTS."
65   (let ((name (gensym)))
66     `(flet ((,name () ,@body))
67        (if *interrupts-enabled*
68            (,name)
69            (let ((*interrupts-enabled* t))
70              (when *interrupt-pending*
71                (do-pending-interrupt))
72              (,name))))))
73 \f
74 ;;;; utilities for dealing with signal names and numbers
75
76 (defstruct (unix-signal
77             (:constructor make-unix-signal (%name %number))
78             (:copier nil))
79   ;; signal keyword (e.g. :SIGINT for the Unix SIGINT signal)
80   (%name   (missing-arg) :type keyword :read-only t)
81   ;; signal number
82   (%number (missing-arg) :type integer :read-only t))
83
84 ;;; list of all defined UNIX-SIGNALs
85 (defvar *unix-signals* nil)
86
87 (defmacro !def-unix-signal (name number)
88   (declare (type keyword name))
89   (declare (type (and fixnum unsigned-byte) number))
90   `(push (make-unix-signal ,name ,number) *unix-signals*))
91
92 (/show0 "signal.lisp 131")
93
94 (defun unix-signal-or-lose (designator)
95   (or (find designator (the list *unix-signals*)
96             :key (etypecase designator
97                    (symbol #'unix-signal-%name)
98                    (number #'unix-signal-%number)))
99       (error "not a valid signal name or number: ~S" designator)))
100
101 (/show0 "signal.lisp 142")
102
103 ;;; Return the name of the designated signal.
104 (defun unix-signal-name (designator)
105   (symbol-name (unix-signal-%name (unix-signal-or-lose designator))))
106
107 (/show0 "signal.lisp 150")
108
109 ;;; Return the number of the designated signal.
110 (defun unix-signal-number (designator)
111   (unix-signal-%number (unix-signal-or-lose designator)))
112
113 (/show0 "signal.lisp 168")
114
115 ;;; known signals
116 (/show0 "defining Unix signals")
117 (!def-unix-signal :CHECK 0) ; check
118 (/show0 "done defining CHECK")
119 (!def-unix-signal :SIGHUP 1) ; hangup
120 (/show0 "done defining SIGHUP")
121 (!def-unix-signal :SIGINT 2) ; interrupt
122 (/show0 "done defining SIGINT")
123 (!def-unix-signal :SIGQUIT 3) ; quit
124 (!def-unix-signal :SIGILL 4) ; illegal instruction
125 (!def-unix-signal :SIGTRAP 5) ; trace trap
126 (!def-unix-signal :SIGIOT 6) ; IOT instruction
127 #!-linux
128 (!def-unix-signal :SIGEMT 7) ; EMT instruction
129 (!def-unix-signal :SIGFPE 8) ; floating point exception
130 (!def-unix-signal :SIGKILL 9) ; kill
131 (!def-unix-signal :SIGBUS #!-linux 10 #!+linux 7) ; bus error
132 (!def-unix-signal :SIGSEGV 11) ; segmentation violation
133 #!-linux
134 (!def-unix-signal :SIGSYS 12) ; bad argument to system call
135 (!def-unix-signal :SIGPIPE 13) ; write on a pipe with no one to read it
136 (!def-unix-signal :SIGALRM 14) ; alarm clock
137 (!def-unix-signal :SIGTERM 15) ; software termination signal
138 #!+linux
139 (!def-unix-signal :SIGSTKFLT 16) ; stack fault on coprocessor
140 (!def-unix-signal :SIGURG ; urgent condition present on socket
141   #!+svr4 21
142   #!-(or hpux svr4 linux) 16
143   #!+hpux 29
144   #!+linux 23)
145 (!def-unix-signal :SIGSTOP ; stop
146   #!-(or hpux svr4 linux) 17
147   #!+hpux 24
148   #!+svr4 23
149   #!+linux 19)
150 (!def-unix-signal :SIGTSTP ;  stop signal generated from keyboard
151   #!-(or hpux svr4 linux) 18
152   #!+hpux 25
153   #!+svr4 24
154   #!+linux 20)
155 (!def-unix-signal :SIGCONT ; continue after stop
156   #!-(or hpux svr4 linux) 19
157   #!+hpux 26
158   #!+svr4 25
159   #!+linux 18)
160 (!def-unix-signal :SIGCHLD ; Child status has changed.
161   #!-(or linux hpux) 20
162   #!+hpux 18
163   #!+linux 17)
164 (!def-unix-signal :SIGTTIN ; background read attempted from control terminal
165   #!-(or hpux svr4) 21
166   #!+hpux 27
167   #!+svr4 26)
168 (!def-unix-signal :SIGTTOU ; background write attempted to control terminal
169   #!-(or hpux svr4) 22
170   #!+hpux 28
171   #!+svr4 27)
172 (!def-unix-signal :SIGIO ; I/O is possible on a descriptor.
173   #!-(or hpux irix linux) 23
174   #!+(or hpux irix) 22
175   #!+linux 29)
176 #!-hpux
177 (!def-unix-signal :SIGXCPU ; CPU time limit exceeded
178   #!-svr4 24
179   #!+svr4 30)
180 #!-hpux
181 (!def-unix-signal :SIGXFSZ ;  file size limit exceeded
182   #!-svr4 25
183   #!+svr4 31)
184 (!def-unix-signal :SIGVTALRM ; virtual time alarm
185   #!-(or hpux svr4) 26
186   #!+hpux 20
187   #!+svr4 28)
188 (!def-unix-signal :SIGPROF ;  profiling timer alarm
189   #!-(or hpux svr4 linux) 27
190   #!+hpux 21
191   #!+svr4 29
192   #!+linux 30)
193 (!def-unix-signal :SIGWINCH ; window size change
194   #!-(or hpux svr4) 28
195   #!+hpux 23
196   #!+svr4 20)
197 (!def-unix-signal :SIGUSR1 ;  user-defined signal 1
198   #!-(or hpux svr4 linux) 30
199   #!+(or hpux svr4) 16
200   #!+linux 10)
201 (!def-unix-signal :SIGUSR2 ; user-defined signal 2
202   #!-(or hpux svr4 linux) 31
203   #!+(or hpux svr4) 17
204   #!+linux 12)
205
206 ;;; SVR4 (or Solaris?) specific signals
207 #!+svr4
208 (!def-unix-signal :SIGWAITING 32) ; Process's LWPs are blocked.
209
210 (/show0 "done with signal.lisp")