src/lisp/interrupt.c

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