2 * interrupt-handling magic
6 * This software is part of the SBCL system. See the README file for
9 * This software is derived from the CMU CL system, which was
10 * written at Carnegie Mellon University and released into the
11 * public domain. The software is in the public domain and is
12 * provided with absolutely no warranty. See the COPYING and CREDITS
13 * files for more information.
19 #ifdef mach /* KLUDGE: #ifdef on lowercase symbols? Ick. -- WHN 19990904 */
29 #include "interrupt.h"
39 void sigaddset_blockable(sigset_t *s)
43 sigaddset(s, SIGQUIT);
44 sigaddset(s, SIGPIPE);
45 sigaddset(s, SIGALRM);
47 sigaddset(s, SIGTSTP);
48 sigaddset(s, SIGCHLD);
50 sigaddset(s, SIGXCPU);
51 sigaddset(s, SIGXFSZ);
52 sigaddset(s, SIGVTALRM);
53 sigaddset(s, SIGPROF);
54 sigaddset(s, SIGWINCH);
55 sigaddset(s, SIGUSR1);
56 sigaddset(s, SIGUSR2);
59 /* When we catch an internal error, should we pass it back to Lisp to
60 * be handled in a high-level way? (Early in cold init, the answer is
61 * 'no', because Lisp is still too brain-dead to handle anything.
62 * After sufficient initialization has been completed, the answer
64 boolean internal_errors_enabled = 0;
66 os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
68 /* As far as I can tell, what's going on here is:
70 * In the case of most signals, when Lisp asks us to handle the
71 * signal, the outermost handler (the one actually passed to UNIX) is
72 * either interrupt_handle_now(..) or interrupt_handle_later(..).
73 * In that case, the Lisp-level handler is stored in interrupt_handlers[..]
74 * and interrupt_low_level_handlers[..] is cleared.
76 * However, some signals need special handling, e.g. the SIGSEGV (for
77 * Linux) or SIGBUS (for FreeBSD) used by the garbage collector to
78 * detect violations of write protection, because some cases of such
79 * signals (e.g. GC-related violations of write protection) are
80 * handled at C level and never passed on to Lisp. For such signals,
81 * we still store any Lisp-level handler in interrupt_handlers[..],
82 * but for the outermost handle we use the value from
83 * interrupt_low_level_handlers[..], instead of the ordinary
84 * interrupt_handle_now(..) or interrupt_handle_later(..).
87 void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, void*) = {0};
88 union interrupt_handler interrupt_handlers[NSIG];
90 /* signal number, siginfo_t, and old mask information for pending signal
92 * pending_signal=0 when there is no pending signal. */
93 static int pending_signal = 0;
94 static siginfo_t pending_info;
95 static sigset_t pending_mask;
97 static boolean maybe_gc_pending = 0;
100 * utility routines used by various signal handlers
104 fake_foreign_function_call(os_context_t *context)
111 /* Get current Lisp state from context. */
113 dynamic_space_free_pointer =
114 (lispobj *)(*os_context_register_addr(context, reg_ALLOC));
116 if ((long)dynamic_space_free_pointer & 1) {
117 lose("dead in fake_foreign_function_call, context = %x", context);
122 current_binding_stack_pointer =
123 (lispobj *)(*os_context_register_addr(context, reg_BSP));
127 /* Build a fake stack frame. */
128 current_control_frame_pointer =
129 (lispobj *)(*os_context_register_addr(context, reg_CSP));
130 if ((lispobj *)(*os_context_register_addr(context, reg_CFP))
131 == current_control_frame_pointer) {
132 /* There is a small window during call where the callee's
133 * frame isn't built yet. */
134 if (LowtagOf(*os_context_register_addr(context, reg_CODE))
135 == type_FunctionPointer) {
136 /* We have called, but not built the new frame, so
137 * build it for them. */
138 current_control_frame_pointer[0] =
139 *os_context_register_addr(context, reg_OCFP);
140 current_control_frame_pointer[1] =
141 *os_context_register_addr(context, reg_LRA);
142 current_control_frame_pointer += 8;
143 /* Build our frame on top of it. */
144 oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
147 /* We haven't yet called, build our frame as if the
148 * partial frame wasn't there. */
149 oldcont = (lispobj)(*os_context_register_addr(context, reg_OCFP));
152 /* ### We can't tell whether we are still in the caller if it had
153 * to reg_ALLOCate the stack frame due to stack arguments. */
154 /* ### Can anything strange happen during return? */
157 oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
160 current_control_stack_pointer = current_control_frame_pointer + 8;
162 current_control_frame_pointer[0] = oldcont;
163 current_control_frame_pointer[1] = NIL;
164 current_control_frame_pointer[2] =
165 (lispobj)(*os_context_register_addr(context, reg_CODE));
168 /* Do dynamic binding of the active interrupt context index
169 * and save the context in the context array. */
170 context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
171 /* FIXME: Ick! Why use abstract "make_fixnum" in some places if
172 * you're going to convert from fixnum by bare >>2 in other
173 * places? Use fixnum_value(..) here, and look for other places
174 * which do bare >> and << for fixnum_value and make_fixnum. */
176 if (context_index >= MAX_INTERRUPTS) {
177 lose("maximum interrupt nesting depth (%d) exceeded",
181 bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,
182 make_fixnum(context_index + 1));
184 lisp_interrupt_contexts[context_index] = context;
186 /* no longer in Lisp now */
187 foreign_function_call_active = 1;
191 undo_fake_foreign_function_call(os_context_t *context)
193 /* Block all blockable signals. */
196 sigaddset_blockable(&block);
197 sigprocmask(SIG_BLOCK, &block, 0);
199 /* going back into Lisp */
200 foreign_function_call_active = 0;
202 /* Undo dynamic binding. */
203 /* ### Do I really need to unbind_to_here()? */
204 /* FIXME: Is this to undo the binding of
205 * FREE_INTERRUPT_CONTEXT_INDEX? If so, we should say so. And
206 * perhaps yes, unbind_to_here() really would be clearer and less
211 /* Put the dynamic space free pointer back into the context. */
212 *os_context_register_addr(context, reg_ALLOC) =
213 (unsigned long) dynamic_space_free_pointer;
217 /* a handler for the signal caused by execution of a trap opcode
218 * signalling an internal error */
220 interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context,
223 lispobj context_sap = 0;
225 fake_foreign_function_call(context);
227 /* Allocate the SAP object while the interrupts are still
229 if (internal_errors_enabled) {
230 context_sap = alloc_sap(context);
233 sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
235 if (internal_errors_enabled) {
236 SHOW("in interrupt_internal_error");
238 /* Display some rudimentary debugging information about the
239 * error, so that even if the Lisp error handler gets badly
240 * confused, we have a chance to determine what's going on. */
241 describe_internal_error(context);
243 funcall2(SymbolFunction(INTERNAL_ERROR), context_sap,
244 continuable ? T : NIL);
246 describe_internal_error(context);
247 /* There's no good way to recover from an internal error
248 * before the Lisp error handling mechanism is set up. */
249 lose("internal error too early in init, can't recover");
251 undo_fake_foreign_function_call(context);
253 arch_skip_instruction(context);
258 interrupt_handle_pending(os_context_t *context)
261 boolean were_in_lisp = !foreign_function_call_active;
264 SetSymbolValue(INTERRUPT_PENDING, NIL);
266 if (maybe_gc_pending) {
267 maybe_gc_pending = 0;
272 fake_foreign_function_call(context);
274 funcall0(SymbolFunction(MAYBE_GC));
279 undo_fake_foreign_function_call(context);
283 /* FIXME: This isn't very clear. It would be good to reverse
284 * engineer it and rewrite the code more clearly, or write a clear
285 * explanation of what's going on in the comments, or both.
287 * WHN's question 1a: How come we unconditionally copy from
288 * pending_mask into the context, and then test whether
289 * pending_signal is set?
291 * WHN's question 1b: If pending_signal wasn't set, how could
292 * pending_mask be valid?
294 * Dan Barlow's reply (sbcl-devel 2001-03-13): And the answer is -
295 * or appears to be - because interrupt_maybe_gc set it that way
296 * (look in the #ifndef __i386__ bit). We can't GC during a
297 * pseudo-atomic, so we set maybe_gc_pending=1 and
298 * arch_set_pseudo_atomic_interrupted(..) When we come out of
299 * pseudo_atomic we're marked as interrupted, so we call
300 * interrupt_handle_pending, which does the GC using the pending
301 * context (it needs a context so that it has registers to use as
302 * GC roots) then notices there's no actual interrupt handler to
303 * call, so doesn't. That's the second question [1b] answered,
304 * anyway. Why we still need to copy the pending_mask into the
305 * context given that we're now done with the context anyway, I
307 memcpy(os_context_sigmask_addr(context), &pending_mask, sizeof(sigset_t));
308 sigemptyset(&pending_mask);
309 if (pending_signal) {
310 int signal = pending_signal;
312 memcpy(&info, &pending_info, sizeof(siginfo_t));
314 interrupt_handle_now(signal, &info, context);
319 * the two main signal handlers:
320 * interrupt_handle_now(..)
321 * maybe_now_maybe_later(..)
325 interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
327 os_context_t *context = (os_context_t*)void_context;
329 boolean were_in_lisp;
331 union interrupt_handler handler;
333 /* FIXME: The CMU CL we forked off of had this Linux-only
334 * operation here. Newer CMU CLs (e.g. 18c) have hairier
335 * Linux/i386-only logic here. SBCL seems to be more reliable
336 * without anything here. However, if we start supporting code
337 * which sets the rounding mode, then we may want to do something
338 * special to force the rounding mode back to some standard value
339 * here, so that ISRs can have a standard environment. (OTOH, if
340 * rounding modes are under user control, then perhaps we should
341 * leave this up to the user.)
343 * In the absence of a test case to show that this is really a
344 * problem, we just suppress this code completely (just like the
345 * parallel code in maybe_now_maybe_later).
347 * SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
350 handler = interrupt_handlers[signal];
352 if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) {
357 were_in_lisp = !foreign_function_call_active;
361 fake_foreign_function_call(context);
365 FSHOW((stderr, "in interrupt_handle_now(%d, info, context)\n", signal));
368 if (ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
370 /* This can happen if someone tries to ignore or default one
371 * of the signals we need for runtime support, and the runtime
372 * support decides to pass on it. */
373 lose("no handler for signal %d in interrupt_handle_now(..)", signal);
375 } else if (LowtagOf(handler.lisp) == type_FunctionPointer) {
377 /* Allocate the SAPs while the interrupts are still disabled.
378 * (FIXME: Why? This is the way it was done in CMU CL, and it
379 * even had the comment noting that this is the way it was
380 * done, but no motivation..) */
381 lispobj context_sap = alloc_sap(context);
382 lispobj info_sap = alloc_sap(info);
384 /* Allow signals again. */
385 sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
388 SHOW("calling Lisp-level handler");
391 funcall3(handler.lisp,
398 SHOW("calling C-level handler");
401 /* Allow signals again. */
402 sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
404 (*handler.c)(signal, info, void_context);
411 undo_fake_foreign_function_call(context);
416 maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
418 os_context_t *context = (os_context_t*)void_context;
420 /* FIXME: See Debian cmucl 2.4.17, and mail from DTC on the CMU CL
421 * mailing list 23 Oct 1999, for changes in FPU handling at
422 * interrupt time which should be ported into SBCL. Also see the
423 * analogous logic at the head of interrupt_handle_now for
424 * more related FIXME stuff.
426 * For now, we just suppress this code completely.
428 * SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
431 if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
433 /* FIXME: This code is exactly the same as the code in the
434 * other leg of the if(..), and should be factored out into
435 * a shared function. */
436 pending_signal = signal;
437 memcpy(&pending_info, info, sizeof(siginfo_t));
438 memcpy(&pending_mask,
439 os_context_sigmask_addr(context),
441 sigaddset_blockable(os_context_sigmask_addr(context));
443 SetSymbolValue(INTERRUPT_PENDING, T);
447 (!foreign_function_call_active) &&
449 arch_pseudo_atomic_atomic(context)) {
451 /* FIXME: It would probably be good to replace these bare
452 * memcpy(..) calls with calls to cpy_siginfo_t and
453 * cpy_sigset_t, so that we only have to get the sizeof
454 * expressions right in one place, and after that static type
455 * checking takes over. */
456 pending_signal = signal;
457 memcpy(&pending_info, info, sizeof(siginfo_t));
458 memcpy(&pending_mask,
459 os_context_sigmask_addr(context),
461 sigaddset_blockable(os_context_sigmask_addr(context));
463 arch_set_pseudo_atomic_interrupted(context);
466 interrupt_handle_now(signal, info, context);
471 * stuff to detect and handle hitting the GC trigger
474 #ifndef INTERNAL_GC_TRIGGER
476 gc_trigger_hit(int signal, siginfo_t *info, os_context_t *context)
478 if (current_auto_gc_trigger == NULL)
481 lispobj *badaddr=(lispobj *)arch_get_bad_addr(signal,
485 return (badaddr >= current_auto_gc_trigger &&
486 badaddr < DYNAMIC_SPACE_START + DYNAMIC_SPACE_SIZE);
493 interrupt_maybe_gc(int signal, siginfo_t *info, os_context_t *context)
495 if (!foreign_function_call_active
496 #ifndef INTERNAL_GC_TRIGGER
497 && gc_trigger_hit(signal, info, context)
500 #ifndef INTERNAL_GC_TRIGGER
501 clear_auto_gc_trigger();
504 if (arch_pseudo_atomic_atomic(context)) {
505 maybe_gc_pending = 1;
506 if (pending_signal == 0) {
507 /* FIXME: This copy-pending_mask-then-sigaddset_blockable
508 * idiom occurs over and over. It should be factored out
509 * into a function with a descriptive name. */
510 memcpy(&pending_mask,
511 os_context_sigmask_addr(context),
513 sigaddset_blockable(os_context_sigmask_addr(context));
515 arch_set_pseudo_atomic_interrupted(context);
518 fake_foreign_function_call(context);
519 funcall0(SymbolFunction(MAYBE_GC));
520 undo_fake_foreign_function_call(context);
531 * noise to install handlers
534 /* Install a special low-level handler for signal; or if handler is
535 * SIG_DFL, remove any special handling for signal. */
537 interrupt_install_low_level_handler (int signal,
538 void handler(int, siginfo_t*, void*))
542 sa.sa_sigaction = handler;
543 sigemptyset(&sa.sa_mask);
544 sigaddset_blockable(&sa.sa_mask);
545 sa.sa_flags = SA_SIGINFO | SA_RESTART;
547 sigaction(signal, &sa, NULL);
548 interrupt_low_level_handlers[signal] =
549 (ARE_SAME_HANDLER(handler,SIG_DFL) ? 0 : handler);
552 /* This is called from Lisp. */
554 install_handler(int signal, void handler(int, siginfo_t*, void*))
558 union interrupt_handler oldhandler;
560 FSHOW((stderr, "entering POSIX install_handler(%d, ..)\n", signal));
563 sigaddset(&new, signal);
564 sigprocmask(SIG_BLOCK, &new, &old);
567 sigaddset_blockable(&new);
569 FSHOW((stderr, "interrupt_low_level_handlers[signal]=%d\n",
570 interrupt_low_level_handlers[signal]));
571 if (interrupt_low_level_handlers[signal]==0) {
572 if (ARE_SAME_HANDLER(handler, SIG_DFL) ||
573 ARE_SAME_HANDLER(handler, SIG_IGN)) {
574 sa.sa_sigaction = handler;
575 } else if (sigismember(&new, signal)) {
576 sa.sa_sigaction = maybe_now_maybe_later;
578 sa.sa_sigaction = interrupt_handle_now;
581 sigemptyset(&sa.sa_mask);
582 sigaddset_blockable(&sa.sa_mask);
583 sa.sa_flags = SA_SIGINFO | SA_RESTART;
585 sigaction(signal, &sa, NULL);
588 oldhandler = interrupt_handlers[signal];
589 interrupt_handlers[signal].c = handler;
591 sigprocmask(SIG_SETMASK, &old, 0);
593 FSHOW((stderr, "leaving POSIX install_handler(%d, ..)\n", signal));
595 return (unsigned long)oldhandler.lisp;
603 for (i = 0; i < NSIG; i++) {
604 interrupt_handlers[i].c =
605 /* (The cast here blasts away the distinction between
606 * SA_SIGACTION-style three-argument handlers and
607 * signal(..)-style one-argument handlers, which is OK
608 * because it works to call the 1-argument form where the
609 * 3-argument form is expected.) */
610 (void (*)(int, siginfo_t*, void*))SIG_DFL;