src/runtime/interrupt.c

   1 /*
   2  * interrupt-handling magic
   3  */
   4
   5 /*
   6  * This software is part of the SBCL system. See the README file for
   7  * more information.
   8  *
   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.
  14  */
  15
  16 /*
  17  * $Header$
  18  */
  19
  20 #include <stdio.h>
  21
  22 #include <signal.h>
  23 #ifdef mach /* KLUDGE: #ifdef on lowercase symbols? Ick. -- WHN 19990904 */
  24 #ifdef mips
  25 #include <mips/cpu.h>
  26 #endif
  27 #endif
  28
  29 #include "runtime.h"
  30 #include "arch.h"
  31 #include "sbcl.h"
  32 #include "os.h"
  33 #include "interrupt.h"
  34 #include "globals.h"
  35 #include "lispregs.h"
  36 #include "validate.h"
  37 #include "monitor.h"
  38 #include "gc.h"
  39 #include "alloc.h"
  40 #include "dynbind.h"
  41 #include "interr.h"
  42
  43 void sigaddset_blockable(sigset_t *s)
  44 {
  45     sigaddset(s, SIGHUP);
  46     sigaddset(s, SIGINT);
  47     sigaddset(s, SIGQUIT);
  48     sigaddset(s, SIGPIPE);
  49     sigaddset(s, SIGALRM);
  50     sigaddset(s, SIGURG);
  51     sigaddset(s, SIGTSTP);
  52     sigaddset(s, SIGCHLD);
  53     sigaddset(s, SIGIO);
  54     sigaddset(s, SIGXCPU);
  55     sigaddset(s, SIGXFSZ);
  56     sigaddset(s, SIGVTALRM);
  57     sigaddset(s, SIGPROF);
  58     sigaddset(s, SIGWINCH);
  59     sigaddset(s, SIGUSR1);
  60     sigaddset(s, SIGUSR2);
  61 }
  62
  63 /* When we catch an internal error, should we pass it back to Lisp to
  64  * be handled in a high-level way? (Early in cold init, the answer is
  65  * 'no', because Lisp is still too brain-dead to handle anything.
  66  * After sufficient initialization has been completed, the answer
  67  * becomes 'yes'.) */
  68 boolean internal_errors_enabled = 0;
  69
  70 os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
  71
  72 /* As far as I can tell, what's going on here is:
  73  *
  74  * In the case of most signals, when Lisp asks us to handle the
  75  * signal, the outermost handler (the one actually passed to UNIX) is
  76  * either interrupt_handle_now(..) or interrupt_handle_later(..).
  77  * In that case, the Lisp-level handler is stored in interrupt_handlers[..]
  78  * and interrupt_low_level_handlers[..] is cleared.
  79  *
  80  * However, some signals need special handling, e.g. the SIGSEGV (for
  81  * Linux) or SIGBUS (for FreeBSD) used by the garbage collector to
  82  * detect violations of write protection, because some cases of such
  83  * signals are handled at C level and never passed on to Lisp. For
  84  * such signals, we still store any Lisp-level handler in
  85  * interrupt_handlers[..], but for the outermost handle we use the
  86  * value from interrupt_low_level_handlers[..], instead of the
  87  * ordinary interrupt_handle_now(..) or interrupt_handle_later(..).
  88  *
  89  * -- WHN 20000728 */
  90 void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, void*) = {0};
  91 union interrupt_handler interrupt_handlers[NSIG];
  92
  93 /* signal number, siginfo_t, and old mask information for pending signal
  94  *
  95  * pending_signal=0 when there is no pending signal. */
  96 static int pending_signal = 0;
  97 static siginfo_t pending_info;
  98 static sigset_t pending_mask;
  99
 100 static boolean maybe_gc_pending = 0;
 101 \f
 102 /*
 103  * utility routines used by various signal handlers
 104  */
 105
 106 void
 107 fake_foreign_function_call(os_context_t *context)
 108 {
 109     int context_index;
 110 #ifndef __i386__
 111     lispobj oldcont;
 112 #endif
 113
 114     /* Get current Lisp state from context. */
 115 #ifdef reg_ALLOC
 116     current_dynamic_space_free_pointer =
 117         (lispobj *)(*os_context_register_addr(context, reg_ALLOC));
 118 #ifdef alpha
 119     if ((long)current_dynamic_space_free_pointer & 1) {
 120       lose("dead in fake_foreign_function_call, context = %x", context);
 121     }
 122 #endif
 123 #endif
 124 #ifdef reg_BSP
 125     current_binding_stack_pointer =
 126         (lispobj *)(*os_context_register_addr(context, reg_BSP));
 127 #endif
 128
 129 #ifndef __i386__
 130     /* Build a fake stack frame. */
 131     current_control_frame_pointer =
 132         (lispobj *)(*os_context_register_addr(context, reg_CSP));
 133     if ((lispobj *)(*os_context_register_addr(context, reg_CFP))
 134         == current_control_frame_pointer) {
 135         /* There is a small window during call where the callee's
 136          * frame isn't built yet. */
 137         if (LowtagOf(*os_context_register_addr(context, reg_CODE))
 138             == type_FunctionPointer) {
 139             /* We have called, but not built the new frame, so
 140              * build it for them. */
 141             current_control_frame_pointer[0] =
 142                 *os_context_register_addr(context, reg_OCFP);
 143             current_control_frame_pointer[1] =
 144                 *os_context_register_addr(context, reg_LRA);
 145             current_control_frame_pointer += 8;
 146             /* Build our frame on top of it. */
 147             oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
 148         }
 149         else {
 150             /* We haven't yet called, build our frame as if the
 151              * partial frame wasn't there. */
 152             oldcont = (lispobj)(*os_context_register_addr(context, reg_OCFP));
 153         }
 154     }
 155     /* ### We can't tell if we are still in the caller if it had to
 156      * reg_ALLOCate the stack frame due to stack arguments. */
 157     /* ### Can anything strange happen during return? */
 158     else
 159         /* normal case */
 160         oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
 161
 162     current_control_stack_pointer = current_control_frame_pointer + 8;
 163
 164     current_control_frame_pointer[0] = oldcont;
 165     current_control_frame_pointer[1] = NIL;
 166     current_control_frame_pointer[2] =
 167         (lispobj)(*os_context_register_addr(context, reg_CODE));
 168 #endif
 169
 170     /* Do dynamic binding of the active interrupt context index
 171      * and save the context in the context array. */
 172     context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
 173     /* FIXME: Ick! Why use abstract "make_fixnum" in some places if
 174      * you're going to convert from fixnum by bare >>2 in other
 175      * places? Use fixnum_value(..) here, and look for other places
 176      * which do bare >> and << for fixnum_value and make_fixnum. */
 177
 178     if (context_index >= MAX_INTERRUPTS) {
 179         lose("maximum interrupt nesting depth (%d) exceeded",
 180              MAX_INTERRUPTS);
 181     }
 182
 183     bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,
 184                   make_fixnum(context_index + 1));
 185
 186     lisp_interrupt_contexts[context_index] = context;
 187
 188     /* no longer in Lisp now */
 189     foreign_function_call_active = 1;
 190 }
 191
 192 void
 193 undo_fake_foreign_function_call(os_context_t *context)
 194 {
 195     /* Block all blockable signals. */
 196     sigset_t block;
 197     sigemptyset(&block);
 198     sigaddset_blockable(&block);
 199     sigprocmask(SIG_BLOCK, &block, 0);
 200
 201     /* going back into Lisp */
 202     foreign_function_call_active = 0;
 203
 204     /* Undo dynamic binding. */
 205     /* ### Do I really need to unbind_to_here()? */
 206     /* FIXME: Is this to undo the binding of
 207      * FREE_INTERRUPT_CONTEXT_INDEX? If so, we should say so. And
 208      * perhaps yes, unbind_to_here() really would be clearer and less
 209      * fragile.. */
 210     unbind();
 211
 212 #ifdef reg_ALLOC
 213     /* Put the dynamic space free pointer back into the context. */
 214     *os_context_register_addr(context, reg_ALLOC) =
 215         (unsigned long) current_dynamic_space_free_pointer;
 216 #endif
 217 }
 218
 219 /* a handler for the signal caused by execution of a trap opcode
 220  * signalling an internal error */
 221 void
 222 interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context,
 223                          boolean continuable)
 224 {
 225     lispobj context_sap;
 226
 227     fake_foreign_function_call(context);
 228
 229     /* Allocate the SAP object while the interrupts are still
 230      * disabled. */
 231     if (internal_errors_enabled) {
 232         context_sap = alloc_sap(context);
 233     }
 234
 235     sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 236
 237     if (internal_errors_enabled) {
 238         SHOW("in interrupt_internal_error");
 239 #if QSHOW
 240         /* Display some rudimentary debugging information about the
 241          * error, so that even if the Lisp error handler gets badly
 242          * confused, we have a chance to determine what's going on. */
 243         describe_internal_error(context);
 244 #endif
 245         funcall2(SymbolFunction(INTERNAL_ERROR), context_sap,
 246                  continuable ? T : NIL);
 247     } else {
 248         describe_internal_error(context);
 249         /* There's no good way to recover from an internal error
 250          * before the Lisp error handling mechanism is set up. */
 251         lose("internal error too early in init, can't recover");
 252     }
 253     undo_fake_foreign_function_call(context);
 254     if (continuable) {
 255         arch_skip_instruction(context);
 256     }
 257 }
 258
 259 void
 260 interrupt_handle_pending(os_context_t *context)
 261 {
 262     boolean were_in_lisp = !foreign_function_call_active;
 263
 264     SetSymbolValue(INTERRUPT_PENDING, NIL);
 265
 266     if (maybe_gc_pending) {
 267         maybe_gc_pending = 0;
 268 #ifndef __i386__
 269         if (were_in_lisp)
 270 #endif
 271         {
 272             fake_foreign_function_call(context);
 273         }
 274         funcall0(SymbolFunction(MAYBE_GC));
 275 #ifndef __i386__
 276         if (were_in_lisp)
 277 #endif
 278         {
 279             undo_fake_foreign_function_call(context);
 280         }
 281     }
 282
 283     /* FIXME: How come we unconditionally copy from pending_mask into
 284      * the context, and then test whether pending_signal is set? If
 285      * pending_signal wasn't set, how could pending_mask be valid? */
 286     memcpy(os_context_sigmask_addr(context), &pending_mask, sizeof(sigset_t));
 287     sigemptyset(&pending_mask);
 288     if (pending_signal) {
 289         int signal = pending_signal;
 290         siginfo_t info;
 291         memcpy(&info, &pending_info, sizeof(siginfo_t));
 292         pending_signal = 0;
 293         interrupt_handle_now(signal, &info, context);
 294     }
 295 }
 296 \f
 297 /*
 298  * the two main signal handlers:
 299  *   interrupt_handle_now(..)
 300  *   maybe_now_maybe_later(..)
 301  */
 302
 303 void
 304 interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 305 {
 306     os_context_t *context = (os_context_t*)void_context;
 307     int were_in_lisp;
 308     union interrupt_handler handler;
 309
 310 #ifdef __linux__
 311     SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
 312 #endif
 313
 314     handler = interrupt_handlers[signal];
 315
 316     if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) {
 317         return;
 318     }
 319
 320     were_in_lisp = !foreign_function_call_active;
 321 #ifndef __i386__
 322     if (were_in_lisp)
 323 #endif
 324     {
 325         fake_foreign_function_call(context);
 326     }
 327
 328 #ifdef QSHOW_SIGNALS
 329     FSHOW((stderr, "in interrupt_handle_now(%d, info, context)\n", signal));
 330 #endif
 331
 332     if (ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
 333
 334         /* This can happen if someone tries to ignore or default one
 335          * of the signals we need for runtime support, and the runtime
 336          * support decides to pass on it. */
 337         lose("no handler for signal %d in interrupt_handle_now(..)", signal);
 338
 339     } else if (LowtagOf(handler.lisp) == type_FunctionPointer) {
 340
 341         /* Allocate the SAPs while the interrupts are still disabled.
 342          * (FIXME: Why? This is the way it was done in CMU CL, and it
 343          * even had the comment noting that this is the way it was
 344          * done, but no motivation..) */
 345         lispobj context_sap = alloc_sap(context);
 346         lispobj info_sap = alloc_sap(info);
 347
 348         /* Allow signals again. */
 349         sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 350
 351 #ifdef QSHOW_SIGNALS
 352         SHOW("calling Lisp-level handler");
 353 #endif
 354
 355         funcall3(handler.lisp,
 356                  make_fixnum(signal),
 357                  info_sap,
 358                  context_sap);
 359     } else {
 360
 361 #ifdef QSHOW_SIGNALS
 362         SHOW("calling C-level handler");
 363 #endif
 364
 365         /* Allow signals again. */
 366         sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 367
 368         (*handler.c)(signal, info, void_context);
 369     }
 370
 371 #ifndef __i386__
 372     if (were_in_lisp)
 373 #endif
 374     {
 375         undo_fake_foreign_function_call(context);
 376     }
 377 }
 378
 379 static void
 380 maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 381 {
 382     os_context_t *context = (os_context_t*)void_context;
 383
 384     /* FIXME: See Debian cmucl 2.4.17, and mail from DTC on the CMU CL
 385      * mailing list 23 Oct 1999, for changes in FPU handling at
 386      * interrupt time which should be ported into SBCL.
 387      *
 388      * (Is this related to the way that it seems that if we do decide
 389      * to handle the interrupt later, we've now screwed up the FPU
 390      * control word?) */
 391 #ifdef __linux__
 392     SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw);
 393 #endif
 394
 395     if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
 396
 397         /* FIXME: This code is exactly the same as the code in the
 398          * other leg of the if(..), and should be factored out into
 399          * a shared function. */
 400         pending_signal = signal;
 401         memcpy(&pending_info, info, sizeof(siginfo_t));
 402         memcpy(&pending_mask,
 403                os_context_sigmask_addr(context),
 404                sizeof(sigset_t));
 405         sigaddset_blockable(os_context_sigmask_addr(context));
 406
 407         SetSymbolValue(INTERRUPT_PENDING, T);
 408
 409     } else if (
 410 #ifndef __i386__
 411                (!foreign_function_call_active) &&
 412 #endif
 413                arch_pseudo_atomic_atomic(context)) {
 414
 415         /* FIXME: It would probably be good to replace these bare
 416          * memcpy(..) calls with calls to cpy_siginfo_t and
 417          * cpy_sigset_t, so that we only have to get the sizeof
 418          * expressions right in one place, and after that static type
 419          * checking takes over. */
 420         pending_signal = signal;
 421         memcpy(&pending_info, info, sizeof(siginfo_t));
 422         memcpy(&pending_mask,
 423                os_context_sigmask_addr(context),
 424                sizeof(sigset_t));
 425         sigaddset_blockable(os_context_sigmask_addr(context));
 426
 427         arch_set_pseudo_atomic_interrupted(context);
 428
 429     } else {
 430         interrupt_handle_now(signal, info, context);
 431     }
 432 }
 433 \f
 434 /*
 435  * stuff to detect and handle hitting the GC trigger
 436  */
 437
 438 #ifndef INTERNAL_GC_TRIGGER
 439 static boolean
 440 gc_trigger_hit(int signal, siginfo_t *info, os_context_t *context)
 441 {
 442     if (current_auto_gc_trigger == NULL)
 443         return 0;
 444     else{
 445         lispobj *badaddr=(lispobj *)arch_get_bad_addr(signal,
 446                                                       info,
 447                                                       context);
 448
 449         return (badaddr >= current_auto_gc_trigger &&
 450                 badaddr < current_dynamic_space + DYNAMIC_SPACE_SIZE);
 451     }
 452 }
 453 #endif
 454
 455 #ifndef __i386__
 456 boolean
 457 interrupt_maybe_gc(int signal, siginfo_t *info, os_context_t *context)
 458 {
 459     if (!foreign_function_call_active
 460 #ifndef INTERNAL_GC_TRIGGER
 461         && gc_trigger_hit(signal, info, context)
 462 #endif
 463         ) {
 464 #ifndef INTERNAL_GC_TRIGGER
 465         clear_auto_gc_trigger();
 466 #endif
 467
 468         if (arch_pseudo_atomic_atomic(context)) {
 469             maybe_gc_pending = 1;
 470             if (pending_signal == 0) {
 471                 /* FIXME: This copy-pending_mask-then-sigaddset_blockable
 472                  * idiom occurs over and over. It should be factored out
 473                  * into a function with a descriptive name. */
 474                 memcpy(&pending_mask,
 475                        os_context_sigmask_addr(context),
 476                        sizeof(sigset_t));
 477                 sigaddset_blockable(os_context_sigmask_addr(context));
 478             }
 479             arch_set_pseudo_atomic_interrupted(context);
 480         }
 481         else {
 482             fake_foreign_function_call(context);
 483             funcall0(SymbolFunction(MAYBE_GC));
 484             undo_fake_foreign_function_call(context);
 485         }
 486
 487         return 1;
 488     } else {
 489         return 0;
 490     }
 491 }
 492 #endif
 493 \f
 494 /*
 495  * noise to install handlers
 496  */
 497
 498 /* Install a special low-level handler for signal; or if handler is
 499  * SIG_DFL, remove any special handling for signal. */
 500 void
 501 interrupt_install_low_level_handler (int signal,
 502                                      void handler(int, siginfo_t*, void*))
 503 {
 504     struct sigaction sa;
 505
 506     sa.sa_sigaction = handler;
 507     sigemptyset(&sa.sa_mask);
 508     sigaddset_blockable(&sa.sa_mask);
 509     sa.sa_flags = SA_SIGINFO | SA_RESTART;
 510
 511     sigaction(signal, &sa, NULL);
 512     interrupt_low_level_handlers[signal] =
 513         (ARE_SAME_HANDLER(handler,SIG_DFL) ? 0 : handler);
 514 }
 515
 516 /* This is called from Lisp. */
 517 unsigned long
 518 install_handler(int signal, void handler(int, siginfo_t*, void*))
 519 {
 520     struct sigaction sa;
 521     sigset_t old, new;
 522     union interrupt_handler oldhandler;
 523
 524     FSHOW((stderr, "entering POSIX install_handler(%d, ..)\n", signal));
 525
 526     sigemptyset(&new);
 527     sigaddset(&new, signal);
 528     sigprocmask(SIG_BLOCK, &new, &old);
 529
 530     sigemptyset(&new);
 531     sigaddset_blockable(&new);
 532
 533     FSHOW((stderr, "interrupt_low_level_handlers[signal]=%d\n",
 534            interrupt_low_level_handlers[signal]));
 535     if (interrupt_low_level_handlers[signal]==0) {
 536         if (ARE_SAME_HANDLER(handler, SIG_DFL) ||
 537             ARE_SAME_HANDLER(handler, SIG_IGN)) {
 538             sa.sa_sigaction = handler;
 539         } else if (sigismember(&new, signal)) {
 540             sa.sa_sigaction = maybe_now_maybe_later;
 541         } else {
 542             sa.sa_sigaction = interrupt_handle_now;
 543         }
 544
 545         sigemptyset(&sa.sa_mask);
 546         sigaddset_blockable(&sa.sa_mask);
 547         sa.sa_flags = SA_SIGINFO | SA_RESTART;
 548
 549         sigaction(signal, &sa, NULL);
 550     }
 551
 552     oldhandler = interrupt_handlers[signal];
 553     interrupt_handlers[signal].c = handler;
 554
 555     sigprocmask(SIG_SETMASK, &old, 0);
 556
 557     FSHOW((stderr, "leaving POSIX install_handler(%d, ..)\n", signal));
 558
 559     return (unsigned long)oldhandler.lisp;
 560 }
 561
 562 void
 563 interrupt_init(void)
 564 {
 565     int i;
 566
 567     for (i = 0; i < NSIG; i++) {
 568         interrupt_handlers[i].c =
 569             /* (The cast here blasts away the distinction between
 570              * SA_SIGACTION-style three-argument handlers and
 571              * signal(..)-style one-argument handlers, which is OK
 572              * because it works to call the 1-argument form where the
 573              * 3-argument form is expected.) */
 574             (void (*)(int, siginfo_t*, void*))SIG_DFL;
 575     }
 576 }