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 /* As far as I can tell, what's going on here is:
  18  *
  19  * In the case of most signals, when Lisp asks us to handle the
  20  * signal, the outermost handler (the one actually passed to UNIX) is
  21  * either interrupt_handle_now(..) or maybe_now_maybe_later(..).
  22  * In that case, the Lisp-level handler is stored in interrupt_handlers[..]
  23  * and interrupt_low_level_handlers[..] is cleared.
  24  *
  25  * However, some signals need special handling, e.g.
  26  *
  27  * o the SIGSEGV (for e.g. Linux) or SIGBUS (for e.g. FreeBSD) used by the
  28  *   garbage collector to detect violations of write protection,
  29  *   because some cases of such signals (e.g. GC-related violations of
  30  *   write protection) are handled at C level and never passed on to
  31  *   Lisp. For such signals, we still store any Lisp-level handler
  32  *   in interrupt_handlers[..], but for the outermost handle we use
  33  *   the value from interrupt_low_level_handlers[..], instead of the
  34  *   ordinary interrupt_handle_now(..) or interrupt_handle_later(..).
  35  *
  36  * o the SIGTRAP (Linux/Alpha) which Lisp code uses to handle breakpoints,
  37  *   pseudo-atomic sections, and some classes of error (e.g. "function
  38  *   not defined").  This never goes anywhere near the Lisp handlers at all.
  39  *   See runtime/alpha-arch.c and code/signal.lisp
  40  *
  41  * - WHN 20000728, dan 20010128 */
  42
  43
  44 #include <stdio.h>
  45 #include <stdlib.h>
  46 #include <string.h>
  47 #include <signal.h>
  48 #include <sys/types.h>
  49 #include <sys/wait.h>
  50
  51 #include "sbcl.h"
  52 #include "runtime.h"
  53 #include "arch.h"
  54 #include "os.h"
  55 #include "interrupt.h"
  56 #include "globals.h"
  57 #include "lispregs.h"
  58 #include "validate.h"
  59 #include "monitor.h"
  60 #include "gc.h"
  61 #include "alloc.h"
  62 #include "dynbind.h"
  63 #include "interr.h"
  64 #include "genesis/fdefn.h"
  65 #include "genesis/simple-fun.h"
  66
  67
  68
  69 void run_deferred_handler(struct interrupt_data *data, void *v_context) ;
  70 static void store_signal_data_for_later (struct interrupt_data *data,
  71                                          void *handler, int signal,
  72                                          siginfo_t *info,
  73                                          os_context_t *context);
  74 boolean interrupt_maybe_gc_int(int signal, siginfo_t *info, void *v_context);
  75
  76 extern volatile lispobj all_threads_lock;
  77
  78 /*
  79  * This is a workaround for some slightly silly Linux/GNU Libc
  80  * behaviour: glibc defines sigset_t to support 1024 signals, which is
  81  * more than the kernel.  This is usually not a problem, but becomes
  82  * one when we want to save a signal mask from a ucontext, and restore
  83  * it later into another ucontext: the ucontext is allocated on the
  84  * stack by the kernel, so copying a libc-sized sigset_t into it will
  85  * overflow and cause other data on the stack to be corrupted */
  86
  87 #define REAL_SIGSET_SIZE_BYTES ((NSIG/8))
  88
  89 void sigaddset_blockable(sigset_t *s)
  90 {
  91     sigaddset(s, SIGHUP);
  92     sigaddset(s, SIGINT);
  93     sigaddset(s, SIGQUIT);
  94     sigaddset(s, SIGPIPE);
  95     sigaddset(s, SIGALRM);
  96     sigaddset(s, SIGURG);
  97     sigaddset(s, SIGFPE);
  98     sigaddset(s, SIGTSTP);
  99     sigaddset(s, SIGCHLD);
 100     sigaddset(s, SIGIO);
 101     sigaddset(s, SIGXCPU);
 102     sigaddset(s, SIGXFSZ);
 103     sigaddset(s, SIGVTALRM);
 104     sigaddset(s, SIGPROF);
 105     sigaddset(s, SIGWINCH);
 106     sigaddset(s, SIGUSR1);
 107     sigaddset(s, SIGUSR2);
 108 #ifdef LISP_FEATURE_SB_THREAD
 109     sigaddset(s, SIG_STOP_FOR_GC);
 110     sigaddset(s, SIG_INTERRUPT_THREAD);
 111     sigaddset(s, SIG_THREAD_EXIT);
 112 #endif
 113 }
 114
 115 /* When we catch an internal error, should we pass it back to Lisp to
 116  * be handled in a high-level way? (Early in cold init, the answer is
 117  * 'no', because Lisp is still too brain-dead to handle anything.
 118  * After sufficient initialization has been completed, the answer
 119  * becomes 'yes'.) */
 120 boolean internal_errors_enabled = 0;
 121
 122 struct interrupt_data * global_interrupt_data;
 123
 124 /* At the toplevel repl we routinely call this function.  The signal
 125  * mask ought to be clear anyway most of the time, but may be non-zero
 126  * if we were interrupted e.g. while waiting for a queue.  */
 127
 128 #if 1
 129 void reset_signal_mask ()
 130 {
 131     sigset_t new;
 132     sigemptyset(&new);
 133     sigprocmask(SIG_SETMASK,&new,0);
 134 }
 135 #else
 136 void reset_signal_mask ()
 137 {
 138     sigset_t new,old;
 139     int i;
 140     int wrong=0;
 141     sigemptyset(&new);
 142     sigprocmask(SIG_SETMASK,&new,&old);
 143     for(i=1; i<NSIG; i++) {
 144         if(sigismember(&old,i)) {
 145             fprintf(stderr,
 146                     "Warning: signal %d is masked: this is unexpected\n",i);
 147             wrong=1;
 148         }
 149     }
 150     if(wrong)
 151         fprintf(stderr,"If this version of SBCL is less than three months old, please report this.\nOtherwise, please try a newer version first\n.  Reset signal mask.\n");
 152 }
 153 #endif
 154
 155
 156
 157 \f
 158 /*
 159  * utility routines used by various signal handlers
 160  */
 161
 162 void
 163 build_fake_control_stack_frames(struct thread *th,os_context_t *context)
 164 {
 165 #ifndef LISP_FEATURE_X86
 166
 167     lispobj oldcont;
 168
 169     /* Build a fake stack frame or frames */
 170
 171     current_control_frame_pointer =
 172         (lispobj *)(*os_context_register_addr(context, reg_CSP));
 173     if ((lispobj *)(*os_context_register_addr(context, reg_CFP))
 174         == current_control_frame_pointer) {
 175         /* There is a small window during call where the callee's
 176          * frame isn't built yet. */
 177         if (lowtag_of(*os_context_register_addr(context, reg_CODE))
 178             == FUN_POINTER_LOWTAG) {
 179             /* We have called, but not built the new frame, so
 180              * build it for them. */
 181             current_control_frame_pointer[0] =
 182                 *os_context_register_addr(context, reg_OCFP);
 183             current_control_frame_pointer[1] =
 184                 *os_context_register_addr(context, reg_LRA);
 185             current_control_frame_pointer += 8;
 186             /* Build our frame on top of it. */
 187             oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
 188         }
 189         else {
 190             /* We haven't yet called, build our frame as if the
 191              * partial frame wasn't there. */
 192             oldcont = (lispobj)(*os_context_register_addr(context, reg_OCFP));
 193         }
 194     }
 195     /* We can't tell whether we are still in the caller if it had to
 196      * allocate a stack frame due to stack arguments. */
 197     /* This observation provoked some past CMUCL maintainer to ask
 198      * "Can anything strange happen during return?" */
 199     else {
 200         /* normal case */
 201         oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
 202     }
 203
 204     current_control_stack_pointer = current_control_frame_pointer + 8;
 205
 206     current_control_frame_pointer[0] = oldcont;
 207     current_control_frame_pointer[1] = NIL;
 208     current_control_frame_pointer[2] =
 209         (lispobj)(*os_context_register_addr(context, reg_CODE));
 210 #endif
 211 }
 212
 213 void
 214 fake_foreign_function_call(os_context_t *context)
 215 {
 216     int context_index;
 217     struct thread *thread=arch_os_get_current_thread();
 218
 219     /* Get current Lisp state from context. */
 220 #ifdef reg_ALLOC
 221     dynamic_space_free_pointer =
 222         (lispobj *)(*os_context_register_addr(context, reg_ALLOC));
 223 #ifdef alpha
 224     if ((long)dynamic_space_free_pointer & 1) {
 225         lose("dead in fake_foreign_function_call, context = %x", context);
 226     }
 227 #endif
 228 #endif
 229 #ifdef reg_BSP
 230     current_binding_stack_pointer =
 231         (lispobj *)(*os_context_register_addr(context, reg_BSP));
 232 #endif
 233
 234     build_fake_control_stack_frames(thread,context);
 235
 236     /* Do dynamic binding of the active interrupt context index
 237      * and save the context in the context array. */
 238     context_index =
 239         fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));
 240
 241     if (context_index >= MAX_INTERRUPTS) {
 242         lose("maximum interrupt nesting depth (%d) exceeded", MAX_INTERRUPTS);
 243     }
 244
 245     bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,
 246                   make_fixnum(context_index + 1),thread);
 247
 248     thread->interrupt_contexts[context_index] = context;
 249
 250     /* no longer in Lisp now */
 251     foreign_function_call_active = 1;
 252 }
 253
 254 /* blocks all blockable signals.  If you are calling from a signal handler,
 255  * the usual signal mask will be restored from the context when the handler
 256  * finishes.  Otherwise, be careful */
 257
 258 void
 259 undo_fake_foreign_function_call(os_context_t *context)
 260 {
 261     struct thread *thread=arch_os_get_current_thread();
 262     /* Block all blockable signals. */
 263     sigset_t block;
 264     sigemptyset(&block);
 265     sigaddset_blockable(&block);
 266     sigprocmask(SIG_BLOCK, &block, 0);
 267
 268     /* going back into Lisp */
 269     foreign_function_call_active = 0;
 270
 271     /* Undo dynamic binding of FREE_INTERRUPT_CONTEXT_INDEX */
 272     unbind(thread);
 273
 274 #ifdef reg_ALLOC
 275     /* Put the dynamic space free pointer back into the context. */
 276     *os_context_register_addr(context, reg_ALLOC) =
 277         (unsigned long) dynamic_space_free_pointer;
 278 #endif
 279 }
 280
 281 /* a handler for the signal caused by execution of a trap opcode
 282  * signalling an internal error */
 283 void
 284 interrupt_internal_error(int signal, siginfo_t *info, os_context_t *context,
 285                          boolean continuable)
 286 {
 287     lispobj context_sap = 0;
 288
 289     fake_foreign_function_call(context);
 290
 291     /* Allocate the SAP object while the interrupts are still
 292      * disabled. */
 293     if (internal_errors_enabled) {
 294         context_sap = alloc_sap(context);
 295     }
 296
 297     sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 298
 299     if (internal_errors_enabled) {
 300         SHOW("in interrupt_internal_error");
 301 #ifdef QSHOW
 302         /* Display some rudimentary debugging information about the
 303          * error, so that even if the Lisp error handler gets badly
 304          * confused, we have a chance to determine what's going on. */
 305         describe_internal_error(context);
 306 #endif
 307         funcall2(SymbolFunction(INTERNAL_ERROR), context_sap,
 308                  continuable ? T : NIL);
 309     } else {
 310         describe_internal_error(context);
 311         /* There's no good way to recover from an internal error
 312          * before the Lisp error handling mechanism is set up. */
 313         lose("internal error too early in init, can't recover");
 314     }
 315     undo_fake_foreign_function_call(context); /* blocks signals again */
 316     if (continuable) {
 317         arch_skip_instruction(context);
 318     }
 319 }
 320
 321 void
 322 interrupt_handle_pending(os_context_t *context)
 323 {
 324     struct thread *thread;
 325     struct interrupt_data *data;
 326
 327     thread=arch_os_get_current_thread();
 328     data=thread->interrupt_data;
 329     /* FIXME I'm not altogether sure this is appropriate if we're
 330      * here as the result of a pseudo-atomic */
 331     SetSymbolValue(INTERRUPT_PENDING, NIL,thread);
 332
 333     /* restore the saved signal mask from the original signal (the
 334      * one that interrupted us during the critical section) into the
 335      * os_context for the signal we're currently in the handler for.
 336      * This should ensure that when we return from the handler the
 337      * blocked signals are unblocked */
 338
 339     memcpy(os_context_sigmask_addr(context), &data->pending_mask,
 340            REAL_SIGSET_SIZE_BYTES);
 341
 342     sigemptyset(&data->pending_mask);
 343     /* This will break on sparc linux: the deferred handler really wants
 344      * to be called with a void_context */
 345     run_deferred_handler(data,(void *)context);
 346 }
 347 \f
 348 /*
 349  * the two main signal handlers:
 350  *   interrupt_handle_now(..)
 351  *   maybe_now_maybe_later(..)
 352  *
 353  * to which we have added interrupt_handle_now_handler(..).  Why?
 354  * Well, mostly because the SPARC/Linux platform doesn't quite do
 355  * signals the way we want them done.  The third argument in the
 356  * handler isn't filled in by the kernel properly, so we fix it up
 357  * ourselves in the arch_os_get_context(..) function; however, we only
 358  * want to do this when we first hit the handler, and not when
 359  * interrupt_handle_now(..) is being called from some other handler
 360  * (when the fixup will already have been done). -- CSR, 2002-07-23
 361  */
 362
 363 void
 364 interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
 365 {
 366     os_context_t *context = (os_context_t*)void_context;
 367     struct thread *thread=arch_os_get_current_thread();
 368 #ifndef LISP_FEATURE_X86
 369     boolean were_in_lisp;
 370 #endif
 371     union interrupt_handler handler;
 372
 373 #ifdef LISP_FEATURE_LINUX
 374     /* Under Linux on some architectures, we appear to have to restore
 375        the FPU control word from the context, as after the signal is
 376        delivered we appear to have a null FPU control word. */
 377     os_restore_fp_control(context);
 378 #endif
 379     handler = thread->interrupt_data->interrupt_handlers[signal];
 380
 381     if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) {
 382         return;
 383     }
 384
 385 #ifndef LISP_FEATURE_X86
 386     were_in_lisp = !foreign_function_call_active;
 387     if (were_in_lisp)
 388 #endif
 389     {
 390         fake_foreign_function_call(context);
 391     }
 392
 393 #ifdef QSHOW_SIGNALS
 394     FSHOW((stderr,
 395            "/entering interrupt_handle_now(%d, info, context)\n",
 396            signal));
 397 #endif
 398
 399     if (ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
 400
 401         /* This can happen if someone tries to ignore or default one
 402          * of the signals we need for runtime support, and the runtime
 403          * support decides to pass on it. */
 404         lose("no handler for signal %d in interrupt_handle_now(..)", signal);
 405
 406     } else if (lowtag_of(handler.lisp) == FUN_POINTER_LOWTAG) {
 407         /* Once we've decided what to do about contexts in a
 408          * return-elsewhere world (the original context will no longer
 409          * be available; should we copy it or was nobody using it anyway?)
 410          * then we should convert this to return-elsewhere */
 411
 412         /* CMUCL comment said "Allocate the SAPs while the interrupts
 413          * are still disabled.".  I (dan, 2003.08.21) assume this is
 414          * because we're not in pseudoatomic and allocation shouldn't
 415          * be interrupted.  In which case it's no longer an issue as
 416          * all our allocation from C now goes through a PA wrapper,
 417          * but still, doesn't hurt */
 418
 419         lispobj info_sap,context_sap = alloc_sap(context);
 420         info_sap = alloc_sap(info);
 421         /* Allow signals again. */
 422         sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 423
 424 #ifdef QSHOW_SIGNALS
 425         SHOW("calling Lisp-level handler");
 426 #endif
 427
 428         funcall3(handler.lisp,
 429                  make_fixnum(signal),
 430                  info_sap,
 431                  context_sap);
 432     } else {
 433
 434 #ifdef QSHOW_SIGNALS
 435         SHOW("calling C-level handler");
 436 #endif
 437
 438         /* Allow signals again. */
 439         sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 440
 441         (*handler.c)(signal, info, void_context);
 442     }
 443
 444 #ifndef LISP_FEATURE_X86
 445     if (were_in_lisp)
 446 #endif
 447     {
 448         undo_fake_foreign_function_call(context); /* block signals again */
 449     }
 450
 451 #ifdef QSHOW_SIGNALS
 452     FSHOW((stderr,
 453            "/returning from interrupt_handle_now(%d, info, context)\n",
 454            signal));
 455 #endif
 456 }
 457
 458 /* This is called at the end of a critical section if the indications
 459  * are that some signal was deferred during the section.  Note that as
 460  * far as C or the kernel is concerned we dealt with the signal
 461  * already; we're just doing the Lisp-level processing now that we
 462  * put off then */
 463
 464 void
 465 run_deferred_handler(struct interrupt_data *data, void *v_context) {
 466     (*(data->pending_handler))
 467         (data->pending_signal,&(data->pending_info), v_context);
 468     data->pending_handler=0;
 469 }
 470
 471 boolean
 472 maybe_defer_handler(void *handler, struct interrupt_data *data,
 473                     int signal, siginfo_t *info, os_context_t *context)
 474 {
 475     struct thread *thread=arch_os_get_current_thread();
 476     if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) {
 477         store_signal_data_for_later(data,handler,signal,info,context);
 478         SetSymbolValue(INTERRUPT_PENDING, T,thread);
 479         return 1;
 480     }
 481     /* a slightly confusing test.  arch_pseudo_atomic_atomic() doesn't
 482      * actually use its argument for anything on x86, so this branch
 483      * may succeed even when context is null (gencgc alloc()) */
 484     if (
 485 #ifndef LISP_FEATURE_X86
 486         (!foreign_function_call_active) &&
 487 #endif
 488         arch_pseudo_atomic_atomic(context)) {
 489         store_signal_data_for_later(data,handler,signal,info,context);
 490         arch_set_pseudo_atomic_interrupted(context);
 491         return 1;
 492     }
 493     return 0;
 494 }
 495 static void
 496 store_signal_data_for_later (struct interrupt_data *data, void *handler,
 497                              int signal,
 498                              siginfo_t *info, os_context_t *context)
 499 {
 500     data->pending_handler = handler;
 501     data->pending_signal = signal;
 502     if(info)
 503         memcpy(&(data->pending_info), info, sizeof(siginfo_t));
 504     if(context) {
 505         /* the signal mask in the context (from before we were
 506          * interrupted) is copied to be restored when
 507          * run_deferred_handler happens.  Then the usually-blocked
 508          * signals are added to the mask in the context so that we are
 509          * running with blocked signals when the handler returns */
 510         sigemptyset(&(data->pending_mask));
 511         memcpy(&(data->pending_mask),
 512                os_context_sigmask_addr(context),
 513                REAL_SIGSET_SIZE_BYTES);
 514         sigaddset_blockable(os_context_sigmask_addr(context));
 515     } else {
 516         /* this is also called from gencgc alloc(), in which case
 517          * there has been no signal and is therefore no context. */
 518         sigset_t new;
 519         sigemptyset(&new);
 520         sigaddset_blockable(&new);
 521         sigprocmask(SIG_BLOCK,&new,&(data->pending_mask));
 522     }
 523 }
 524
 525
 526 static void
 527 maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 528 {
 529     os_context_t *context = arch_os_get_context(&void_context);
 530     struct thread *thread=arch_os_get_current_thread();
 531     struct interrupt_data *data=thread->interrupt_data;
 532 #ifdef LISP_FEATURE_LINUX
 533     os_restore_fp_control(context);
 534 #endif
 535     if(maybe_defer_handler(interrupt_handle_now,data,
 536                            signal,info,context))
 537         return;
 538     interrupt_handle_now(signal, info, context);
 539 #ifdef LISP_FEATURE_DARWIN
 540     /* Work around G5 bug */
 541     sigreturn(void_context);
 542 #endif
 543 }
 544
 545 #ifdef LISP_FEATURE_SB_THREAD
 546 void
 547 sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
 548 {
 549     os_context_t *context = arch_os_get_context(&void_context);
 550     struct thread *thread=arch_os_get_current_thread();
 551     struct interrupt_data *data=thread->interrupt_data;
 552     sigset_t ss;
 553     int i;
 554
 555     /* KLUDGE: at least on Linux, the kernel apparently schedules a
 556        thread immediately it is signalled.  However, we signal
 557        SIG_STOP_FOR_GC while holding the spinlock, and consequently we
 558        can easily end up with a kind of thundering herd of threads all
 559        wanting to acquire the lock at the same time so that they can
 560        tell the system that they've gone to sleep.  So we yield here.
 561        Whether this is the right fix or not is unknown.  -- CSR,
 562        2004-07-16 */
 563     sched_yield();
 564
 565     if(maybe_defer_handler(sig_stop_for_gc_handler,data,
 566                            signal,info,context)) {
 567         return;
 568     }
 569     /* need the context stored so it can have registers scavenged */
 570     fake_foreign_function_call(context);
 571
 572     sigemptyset(&ss);
 573     for(i=1;i<NSIG;i++) sigaddset(&ss,i); /* Block everything. */
 574     sigprocmask(SIG_BLOCK,&ss,0);
 575
 576     get_spinlock(&all_threads_lock,thread->pid);
 577     thread->state=STATE_STOPPED;
 578     release_spinlock(&all_threads_lock);
 579
 580     sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC);
 581     sigwaitinfo(&ss,0);
 582
 583     undo_fake_foreign_function_call(context);
 584 }
 585 #endif
 586
 587 void
 588 interrupt_handle_now_handler(int signal, siginfo_t *info, void *void_context)
 589 {
 590     os_context_t *context = arch_os_get_context(&void_context);
 591     interrupt_handle_now(signal, info, context);
 592 #ifdef LISP_FEATURE_DARWIN
 593     sigreturn(void_context);
 594 #endif
 595 }
 596
 597 /*
 598  * stuff to detect and handle hitting the GC trigger
 599  */
 600
 601 #ifndef LISP_FEATURE_GENCGC
 602 /* since GENCGC has its own way to record trigger */
 603 static boolean
 604 gc_trigger_hit(int signal, siginfo_t *info, os_context_t *context)
 605 {
 606     if (current_auto_gc_trigger == NULL)
 607         return 0;
 608     else{
 609         void *badaddr=arch_get_bad_addr(signal,info,context);
 610         return (badaddr >= (void *)current_auto_gc_trigger &&
 611                 badaddr <((void *)current_dynamic_space + DYNAMIC_SPACE_SIZE));
 612     }
 613 }
 614 #endif
 615
 616 /* manipulate the signal context and stack such that when the handler
 617  * returns, it will call function instead of whatever it was doing
 618  * previously
 619  */
 620
 621 extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
 622 extern void post_signal_tramp(void);
 623 void arrange_return_to_lisp_function(os_context_t *context, lispobj function)
 624 {
 625 #ifndef LISP_FEATURE_X86
 626     void * fun=native_pointer(function);
 627     void *code = &(((struct simple_fun *) fun)->code);
 628 #endif
 629
 630     /* Build a stack frame showing `interrupted' so that the
 631      * user's backtrace makes (as much) sense (as usual) */
 632 #ifdef LISP_FEATURE_X86
 633     /* Suppose the existence of some function that saved all
 634      * registers, called call_into_lisp, then restored GP registers and
 635      * returned.  We shortcut this: fake the stack that call_into_lisp
 636      * would see, then arrange to have it called directly.  post_signal_tramp
 637      * is the second half of this function
 638      */
 639     u32 *sp=(u32 *)*os_context_register_addr(context,reg_ESP);
 640
 641     *(sp-14) = post_signal_tramp; /* return address for call_into_lisp */
 642     *(sp-13) = function;        /* args for call_into_lisp : function*/
 643     *(sp-12) = 0;               /*                           arg array */
 644     *(sp-11) = 0;               /*                           no. args */
 645     /* this order matches that used in POPAD */
 646     *(sp-10)=*os_context_register_addr(context,reg_EDI);
 647     *(sp-9)=*os_context_register_addr(context,reg_ESI);
 648     /* this gets overwritten again before it's used, anyway */
 649     *(sp-8)=*os_context_register_addr(context,reg_EBP);
 650     *(sp-7)=0 ; /* POPAD doesn't set ESP, but expects a gap for it anyway */
 651     *(sp-6)=*os_context_register_addr(context,reg_EBX);
 652
 653     *(sp-5)=*os_context_register_addr(context,reg_EDX);
 654     *(sp-4)=*os_context_register_addr(context,reg_ECX);
 655     *(sp-3)=*os_context_register_addr(context,reg_EAX);
 656     *(sp-2)=*os_context_register_addr(context,reg_EBP);
 657     *(sp-1)=*os_context_pc_addr(context);
 658
 659 #else
 660     struct thread *th=arch_os_get_current_thread();
 661     build_fake_control_stack_frames(th,context);
 662 #endif
 663
 664 #ifdef LISP_FEATURE_X86
 665     *os_context_pc_addr(context) = call_into_lisp;
 666     *os_context_register_addr(context,reg_ECX) = 0;
 667     *os_context_register_addr(context,reg_EBP) = sp-2;
 668     *os_context_register_addr(context,reg_ESP) = sp-14;
 669 #else
 670     /* this much of the calling convention is common to all
 671        non-x86 ports */
 672     *os_context_pc_addr(context) = code;
 673     *os_context_register_addr(context,reg_NARGS) = 0;
 674     *os_context_register_addr(context,reg_LIP) = code;
 675     *os_context_register_addr(context,reg_CFP) =
 676         current_control_frame_pointer;
 677 #endif
 678 #ifdef ARCH_HAS_NPC_REGISTER
 679     *os_context_npc_addr(context) =
 680         4 + *os_context_pc_addr(context);
 681 #endif
 682 #ifdef LISP_FEATURE_SPARC
 683     *os_context_register_addr(context,reg_CODE) =
 684         fun + FUN_POINTER_LOWTAG;
 685 #endif
 686 }
 687
 688 #ifdef LISP_FEATURE_SB_THREAD
 689 void interrupt_thread_handler(int num, siginfo_t *info, void *v_context)
 690 {
 691     os_context_t *context = (os_context_t*)arch_os_get_context(&v_context);
 692     struct thread *th=arch_os_get_current_thread();
 693     struct interrupt_data *data=
 694         th ? th->interrupt_data : global_interrupt_data;
 695     if(maybe_defer_handler(interrupt_thread_handler,data,num,info,context)){
 696         return ;
 697     }
 698     arrange_return_to_lisp_function(context,info->si_value.sival_int);
 699 }
 700
 701 void thread_exit_handler(int num, siginfo_t *info, void *v_context)
 702 {   /* called when a child thread exits */
 703     os_context_t *context = (os_context_t*)arch_os_get_context(&v_context);
 704     struct thread *th=arch_os_get_current_thread();
 705     pid_t kid;
 706     int *status;
 707     struct interrupt_data *data=
 708         th ? th->interrupt_data : global_interrupt_data;
 709     if(maybe_defer_handler(thread_exit_handler,data,num,info,context)){
 710         return ;
 711     }
 712     while(1) {
 713         kid=waitpid(-1,&status,__WALL|WNOHANG);
 714         if(kid<1) break;
 715         if(WIFEXITED(status) || WIFSIGNALED(status)) {
 716             struct thread *th=find_thread_by_pid(kid);
 717             if(!th) continue;
 718             funcall1(SymbolFunction(HANDLE_THREAD_EXIT),make_fixnum(kid));
 719             destroy_thread(th);
 720         }
 721     }
 722 }
 723 #endif
 724
 725 boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr){
 726     struct thread *th=arch_os_get_current_thread();
 727     /* note the os_context hackery here.  When the signal handler returns,
 728      * it won't go back to what it was doing ... */
 729     if(addr>=(void *)CONTROL_STACK_GUARD_PAGE(th) &&
 730        addr<(void *)(CONTROL_STACK_GUARD_PAGE(th)+os_vm_page_size)) {
 731         /* we hit the end of the control stack.  disable protection
 732          * temporarily so the error handler has some headroom */
 733         protect_control_stack_guard_page(th->pid,0L);
 734
 735         arrange_return_to_lisp_function
 736             (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
 737         return 1;
 738     }
 739     else return 0;
 740 }
 741
 742 #ifndef LISP_FEATURE_GENCGC
 743 /* This function gets called from the SIGSEGV (for e.g. Linux, NetBSD, &
 744  * OpenBSD) or SIGBUS (for e.g. FreeBSD) handler. Here we check
 745  * whether the signal was due to treading on the mprotect()ed zone -
 746  * and if so, arrange for a GC to happen. */
 747 extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
 748
 749 boolean
 750 interrupt_maybe_gc(int signal, siginfo_t *info, void *void_context)
 751 {
 752     os_context_t *context=(os_context_t *) void_context;
 753     struct thread *th=arch_os_get_current_thread();
 754     struct interrupt_data *data=
 755         th ? th->interrupt_data : global_interrupt_data;
 756
 757     if(!foreign_function_call_active && gc_trigger_hit(signal, info, context)){
 758         clear_auto_gc_trigger();
 759         if(!maybe_defer_handler
 760            (interrupt_maybe_gc_int,data,signal,info,void_context))
 761             interrupt_maybe_gc_int(signal,info,void_context);
 762         return 1;
 763     }
 764     return 0;
 765 }
 766
 767 #endif
 768
 769 /* this is also used by gencgc, in alloc() */
 770 boolean
 771 interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context)
 772 {
 773     sigset_t new;
 774     os_context_t *context=(os_context_t *) void_context;
 775     fake_foreign_function_call(context);
 776     /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
 777      * which case we will be running with no gc trigger barrier
 778      * thing for a while.  But it shouldn't be long until the end
 779      * of WITHOUT-GCING. */
 780
 781     sigemptyset(&new);
 782     sigaddset_blockable(&new);
 783     /* enable signals before calling into Lisp */
 784     sigprocmask(SIG_UNBLOCK,&new,0);
 785     funcall0(SymbolFunction(SUB_GC));
 786     undo_fake_foreign_function_call(context);
 787     return 1;
 788 }
 789
 790 \f
 791 /*
 792  * noise to install handlers
 793  */
 794
 795 void
 796 undoably_install_low_level_interrupt_handler (int signal,
 797                                               void handler(int,
 798                                                            siginfo_t*,
 799                                                            void*))
 800 {
 801     struct sigaction sa;
 802     struct thread *th=arch_os_get_current_thread();
 803     struct interrupt_data *data=
 804         th ? th->interrupt_data : global_interrupt_data;
 805
 806     if (0 > signal || signal >= NSIG) {
 807         lose("bad signal number %d", signal);
 808     }
 809
 810     sa.sa_sigaction = handler;
 811     sigemptyset(&sa.sa_mask);
 812     sigaddset_blockable(&sa.sa_mask);
 813     sa.sa_flags = SA_SIGINFO | SA_RESTART;
 814 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
 815     if((signal==SIG_MEMORY_FAULT)
 816 #ifdef SIG_INTERRUPT_THREAD
 817        || (signal==SIG_INTERRUPT_THREAD)
 818 #endif
 819        )
 820         sa.sa_flags|= SA_ONSTACK;
 821 #endif
 822
 823     sigaction(signal, &sa, NULL);
 824     data->interrupt_low_level_handlers[signal] =
 825         (ARE_SAME_HANDLER(handler, SIG_DFL) ? 0 : handler);
 826 }
 827
 828 /* This is called from Lisp. */
 829 unsigned long
 830 install_handler(int signal, void handler(int, siginfo_t*, void*))
 831 {
 832     struct sigaction sa;
 833     sigset_t old, new;
 834     union interrupt_handler oldhandler;
 835     struct thread *th=arch_os_get_current_thread();
 836     struct interrupt_data *data=
 837         th ? th->interrupt_data : global_interrupt_data;
 838
 839     FSHOW((stderr, "/entering POSIX install_handler(%d, ..)\n", signal));
 840
 841     sigemptyset(&new);
 842     sigaddset(&new, signal);
 843     sigprocmask(SIG_BLOCK, &new, &old);
 844
 845     sigemptyset(&new);
 846     sigaddset_blockable(&new);
 847
 848     FSHOW((stderr, "/data->interrupt_low_level_handlers[signal]=%d\n",
 849            data->interrupt_low_level_handlers[signal]));
 850     if (data->interrupt_low_level_handlers[signal]==0) {
 851         if (ARE_SAME_HANDLER(handler, SIG_DFL) ||
 852             ARE_SAME_HANDLER(handler, SIG_IGN)) {
 853             sa.sa_sigaction = handler;
 854         } else if (sigismember(&new, signal)) {
 855             sa.sa_sigaction = maybe_now_maybe_later;
 856         } else {
 857             sa.sa_sigaction = interrupt_handle_now_handler;
 858         }
 859
 860         sigemptyset(&sa.sa_mask);
 861         sigaddset_blockable(&sa.sa_mask);
 862         sa.sa_flags = SA_SIGINFO | SA_RESTART;
 863         sigaction(signal, &sa, NULL);
 864     }
 865
 866     oldhandler = data->interrupt_handlers[signal];
 867     data->interrupt_handlers[signal].c = handler;
 868
 869     sigprocmask(SIG_SETMASK, &old, 0);
 870
 871     FSHOW((stderr, "/leaving POSIX install_handler(%d, ..)\n", signal));
 872
 873     return (unsigned long)oldhandler.lisp;
 874 }
 875
 876 void
 877 interrupt_init()
 878 {
 879     int i;
 880     SHOW("entering interrupt_init()");
 881     global_interrupt_data=calloc(sizeof(struct interrupt_data), 1);
 882
 883     /* Set up high level handler information. */
 884     for (i = 0; i < NSIG; i++) {
 885         global_interrupt_data->interrupt_handlers[i].c =
 886             /* (The cast here blasts away the distinction between
 887              * SA_SIGACTION-style three-argument handlers and
 888              * signal(..)-style one-argument handlers, which is OK
 889              * because it works to call the 1-argument form where the
 890              * 3-argument form is expected.) */
 891             (void (*)(int, siginfo_t*, void*))SIG_DFL;
 892     }
 893
 894     SHOW("returning from interrupt_init()");
 895 }