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