src/lisp/interrupt.c

   1 /*
   2
   3  This code was written as part of the CMU Common Lisp project at
   4  Carnegie Mellon University, and has been placed in the public domain.
   5
   6 */
   7
   8 /* Interrupt handling magic. */
   9
  10 #include <stdio.h>
  11 #include <unistd.h>
  12 #include <stdlib.h>
  13 #include <signal.h>
  14 #include <assert.h>
  15
  16 #include "lisp.h"
  17 #include "arch.h"
  18 #include "internals.h"
  19 #include "os.h"
  20 #include "interrupt.h"
  21 #include "globals.h"
  22 #include "lispregs.h"
  23 #include "validate.h"
  24 #include "monitor.h"
  25 #include "gc.h"
  26 #include "alloc.h"
  27 #include "dynbind.h"
  28 #include "interr.h"
  29
  30 boolean internal_errors_enabled = 0;
  31
  32 os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
  33
  34 union interrupt_handler interrupt_handlers[NSIG];
  35 void (*interrupt_low_level_handlers[NSIG])(HANDLER_ARGS) = {0};
  36
  37 static int pending_signal = 0;
  38 static siginfo_t pending_code = {0};
  39 static sigset_t pending_mask;
  40 static boolean maybe_gc_pending = FALSE;
  41
  42
  43 /****************************************************************\
  44 * Utility routines used by various signal handlers.              *
  45 \****************************************************************/
  46
  47 void
  48 build_fake_control_stack_frame(os_context_t * context)
  49 {
  50 #if !(defined(i386) || defined(__x86_64))
  51     lispobj oldcont;
  52
  53     /* Build a fake stack frame */
  54     current_control_frame_pointer = (lispobj *) SC_REG(context, reg_CSP);
  55     if ((lispobj *) SC_REG(context, reg_CFP) == current_control_frame_pointer) {
  56         /* There is a small window during call where the callee's frame */
  57         /* isn't built yet. */
  58         if (LowtagOf(SC_REG(context, reg_CODE)) == type_FunctionPointer) {
  59             /* We have called, but not built the new frame, so
  60                build it for them. */
  61             current_control_frame_pointer[0] = SC_REG(context, reg_OCFP);
  62             current_control_frame_pointer[1] = SC_REG(context, reg_LRA);
  63             current_control_frame_pointer += 8;
  64             /* Build our frame on top of it. */
  65             oldcont = (lispobj) SC_REG(context, reg_CFP);
  66         } else {
  67             /* We haven't yet called, build our frame as if the
  68                partial frame wasn't there. */
  69             oldcont = (lispobj) SC_REG(context, reg_OCFP);
  70         }
  71     }
  72     /* ### We can't tell if we are still in the caller if it had to
  73        reg_ALLOCate the stack frame due to stack arguments. */
  74     /* ### Can anything strange happen during return? */
  75     else {
  76
  77         /* Normal case. */
  78         oldcont = (lispobj) SC_REG(context, reg_CFP);
  79     }
  80
  81     current_control_stack_pointer = current_control_frame_pointer + 8;
  82
  83     current_control_frame_pointer[0] = oldcont;
  84     current_control_frame_pointer[1] = NIL;
  85     current_control_frame_pointer[2] = (lispobj) SC_REG(context, reg_CODE);
  86 #endif
  87 }
  88
  89 void
  90 fake_foreign_function_call(os_context_t * context)
  91 {
  92     int context_index;
  93
  94     /* Get current LISP state from context */
  95 #ifdef reg_ALLOC
  96     current_dynamic_space_free_pointer = (lispobj *) SC_REG(context, reg_ALLOC);
  97 #ifdef alpha
  98     if ((long) current_dynamic_space_free_pointer & 1) {
  99         printf("Dead in fake_foriegn_function-call, context = %x\n", context);
 100         lose("");
 101     }
 102 #endif
 103 #endif
 104 #ifdef reg_BSP
 105     current_binding_stack_pointer = (lispobj *) SC_REG(context, reg_BSP);
 106 #endif
 107
 108     build_fake_control_stack_frame(context);
 109
 110     /* Do dynamic binding of the active interrupt context index
 111        and save the context in the context array. */
 112     context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2;
 113
 114     if (context_index >= MAX_INTERRUPTS) {
 115         fprintf(stderr,
 116                 "Maximum number (%d) of interrupts exceeded.  Exiting.\n",
 117                 MAX_INTERRUPTS);
 118         exit(1);
 119     }
 120
 121     bind_variable(FREE_INTERRUPT_CONTEXT_INDEX, make_fixnum(context_index + 1));
 122
 123     lisp_interrupt_contexts[context_index] = context;
 124
 125     /* No longer in Lisp now. */
 126     foreign_function_call_active = 1;
 127 }
 128
 129 void
 130 undo_fake_foreign_function_call(os_context_t * context)
 131 {
 132     /* Block all blockable signals */
 133     sigset_t block;
 134
 135     sigemptyset(&block);
 136     FILLBLOCKSET(&block);
 137     sigprocmask(SIG_BLOCK, &block, 0);
 138
 139     /* Going back into lisp. */
 140     foreign_function_call_active = 0;
 141
 142     /* Undo dynamic binding. */
 143     /* ### Do I really need to unbind_to_here()? */
 144     unbind();
 145
 146 #ifdef reg_ALLOC
 147     /* Put the dynamic space free pointer back into the context. */
 148     SC_REG(context, reg_ALLOC) =
 149         (unsigned long) current_dynamic_space_free_pointer;
 150 #endif
 151 }
 152
 153 void
 154 interrupt_internal_error(HANDLER_ARGS, boolean continuable)
 155 {
 156     ucontext_t *ucontext = (ucontext_t *) context;
 157     lispobj context_sap = NIL;
 158
 159     fake_foreign_function_call(context);
 160
 161     /* Allocate the SAP object while the interrupts are still disabled. */
 162     if (internal_errors_enabled)
 163         context_sap = alloc_sap(context);
 164
 165     sigprocmask(SIG_SETMASK, &ucontext->uc_sigmask, 0);
 166
 167     if (internal_errors_enabled)
 168         funcall2(SymbolFunction(INTERNAL_ERROR), context_sap,
 169                  continuable ? T : NIL);
 170     else
 171         internal_error(context);
 172     undo_fake_foreign_function_call(context);
 173     if (continuable)
 174         arch_skip_instruction(context);
 175 }
 176
 177 static void
 178 copy_sigmask(sigset_t *dst, sigset_t *src)
 179 {
 180 #ifndef __linux__
 181     *dst = *src;
 182 #else
 183     memcpy(dst, src, NSIG / CHAR_BIT);
 184 #endif
 185 }
 186
 187 void
 188 interrupt_handle_pending(os_context_t * context)
 189 {
 190 #ifndef i386
 191     boolean were_in_lisp = !foreign_function_call_active;
 192 #endif
 193
 194     SetSymbolValue(INTERRUPT_PENDING, NIL);
 195
 196     if (maybe_gc_pending) {
 197         maybe_gc_pending = FALSE;
 198 #ifndef i386
 199         if (were_in_lisp)
 200 #endif
 201             fake_foreign_function_call(context);
 202         funcall0(SymbolFunction(MAYBE_GC));
 203 #ifndef i386
 204         if (were_in_lisp)
 205 #endif
 206             undo_fake_foreign_function_call(context);
 207     }
 208
 209     copy_sigmask(&context->uc_sigmask, &pending_mask);
 210     sigemptyset(&pending_mask);
 211
 212     if (pending_signal) {
 213         int signal;
 214         siginfo_t code;
 215
 216         signal = pending_signal;
 217         code = pending_code;
 218         pending_signal = 0;
 219         /* pending_code = 0; */
 220         interrupt_handle_now(signal, &code, context);
 221     }
 222 }
 223
 224
 225 /****************************************************************\
 226 * interrupt_handle_now_handler, maybe_now_maybe_later            *
 227 *    the two main signal handlers.                               *
 228 * interrupt_handle_now                                           *
 229 *    is called from those to do the real work, but isn't itself  *
 230 *    a handler.                                                  *
 231 \****************************************************************/
 232
 233 void
 234 interrupt_handle_now_handler(HANDLER_ARGS)
 235 {
 236     interrupt_handle_now(signal, code, context);
 237
 238 #if defined(DARWIN) && defined(__ppc__)
 239     /* Work around G5 bug; fix courtesy gbyers via chandler */
 240     sigreturn(context);
 241 #endif
 242 }
 243
 244 void
 245 interrupt_handle_now(HANDLER_ARGS)
 246 {
 247     int were_in_lisp;
 248     ucontext_t *ucontext = (ucontext_t *) context;
 249     union interrupt_handler handler;
 250
 251     handler = interrupt_handlers[signal];
 252
 253     RESTORE_FPU(context);
 254
 255     if (handler.c == (void (*)(HANDLER_ARGS)) SIG_IGN)
 256         return;
 257
 258     SAVE_CONTEXT();
 259     /**/ were_in_lisp = !foreign_function_call_active;
 260 #if ! (defined(i386) || defined(_x86_64))
 261     if (were_in_lisp)
 262 #endif
 263         fake_foreign_function_call(context);
 264
 265     if (handler.c == (void (*)(HANDLER_ARGS)) SIG_DFL)
 266         /* This can happen if someone tries to ignore or default on one of the */
 267         /* signals we need for runtime support, and the runtime support */
 268         /* decides to pass on it.  */
 269         lose("interrupt_handle_now: No handler for signal %d?\n", signal);
 270     else if (LowtagOf(handler.lisp) == type_FunctionPointer) {
 271         /* Allocate the SAP object while the interrupts are still
 272            disabled. */
 273         lispobj context_sap = alloc_sap(context);
 274
 275         /* Allow signals again. */
 276         sigprocmask(SIG_SETMASK, &ucontext->uc_sigmask, 0);
 277
 278 #if 1
 279         funcall3(handler.lisp, make_fixnum(signal), make_fixnum(CODE(code)),
 280                  context_sap);
 281 #else
 282         funcall3(handler.lisp, make_fixnum(signal), alloc_sap(code),
 283                  alloc_sap(context));
 284 #endif
 285     } else {
 286         /* Allow signals again. */
 287         sigprocmask(SIG_SETMASK, &ucontext->uc_sigmask, 0);
 288
 289         (*handler.c) (signal, code, context);
 290     }
 291
 292 #if !(defined(i386) || defined(__x86_64))
 293     if (were_in_lisp)
 294 #endif
 295         undo_fake_foreign_function_call(context);
 296 }
 297
 298 static void
 299 setup_pending_signal(HANDLER_ARGS)
 300 {
 301     ucontext_t *ucontext = (ucontext_t *) context;
 302     pending_signal = signal;
 303     /*
 304      * Note: We used to set pending_code = *code.  This doesn't work
 305      * very well on Solaris since code is sometimes NULL.  AFAICT, we
 306      * only care about the si_code value, so just get the si_code
 307      * value.  The CODE macro does something appropriate when code is
 308      * NULL.
 309      *
 310      * A look at the Lisp handlers shows that the code value is
 311      * ignored anyway.
 312      *
 313      */
 314     pending_code.si_code = CODE(code);
 315     copy_sigmask(&pending_mask, &ucontext->uc_sigmask);
 316     FILLBLOCKSET(&ucontext->uc_sigmask);
 317 }
 318
 319 static void
 320 maybe_now_maybe_later(HANDLER_ARGS)
 321 {
 322     SAVE_CONTEXT();
 323     if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
 324         setup_pending_signal(signal, code, context);
 325         SetSymbolValue(INTERRUPT_PENDING, T);
 326     } else if (
 327 #if !(defined(i386) || defined(__x86_64))
 328                   (!foreign_function_call_active) &&
 329 #endif
 330                   arch_pseudo_atomic_atomic(context)) {
 331         setup_pending_signal(signal, code, context);
 332         arch_set_pseudo_atomic_interrupted(context);
 333     } else {
 334         RESTORE_FPU(context);
 335         interrupt_handle_now(signal, code, context);
 336     }
 337
 338 #if defined(DARWIN) && defined(__ppc__)
 339     /* Work around G5 bug; fix courtesy gbyers via chandler */
 340     sigreturn(context);
 341 #endif
 342 }
 343
 344 /****************************************************************\
 345 * Stuff to detect and handle hitting the gc trigger.             *
 346 \****************************************************************/
 347
 348 #ifndef INTERNAL_GC_TRIGGER
 349 static boolean
 350 gc_trigger_hit(HANDLER_ARGS)
 351 {
 352     if (current_auto_gc_trigger == NULL) {
 353         return FALSE;
 354     } else {
 355         lispobj *badaddr = (lispobj *) arch_get_bad_addr(signal, code, context);
 356
 357 #ifdef PRINTNOISE
 358         fprintf(stderr,
 359                 "gc_trigger_hit: badaddr=%p, current_auto_gc_trigger=%p, limit=%p\n",
 360                 badaddr, current_auto_gc_trigger,
 361                 current_dynamic_space + dynamic_space_size);
 362 #endif
 363         return (badaddr >= current_auto_gc_trigger &&
 364                 (unsigned long) badaddr <
 365                 (unsigned long) current_dynamic_space +
 366                 (unsigned long) dynamic_space_size);
 367     }
 368 }
 369 #endif
 370
 371 #if !(defined(i386) || defined(__x86_64) || defined(GENCGC))
 372 boolean
 373 interrupt_maybe_gc(HANDLER_ARGS)
 374 {
 375     if (!foreign_function_call_active
 376 #ifndef INTERNAL_GC_TRIGGER
 377         && gc_trigger_hit(signal, code, context)
 378 #endif
 379         ) {
 380 #ifndef INTERNAL_GC_TRIGGER
 381         clear_auto_gc_trigger();
 382 #endif
 383
 384         if (arch_pseudo_atomic_atomic(context)) {
 385             maybe_gc_pending = TRUE;
 386             if (pending_signal == 0) {
 387                 copy_sigmask(&pending_mask, &context->uc_sigmask);
 388                 FILLBLOCKSET(&context->uc_sigmask);
 389             }
 390             arch_set_pseudo_atomic_interrupted(context);
 391         } else {
 392             fake_foreign_function_call(context);
 393             funcall0(SymbolFunction(MAYBE_GC));
 394             undo_fake_foreign_function_call(context);
 395         }
 396
 397         return TRUE;
 398     } else
 399         return FALSE;
 400 }
 401 #endif
 402
 403 /****************************************************************\
 404 * Noise to install handlers.                                     *
 405 \****************************************************************/
 406
 407 #if !(defined(i386) || defined(__x86_64))
 408 #define SIGNAL_STACK_SIZE SIGSTKSZ
 409 static char altstack[SIGNAL_STACK_SIZE];
 410 #endif
 411
 412 void
 413 interrupt_install_low_level_handler(int signal, void handler(HANDLER_ARGS))
 414 {
 415     struct sigaction sa;
 416
 417     sa.sa_sigaction = (void (*)(HANDLER_ARGS)) handler;
 418     sigemptyset(&sa.sa_mask);
 419     FILLBLOCKSET(&sa.sa_mask);
 420     sa.sa_flags = SA_RESTART | SA_SIGINFO;
 421
 422     /* Deliver protection violations on a dedicated signal stack,
 423        because, when we get that signal because of hitting a control
 424        stack guard zone, it's not a good idea to use more of the
 425        control stack for handling the signal.  */
 426     /* But we only need this on x86 since the Lisp control stack and the
 427        C control stack are the same.  For others, they're separate so
 428        the C stack can still be used.  */
 429 #ifdef RED_ZONE_HIT
 430     if (signal == PROTECTION_VIOLATION_SIGNAL) {
 431         stack_t sigstack;
 432
 433 #if (defined( i386 ) || defined(__x86_64))
 434         sigstack.ss_sp = (void *) SIGNAL_STACK_START;
 435 #else
 436         sigstack.ss_sp = (void *) altstack;
 437 #endif
 438         sigstack.ss_flags = 0;
 439         sigstack.ss_size = SIGNAL_STACK_SIZE;
 440         if (sigaltstack(&sigstack, 0) == -1)
 441             perror("sigaltstack");
 442         sa.sa_flags |= SA_ONSTACK;
 443     }
 444 #endif /* RED_ZONE_HIT */
 445
 446     sigaction(signal, &sa, NULL);
 447
 448
 449     if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL)
 450         interrupt_low_level_handlers[signal] = 0;
 451     else
 452         interrupt_low_level_handlers[signal] = handler;
 453 }
 454
 455 unsigned long
 456 install_handler(int signal, void handler(HANDLER_ARGS))
 457 {
 458     struct sigaction sa;
 459     sigset_t old, new;
 460     union interrupt_handler oldhandler;
 461
 462     sigemptyset(&new);
 463     sigaddset(&new, signal);
 464     sigprocmask(SIG_BLOCK, &new, &old);
 465
 466     sigemptyset(&new);
 467     FILLBLOCKSET(&new);
 468
 469     if (interrupt_low_level_handlers[signal] == 0) {
 470         if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL
 471             || handler == (void (*)(HANDLER_ARGS)) SIG_IGN)
 472             sa.sa_sigaction = (void (*)(HANDLER_ARGS)) handler;
 473         else if (sigismember(&new, signal))
 474             sa.sa_sigaction = (void (*)(HANDLER_ARGS)) maybe_now_maybe_later;
 475         else
 476             sa.sa_sigaction = (void (*)(HANDLER_ARGS)) interrupt_handle_now_handler;
 477
 478         sigemptyset(&sa.sa_mask);
 479         FILLBLOCKSET(&sa.sa_mask);
 480         sa.sa_flags = SA_SIGINFO | SA_RESTART;
 481
 482         sigaction(signal, &sa, NULL);
 483     }
 484
 485     oldhandler = interrupt_handlers[signal];
 486     interrupt_handlers[signal].c = handler;
 487
 488     sigprocmask(SIG_SETMASK, &old, 0);
 489
 490     return (unsigned long) oldhandler.lisp;
 491 }
 492
 493 #ifdef FEATURE_HEAP_OVERFLOW_CHECK
 494 void
 495 interrupt_handle_space_overflow(lispobj error, os_context_t * context)
 496 {
 497 #if defined(i386) || defined(__x86_64)
 498     SC_PC(context) = (int) ((struct function *) PTR(error))->code;
 499     SC_REG(context, reg_NARGS) = 0;
 500 #elif defined(sparc)
 501     build_fake_control_stack_frame(context);
 502     /* This part should be common to all non-x86 ports */
 503     SC_PC(context) = (long) ((struct function *) PTR(error))->code;
 504     SC_NPC(context) = SC_PC(context) + 4;
 505     SC_REG(context, reg_NARGS) = 0;
 506     SC_REG(context, reg_LIP) = (long) ((struct function *) PTR(error))->code;
 507     SC_REG(context, reg_CFP) = (long) current_control_frame_pointer;
 508     /* This is sparc specific */
 509     SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer;
 510     /*
 511      * Restore important Lisp regs.  Are there others we need to
 512      * restore?
 513      */
 514     SC_REG(context, reg_ALLOC) = (long) current_dynamic_space_free_pointer;
 515     SC_REG(context, reg_NIL) = NIL;
 516 #else
 517 #error interrupt_handle_space_overflow not implemented for this system
 518 #endif
 519 }
 520 #endif /* FEATURE_HEAP_OVERFLOW_CHECK */
 521
 522 void
 523 interrupt_init(void)
 524 {
 525     int i;
 526
 527     for (i = 0; i < NSIG; i++)
 528         interrupt_handlers[i].c = (void (*)(HANDLER_ARGS)) SIG_DFL;
 529 }