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 #include "sbcl.h"
  44
  45 #include <stdio.h>
  46 #include <stdlib.h>
  47 #include <string.h>
  48 #include <signal.h>
  49 #include <sys/types.h>
  50 #ifndef LISP_FEATURE_WIN32
  51 #include <sys/wait.h>
  52 #endif
  53 #include <errno.h>
  54
  55 #include "runtime.h"
  56 #include "arch.h"
  57 #include "os.h"
  58 #include "interrupt.h"
  59 #include "globals.h"
  60 #include "lispregs.h"
  61 #include "validate.h"
  62 #include "gc.h"
  63 #include "alloc.h"
  64 #include "dynbind.h"
  65 #include "interr.h"
  66 #include "genesis/fdefn.h"
  67 #include "genesis/simple-fun.h"
  68 #include "genesis/cons.h"
  69
  70 static void run_deferred_handler(struct interrupt_data *data, void *v_context);
  71 #ifndef LISP_FEATURE_WIN32
  72 static void store_signal_data_for_later (struct interrupt_data *data,
  73                                          void *handler, int signal,
  74                                          siginfo_t *info,
  75                                          os_context_t *context);
  76
  77 void
  78 sigaddset_deferrable(sigset_t *s)
  79 {
  80     sigaddset(s, SIGHUP);
  81     sigaddset(s, SIGINT);
  82     sigaddset(s, SIGTERM);
  83     sigaddset(s, SIGQUIT);
  84     sigaddset(s, SIGPIPE);
  85     sigaddset(s, SIGALRM);
  86     sigaddset(s, SIGURG);
  87     sigaddset(s, SIGTSTP);
  88     sigaddset(s, SIGCHLD);
  89     sigaddset(s, SIGIO);
  90 #ifndef LISP_FEATURE_HPUX
  91     sigaddset(s, SIGXCPU);
  92     sigaddset(s, SIGXFSZ);
  93 #endif
  94     sigaddset(s, SIGVTALRM);
  95     sigaddset(s, SIGPROF);
  96     sigaddset(s, SIGWINCH);
  97
  98 #if !((defined(LISP_FEATURE_DARWIN) || defined(LISP_FEATURE_FREEBSD)) && defined(LISP_FEATURE_SB_THREAD))
  99     sigaddset(s, SIGUSR1);
 100     sigaddset(s, SIGUSR2);
 101 #endif
 102
 103 #ifdef LISP_FEATURE_SB_THREAD
 104     sigaddset(s, SIG_INTERRUPT_THREAD);
 105 #endif
 106 }
 107
 108 void
 109 sigaddset_blockable(sigset_t *s)
 110 {
 111     sigaddset_deferrable(s);
 112 #ifdef LISP_FEATURE_SB_THREAD
 113 #ifdef SIG_RESUME_FROM_GC
 114     sigaddset(s, SIG_RESUME_FROM_GC);
 115 #endif
 116     sigaddset(s, SIG_STOP_FOR_GC);
 117 #endif
 118 }
 119
 120 /* initialized in interrupt_init */
 121 sigset_t deferrable_sigset;
 122 sigset_t blockable_sigset;
 123 #endif
 124
 125 void
 126 check_blockables_blocked_or_lose(void)
 127 {
 128 #if !defined(LISP_FEATURE_WIN32)
 129     /* Get the current sigmask, by blocking the empty set. */
 130     sigset_t empty,current;
 131     int i;
 132     sigemptyset(&empty);
 133     thread_sigmask(SIG_BLOCK, &empty, &current);
 134     for(i = 1; i < NSIG; i++) {
 135         if (sigismember(&blockable_sigset, i) && !sigismember(&current, i))
 136             lose("blockable signal %d not blocked\n",i);
 137     }
 138 #endif
 139 }
 140
 141 void
 142 unblock_gc_signals(void)
 143 {
 144 #ifdef LISP_FEATURE_SB_THREAD
 145     sigset_t new;
 146     sigemptyset(&new);
 147 #if defined(SIG_RESUME_FROM_GC)
 148     sigaddset(&new,SIG_RESUME_FROM_GC);
 149 #endif
 150     sigaddset(&new,SIG_STOP_FOR_GC);
 151     thread_sigmask(SIG_UNBLOCK,&new,0);
 152 #endif
 153 }
 154
 155 inline static void
 156 check_interrupts_enabled_or_lose(os_context_t *context)
 157 {
 158     struct thread *thread=arch_os_get_current_thread();
 159     if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL)
 160         lose("interrupts not enabled\n");
 161     if (arch_pseudo_atomic_atomic(context))
 162         lose ("in pseudo atomic section\n");
 163 }
 164
 165 /* When we catch an internal error, should we pass it back to Lisp to
 166  * be handled in a high-level way? (Early in cold init, the answer is
 167  * 'no', because Lisp is still too brain-dead to handle anything.
 168  * After sufficient initialization has been completed, the answer
 169  * becomes 'yes'.) */
 170 boolean internal_errors_enabled = 0;
 171
 172 #ifndef LISP_FEATURE_WIN32
 173 static void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, void*);
 174 #endif
 175 union interrupt_handler interrupt_handlers[NSIG];
 176
 177 /* At the toplevel repl we routinely call this function.  The signal
 178  * mask ought to be clear anyway most of the time, but may be non-zero
 179  * if we were interrupted e.g. while waiting for a queue.  */
 180
 181 void
 182 reset_signal_mask(void)
 183 {
 184 #ifndef LISP_FEATURE_WIN32
 185     sigset_t new;
 186     sigemptyset(&new);
 187     thread_sigmask(SIG_SETMASK,&new,0);
 188 #endif
 189 }
 190
 191 void
 192 block_blockable_signals(void)
 193 {
 194 #ifndef LISP_FEATURE_WIN32
 195     thread_sigmask(SIG_BLOCK, &blockable_sigset, 0);
 196 #endif
 197 }
 198
 199 void
 200 block_deferrable_signals(void)
 201 {
 202 #ifndef LISP_FEATURE_WIN32
 203     thread_sigmask(SIG_BLOCK, &deferrable_sigset, 0);
 204 #endif
 205 }
 206
 207 \f
 208 /*
 209  * utility routines used by various signal handlers
 210  */
 211
 212 static void
 213 build_fake_control_stack_frames(struct thread *th,os_context_t *context)
 214 {
 215 #ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
 216
 217     lispobj oldcont;
 218
 219     /* Build a fake stack frame or frames */
 220
 221     current_control_frame_pointer =
 222         (lispobj *)(unsigned long)
 223             (*os_context_register_addr(context, reg_CSP));
 224     if ((lispobj *)(unsigned long)
 225             (*os_context_register_addr(context, reg_CFP))
 226         == current_control_frame_pointer) {
 227         /* There is a small window during call where the callee's
 228          * frame isn't built yet. */
 229         if (lowtag_of(*os_context_register_addr(context, reg_CODE))
 230             == FUN_POINTER_LOWTAG) {
 231             /* We have called, but not built the new frame, so
 232              * build it for them. */
 233             current_control_frame_pointer[0] =
 234                 *os_context_register_addr(context, reg_OCFP);
 235             current_control_frame_pointer[1] =
 236                 *os_context_register_addr(context, reg_LRA);
 237             current_control_frame_pointer += 8;
 238             /* Build our frame on top of it. */
 239             oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
 240         }
 241         else {
 242             /* We haven't yet called, build our frame as if the
 243              * partial frame wasn't there. */
 244             oldcont = (lispobj)(*os_context_register_addr(context, reg_OCFP));
 245         }
 246     }
 247     /* We can't tell whether we are still in the caller if it had to
 248      * allocate a stack frame due to stack arguments. */
 249     /* This observation provoked some past CMUCL maintainer to ask
 250      * "Can anything strange happen during return?" */
 251     else {
 252         /* normal case */
 253         oldcont = (lispobj)(*os_context_register_addr(context, reg_CFP));
 254     }
 255
 256     current_control_stack_pointer = current_control_frame_pointer + 8;
 257
 258     current_control_frame_pointer[0] = oldcont;
 259     current_control_frame_pointer[1] = NIL;
 260     current_control_frame_pointer[2] =
 261         (lispobj)(*os_context_register_addr(context, reg_CODE));
 262 #endif
 263 }
 264
 265 /* Stores the context for gc to scavange and builds fake stack
 266  * frames. */
 267 void
 268 fake_foreign_function_call(os_context_t *context)
 269 {
 270     int context_index;
 271     struct thread *thread=arch_os_get_current_thread();
 272
 273     /* context_index incrementing must not be interrupted */
 274     check_blockables_blocked_or_lose();
 275
 276     /* Get current Lisp state from context. */
 277 #ifdef reg_ALLOC
 278     dynamic_space_free_pointer =
 279         (lispobj *)(unsigned long)
 280             (*os_context_register_addr(context, reg_ALLOC));
 281 /*     fprintf(stderr,"dynamic_space_free_pointer: %p\n", */
 282 /*             dynamic_space_free_pointer); */
 283 #if defined(LISP_FEATURE_ALPHA) || defined(LISP_FEATURE_MIPS)
 284     if ((long)dynamic_space_free_pointer & 1) {
 285         lose("dead in fake_foreign_function_call, context = %x\n", context);
 286     }
 287 #endif
 288 /* why doesnt PPC and SPARC do something like this: */
 289 #if defined(LISP_FEATURE_HPPA)
 290     if ((long)dynamic_space_free_pointer & 4) {
 291         lose("dead in fake_foreign_function_call, context = %x, d_s_f_p = %x\n", context, dynamic_space_free_pointer);
 292     }
 293 #endif
 294 #endif
 295 #ifdef reg_BSP
 296     current_binding_stack_pointer =
 297         (lispobj *)(unsigned long)
 298             (*os_context_register_addr(context, reg_BSP));
 299 #endif
 300
 301     build_fake_control_stack_frames(thread,context);
 302
 303     /* Do dynamic binding of the active interrupt context index
 304      * and save the context in the context array. */
 305     context_index =
 306         fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));
 307
 308     if (context_index >= MAX_INTERRUPTS) {
 309         lose("maximum interrupt nesting depth (%d) exceeded\n", MAX_INTERRUPTS);
 310     }
 311
 312     bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,
 313                   make_fixnum(context_index + 1),thread);
 314
 315     thread->interrupt_contexts[context_index] = context;
 316
 317 #ifdef FOREIGN_FUNCTION_CALL_FLAG
 318     foreign_function_call_active = 1;
 319 #endif
 320 }
 321
 322 /* blocks all blockable signals.  If you are calling from a signal handler,
 323  * the usual signal mask will be restored from the context when the handler
 324  * finishes.  Otherwise, be careful */
 325 void
 326 undo_fake_foreign_function_call(os_context_t *context)
 327 {
 328     struct thread *thread=arch_os_get_current_thread();
 329     /* Block all blockable signals. */
 330     block_blockable_signals();
 331
 332 #ifdef FOREIGN_FUNCTION_CALL_FLAG
 333     foreign_function_call_active = 0;
 334 #endif
 335
 336     /* Undo dynamic binding of FREE_INTERRUPT_CONTEXT_INDEX */
 337     unbind(thread);
 338
 339 #ifdef reg_ALLOC
 340     /* Put the dynamic space free pointer back into the context. */
 341     *os_context_register_addr(context, reg_ALLOC) =
 342         (unsigned long) dynamic_space_free_pointer
 343         | (*os_context_register_addr(context, reg_ALLOC)
 344            & LOWTAG_MASK);
 345     /*
 346       ((unsigned long)(*os_context_register_addr(context, reg_ALLOC))
 347       & ~LOWTAG_MASK)
 348       | ((unsigned long) dynamic_space_free_pointer & LOWTAG_MASK);
 349     */
 350 #endif
 351 }
 352
 353 /* a handler for the signal caused by execution of a trap opcode
 354  * signalling an internal error */
 355 void
 356 interrupt_internal_error(os_context_t *context, boolean continuable)
 357 {
 358     lispobj context_sap;
 359
 360     fake_foreign_function_call(context);
 361
 362     if (!internal_errors_enabled) {
 363         describe_internal_error(context);
 364         /* There's no good way to recover from an internal error
 365          * before the Lisp error handling mechanism is set up. */
 366         lose("internal error too early in init, can't recover\n");
 367     }
 368
 369     /* Allocate the SAP object while the interrupts are still
 370      * disabled. */
 371     context_sap = alloc_sap(context);
 372
 373 #ifndef LISP_FEATURE_WIN32
 374     thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 375 #endif
 376
 377     SHOW("in interrupt_internal_error");
 378 #ifdef QSHOW
 379     /* Display some rudimentary debugging information about the
 380      * error, so that even if the Lisp error handler gets badly
 381      * confused, we have a chance to determine what's going on. */
 382     describe_internal_error(context);
 383 #endif
 384     funcall2(StaticSymbolFunction(INTERNAL_ERROR), context_sap,
 385              continuable ? T : NIL);
 386
 387     undo_fake_foreign_function_call(context); /* blocks signals again */
 388     if (continuable)
 389         arch_skip_instruction(context);
 390 }
 391
 392 void
 393 interrupt_handle_pending(os_context_t *context)
 394 {
 395     /* There are three ways we can get here. First, if an interrupt
 396      * occurs within pseudo-atomic, it will be deferred, and we'll
 397      * trap to here at the end of the pseudo-atomic block. Second, if
 398      * the GC (in alloc()) decides that a GC is required, it will set
 399      * *GC-PENDING* and pseudo-atomic-interrupted if not *GC-INHIBIT*,
 400      * and alloc() is always called from within pseudo-atomic, and
 401      * thus we end up here again. Third, when calling GC-ON or at the
 402      * end of a WITHOUT-GCING, MAYBE-HANDLE-PENDING-GC will trap to
 403      * here if there is a pending GC. Fourth, ahem, at the end of
 404      * WITHOUT-INTERRUPTS (bar complications with nesting). */
 405
 406     /* Win32 only needs to handle the GC cases (for now?) */
 407
 408     struct thread *thread;
 409
 410     /* Punt if in PA section, marking it as interrupted. This can
 411      * happenat least if we pick up a GC request while in a
 412      * WITHOUT-GCING with an outer PA -- it is not immediately clear
 413      * to me that this should/could ever happen, but better safe then
 414      * sorry. --NS 2007-05-15 */
 415     if (arch_pseudo_atomic_atomic(context)) {
 416         arch_set_pseudo_atomic_interrupted(context);
 417         return;
 418     }
 419
 420     thread = arch_os_get_current_thread();
 421
 422     FSHOW_SIGNAL((stderr, "/entering interrupt_handle_pending\n"));
 423
 424     check_blockables_blocked_or_lose();
 425
 426     /* If pseudo_atomic_interrupted is set then the interrupt is going
 427      * to be handled now, ergo it's safe to clear it. */
 428     arch_clear_pseudo_atomic_interrupted(context);
 429
 430     if (SymbolValue(GC_INHIBIT,thread)==NIL) {
 431 #ifdef LISP_FEATURE_SB_THREAD
 432         if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) {
 433             /* STOP_FOR_GC_PENDING and GC_PENDING are cleared by
 434              * the signal handler if it actually stops us. */
 435             sig_stop_for_gc_handler(SIG_STOP_FOR_GC,NULL,context);
 436         } else
 437 #endif
 438         if (SymbolValue(GC_PENDING,thread) != NIL) {
 439             /* GC_PENDING is cleared in SUB-GC, or if another thread
 440              * is doing a gc already we will get a SIG_STOP_FOR_GC and
 441              * that will clear it. */
 442             maybe_gc(context);
 443         }
 444         check_blockables_blocked_or_lose();
 445     }
 446
 447 #ifndef LISP_FEATURE_WIN32
 448     /* we may be here only to do the gc stuff, if interrupts are
 449      * enabled run the pending handler */
 450     if (SymbolValue(INTERRUPTS_ENABLED,thread) != NIL) {
 451         struct interrupt_data *data = thread->interrupt_data;
 452
 453         /* There may be no pending handler, because it was only a gc
 454          * that had to be executed or because pseudo atomic triggered
 455          * twice for a single interrupt. For the interested reader,
 456          * that may happen if an interrupt hits after the interrupted
 457          * flag is cleared but before pseudo-atomic is set and a
 458          * pseudo atomic is interrupted in that interrupt. */
 459         if (data->pending_handler) {
 460
 461             /* If we're here as the result of a pseudo-atomic as opposed
 462              * to WITHOUT-INTERRUPTS, then INTERRUPT_PENDING is already
 463              * NIL, because maybe_defer_handler sets
 464              * PSEUDO_ATOMIC_INTERRUPTED only if interrupts are enabled.*/
 465             SetSymbolValue(INTERRUPT_PENDING, NIL, thread);
 466
 467             /* restore the saved signal mask from the original signal (the
 468              * one that interrupted us during the critical section) into the
 469              * os_context for the signal we're currently in the handler for.
 470              * This should ensure that when we return from the handler the
 471              * blocked signals are unblocked */
 472             sigcopyset(os_context_sigmask_addr(context), &data->pending_mask);
 473
 474             sigemptyset(&data->pending_mask);
 475             /* This will break on sparc linux: the deferred handler really wants
 476              * to be called with a void_context */
 477             run_deferred_handler(data,(void *)context);
 478         }
 479     }
 480 #endif
 481 }
 482 \f
 483 /*
 484  * the two main signal handlers:
 485  *   interrupt_handle_now(..)
 486  *   maybe_now_maybe_later(..)
 487  *
 488  * to which we have added interrupt_handle_now_handler(..).  Why?
 489  * Well, mostly because the SPARC/Linux platform doesn't quite do
 490  * signals the way we want them done.  The third argument in the
 491  * handler isn't filled in by the kernel properly, so we fix it up
 492  * ourselves in the arch_os_get_context(..) function; however, we only
 493  * want to do this when we first hit the handler, and not when
 494  * interrupt_handle_now(..) is being called from some other handler
 495  * (when the fixup will already have been done). -- CSR, 2002-07-23
 496  */
 497
 498 void
 499 interrupt_handle_now(int signal, siginfo_t *info, os_context_t *context)
 500 {
 501 #ifdef FOREIGN_FUNCTION_CALL_FLAG
 502     boolean were_in_lisp;
 503 #endif
 504     union interrupt_handler handler;
 505
 506     check_blockables_blocked_or_lose();
 507
 508 #ifndef LISP_FEATURE_WIN32
 509     if (sigismember(&deferrable_sigset,signal))
 510         check_interrupts_enabled_or_lose(context);
 511 #endif
 512
 513 #if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT)
 514     /* Under Linux on some architectures, we appear to have to restore
 515        the FPU control word from the context, as after the signal is
 516        delivered we appear to have a null FPU control word. */
 517     os_restore_fp_control(context);
 518 #endif
 519
 520     handler = interrupt_handlers[signal];
 521
 522     if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) {
 523         return;
 524     }
 525
 526 #ifdef FOREIGN_FUNCTION_CALL_FLAG
 527     were_in_lisp = !foreign_function_call_active;
 528     if (were_in_lisp)
 529 #endif
 530     {
 531         fake_foreign_function_call(context);
 532     }
 533
 534     FSHOW_SIGNAL((stderr,
 535                   "/entering interrupt_handle_now(%d, info, context)\n",
 536                   signal));
 537
 538     if (ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
 539
 540         /* This can happen if someone tries to ignore or default one
 541          * of the signals we need for runtime support, and the runtime
 542          * support decides to pass on it. */
 543         lose("no handler for signal %d in interrupt_handle_now(..)\n", signal);
 544
 545     } else if (lowtag_of(handler.lisp) == FUN_POINTER_LOWTAG) {
 546         /* Once we've decided what to do about contexts in a
 547          * return-elsewhere world (the original context will no longer
 548          * be available; should we copy it or was nobody using it anyway?)
 549          * then we should convert this to return-elsewhere */
 550
 551         /* CMUCL comment said "Allocate the SAPs while the interrupts
 552          * are still disabled.".  I (dan, 2003.08.21) assume this is
 553          * because we're not in pseudoatomic and allocation shouldn't
 554          * be interrupted.  In which case it's no longer an issue as
 555          * all our allocation from C now goes through a PA wrapper,
 556          * but still, doesn't hurt.
 557          *
 558          * Yeah, but non-gencgc platforms don't really wrap allocation
 559          * in PA. MG - 2005-08-29  */
 560
 561         lispobj info_sap,context_sap = alloc_sap(context);
 562         info_sap = alloc_sap(info);
 563         /* Leave deferrable signals blocked, the handler itself will
 564          * allow signals again when it sees fit. */
 565 #ifdef LISP_FEATURE_SB_THREAD
 566         {
 567             sigset_t unblock;
 568             sigemptyset(&unblock);
 569             sigaddset(&unblock, SIG_STOP_FOR_GC);
 570 #ifdef SIG_RESUME_FROM_GC
 571             sigaddset(&unblock, SIG_RESUME_FROM_GC);
 572 #endif
 573             thread_sigmask(SIG_UNBLOCK, &unblock, 0);
 574         }
 575 #endif
 576
 577         FSHOW_SIGNAL((stderr,"/calling Lisp-level handler\n"));
 578
 579         funcall3(handler.lisp,
 580                  make_fixnum(signal),
 581                  info_sap,
 582                  context_sap);
 583     } else {
 584
 585         FSHOW_SIGNAL((stderr,"/calling C-level handler\n"));
 586
 587 #ifndef LISP_FEATURE_WIN32
 588         /* Allow signals again. */
 589         thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 590 #endif
 591         (*handler.c)(signal, info, context);
 592     }
 593
 594 #ifdef FOREIGN_FUNCTION_CALL_FLAG
 595     if (were_in_lisp)
 596 #endif
 597     {
 598         undo_fake_foreign_function_call(context); /* block signals again */
 599     }
 600
 601     FSHOW_SIGNAL((stderr,
 602                   "/returning from interrupt_handle_now(%d, info, context)\n",
 603                   signal));
 604 }
 605
 606 /* This is called at the end of a critical section if the indications
 607  * are that some signal was deferred during the section.  Note that as
 608  * far as C or the kernel is concerned we dealt with the signal
 609  * already; we're just doing the Lisp-level processing now that we
 610  * put off then */
 611 static void
 612 run_deferred_handler(struct interrupt_data *data, void *v_context)
 613 {
 614     /* The pending_handler may enable interrupts and then another
 615      * interrupt may hit, overwrite interrupt_data, so reset the
 616      * pending handler before calling it. Trust the handler to finish
 617      * with the siginfo before enabling interrupts. */
 618     void (*pending_handler) (int, siginfo_t*, void*)=data->pending_handler;
 619
 620     data->pending_handler=0;
 621     (*pending_handler)(data->pending_signal,&(data->pending_info), v_context);
 622 }
 623
 624 #ifndef LISP_FEATURE_WIN32
 625 boolean
 626 maybe_defer_handler(void *handler, struct interrupt_data *data,
 627                     int signal, siginfo_t *info, os_context_t *context)
 628 {
 629     struct thread *thread=arch_os_get_current_thread();
 630
 631     check_blockables_blocked_or_lose();
 632
 633     if (SymbolValue(INTERRUPT_PENDING,thread) != NIL)
 634         lose("interrupt already pending\n");
 635     /* If interrupts are disabled then INTERRUPT_PENDING is set and
 636      * not PSEDUO_ATOMIC_INTERRUPTED. This is important for a pseudo
 637      * atomic section inside a WITHOUT-INTERRUPTS.
 638      */
 639     if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) {
 640         store_signal_data_for_later(data,handler,signal,info,context);
 641         SetSymbolValue(INTERRUPT_PENDING, T,thread);
 642         FSHOW_SIGNAL((stderr,
 643                       "/maybe_defer_handler(%x,%d): deferred\n",
 644                       (unsigned int)handler,signal));
 645         return 1;
 646     }
 647     /* a slightly confusing test. arch_pseudo_atomic_atomic() doesn't
 648      * actually use its argument for anything on x86, so this branch
 649      * may succeed even when context is null (gencgc alloc()) */
 650     if (arch_pseudo_atomic_atomic(context)) {
 651         store_signal_data_for_later(data,handler,signal,info,context);
 652         arch_set_pseudo_atomic_interrupted(context);
 653         FSHOW_SIGNAL((stderr,
 654                       "/maybe_defer_handler(%x,%d): deferred(PA)\n",
 655                       (unsigned int)handler,signal));
 656         return 1;
 657     }
 658     FSHOW_SIGNAL((stderr,
 659                   "/maybe_defer_handler(%x,%d): not deferred\n",
 660                   (unsigned int)handler,signal));
 661     return 0;
 662 }
 663
 664 static void
 665 store_signal_data_for_later (struct interrupt_data *data, void *handler,
 666                              int signal,
 667                              siginfo_t *info, os_context_t *context)
 668 {
 669     if (data->pending_handler)
 670         lose("tried to overwrite pending interrupt handler %x with %x\n",
 671              data->pending_handler, handler);
 672     if (!handler)
 673         lose("tried to defer null interrupt handler\n");
 674     data->pending_handler = handler;
 675     data->pending_signal = signal;
 676     if(info)
 677         memcpy(&(data->pending_info), info, sizeof(siginfo_t));
 678
 679     FSHOW_SIGNAL((stderr, "/store_signal_data_for_later: signal: %d\n",
 680                   signal));
 681
 682     if(context) {
 683         /* the signal mask in the context (from before we were
 684          * interrupted) is copied to be restored when
 685          * run_deferred_handler happens.  Then the usually-blocked
 686          * signals are added to the mask in the context so that we are
 687          * running with blocked signals when the handler returns */
 688         sigcopyset(&(data->pending_mask),os_context_sigmask_addr(context));
 689         sigaddset_deferrable(os_context_sigmask_addr(context));
 690     }
 691 }
 692
 693 static void
 694 maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 695 {
 696     os_context_t *context = arch_os_get_context(&void_context);
 697     struct thread *thread = arch_os_get_current_thread();
 698     struct interrupt_data *data = thread->interrupt_data;
 699
 700 #if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT)
 701     os_restore_fp_control(context);
 702 #endif
 703
 704     if(!maybe_defer_handler(interrupt_handle_now,data,signal,info,context))
 705         interrupt_handle_now(signal, info, context);
 706 }
 707
 708 static void
 709 low_level_interrupt_handle_now(int signal, siginfo_t *info,
 710                                os_context_t *context)
 711 {
 712     /* No FP control fixage needed, caller has done that. */
 713     check_blockables_blocked_or_lose();
 714     check_interrupts_enabled_or_lose(context);
 715     (*interrupt_low_level_handlers[signal])(signal, info, context);
 716     /* No Darwin context fixage needed, caller does that. */
 717 }
 718
 719 static void
 720 low_level_maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
 721 {
 722     os_context_t *context = arch_os_get_context(&void_context);
 723     struct thread *thread = arch_os_get_current_thread();
 724     struct interrupt_data *data = thread->interrupt_data;
 725
 726 #if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT)
 727     os_restore_fp_control(context);
 728 #endif
 729
 730     if(!maybe_defer_handler(low_level_interrupt_handle_now,data,
 731                             signal,info,context))
 732         low_level_interrupt_handle_now(signal, info, context);
 733 }
 734 #endif
 735
 736 #ifdef LISP_FEATURE_SB_THREAD
 737
 738 void
 739 sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context)
 740 {
 741     os_context_t *context = arch_os_get_context(&void_context);
 742
 743     struct thread *thread=arch_os_get_current_thread();
 744     sigset_t ss;
 745
 746     if (arch_pseudo_atomic_atomic(context)) {
 747         SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
 748         arch_set_pseudo_atomic_interrupted(context);
 749         FSHOW_SIGNAL((stderr, "sig_stop_for_gc deferred (PA)\n"));
 750         return;
 751     }
 752     else if (SymbolValue(GC_INHIBIT,thread) != NIL) {
 753         SetSymbolValue(STOP_FOR_GC_PENDING,T,thread);
 754         FSHOW_SIGNAL((stderr, "sig_stop_for_gc deferred (*GC-INHIBIT*)\n"));
 755         return;
 756     }
 757
 758     /* Not PA and GC not inhibited -- we can stop now. */
 759
 760     /* need the context stored so it can have registers scavenged */
 761     fake_foreign_function_call(context);
 762
 763     /* Block everything. */
 764     sigfillset(&ss);
 765     thread_sigmask(SIG_BLOCK,&ss,0);
 766
 767     /* Not pending anymore. */
 768     SetSymbolValue(GC_PENDING,NIL,thread);
 769     SetSymbolValue(STOP_FOR_GC_PENDING,NIL,thread);
 770
 771     if(thread->state!=STATE_RUNNING) {
 772         lose("sig_stop_for_gc_handler: wrong thread state: %ld\n",
 773              fixnum_value(thread->state));
 774     }
 775
 776     thread->state=STATE_SUSPENDED;
 777     FSHOW_SIGNAL((stderr,"suspended\n"));
 778
 779     sigemptyset(&ss);
 780 #if defined(SIG_RESUME_FROM_GC)
 781     sigaddset(&ss,SIG_RESUME_FROM_GC);
 782 #else
 783     sigaddset(&ss,SIG_STOP_FOR_GC);
 784 #endif
 785
 786     /* It is possible to get SIGCONT (and probably other non-blockable
 787      * signals) here. */
 788 #ifdef SIG_RESUME_FROM_GC
 789     {
 790         int sigret;
 791         do { sigwait(&ss, &sigret); }
 792         while (sigret != SIG_RESUME_FROM_GC);
 793     }
 794 #else
 795     while (sigwaitinfo(&ss,0) != SIG_STOP_FOR_GC);
 796 #endif
 797
 798     FSHOW_SIGNAL((stderr,"resumed\n"));
 799     if(thread->state!=STATE_RUNNING) {
 800         lose("sig_stop_for_gc_handler: wrong thread state on wakeup: %ld\n",
 801              fixnum_value(thread->state));
 802     }
 803
 804     undo_fake_foreign_function_call(context);
 805 }
 806 #endif
 807
 808 void
 809 interrupt_handle_now_handler(int signal, siginfo_t *info, void *void_context)
 810 {
 811     os_context_t *context = arch_os_get_context(&void_context);
 812 #if defined(LISP_FEATURE_LINUX) || defined(RESTORE_FP_CONTROL_FROM_CONTEXT)
 813     os_restore_fp_control(context);
 814 #ifndef LISP_FEATURE_WIN32
 815     if ((signal == SIGILL) || (signal == SIGBUS)
 816 #ifndef LISP_FEATURE_LINUX
 817         || (signal == SIGEMT)
 818 #endif
 819         )
 820         corruption_warning_and_maybe_lose("Signal %d recieved", signal);
 821 #endif
 822 #endif
 823     interrupt_handle_now(signal, info, context);
 824 }
 825
 826 /* manipulate the signal context and stack such that when the handler
 827  * returns, it will call function instead of whatever it was doing
 828  * previously
 829  */
 830
 831 #if (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
 832 extern int *context_eflags_addr(os_context_t *context);
 833 #endif
 834
 835 extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
 836 extern void post_signal_tramp(void);
 837 extern void call_into_lisp_tramp(void);
 838 void
 839 arrange_return_to_lisp_function(os_context_t *context, lispobj function)
 840 {
 841 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
 842     void * fun=native_pointer(function);
 843     void *code = &(((struct simple_fun *) fun)->code);
 844 #endif
 845
 846     /* Build a stack frame showing `interrupted' so that the
 847      * user's backtrace makes (as much) sense (as usual) */
 848
 849     /* FIXME: what about restoring fp state? */
 850     /* FIXME: what about restoring errno? */
 851 #ifdef LISP_FEATURE_X86
 852     /* Suppose the existence of some function that saved all
 853      * registers, called call_into_lisp, then restored GP registers and
 854      * returned.  It would look something like this:
 855
 856      push   ebp
 857      mov    ebp esp
 858      pushfl
 859      pushal
 860      push   $0
 861      push   $0
 862      pushl  {address of function to call}
 863      call   0x8058db0 <call_into_lisp>
 864      addl   $12,%esp
 865      popal
 866      popfl
 867      leave
 868      ret
 869
 870      * What we do here is set up the stack that call_into_lisp would
 871      * expect to see if it had been called by this code, and frob the
 872      * signal context so that signal return goes directly to call_into_lisp,
 873      * and when that function (and the lisp function it invoked) returns,
 874      * it returns to the second half of this imaginary function which
 875      * restores all registers and returns to C
 876
 877      * For this to work, the latter part of the imaginary function
 878      * must obviously exist in reality.  That would be post_signal_tramp
 879      */
 880
 881     u32 *sp=(u32 *)*os_context_register_addr(context,reg_ESP);
 882
 883 #if defined(LISP_FEATURE_DARWIN)
 884     u32 *register_save_area = (u32 *)os_validate(0, 0x40);
 885
 886     FSHOW_SIGNAL((stderr, "/arrange_return_to_lisp_function: preparing to go to function %x, sp: %x\n", function, sp));
 887     FSHOW_SIGNAL((stderr, "/arrange_return_to_lisp_function: context: %x, &context %x\n", context, &context));
 888
 889     /* 1. os_validate (malloc/mmap) register_save_block
 890      * 2. copy register state into register_save_block
 891      * 3. put a pointer to register_save_block in a register in the context
 892      * 4. set the context's EIP to point to a trampoline which:
 893      *    a. builds the fake stack frame from the block
 894      *    b. frees the block
 895      *    c. calls the function
 896      */
 897
 898     *register_save_area = *os_context_pc_addr(context);
 899     *(register_save_area + 1) = function;
 900     *(register_save_area + 2) = *os_context_register_addr(context,reg_EDI);
 901     *(register_save_area + 3) = *os_context_register_addr(context,reg_ESI);
 902     *(register_save_area + 4) = *os_context_register_addr(context,reg_EDX);
 903     *(register_save_area + 5) = *os_context_register_addr(context,reg_ECX);
 904     *(register_save_area + 6) = *os_context_register_addr(context,reg_EBX);
 905     *(register_save_area + 7) = *os_context_register_addr(context,reg_EAX);
 906     *(register_save_area + 8) = *context_eflags_addr(context);
 907
 908     *os_context_pc_addr(context) =
 909       (os_context_register_t) call_into_lisp_tramp;
 910     *os_context_register_addr(context,reg_ECX) =
 911       (os_context_register_t) register_save_area;
 912 #else
 913
 914     /* return address for call_into_lisp: */
 915     *(sp-15) = (u32)post_signal_tramp;
 916     *(sp-14) = function;        /* args for call_into_lisp : function*/
 917     *(sp-13) = 0;               /*                           arg array */
 918     *(sp-12) = 0;               /*                           no. args */
 919     /* this order matches that used in POPAD */
 920     *(sp-11)=*os_context_register_addr(context,reg_EDI);
 921     *(sp-10)=*os_context_register_addr(context,reg_ESI);
 922
 923     *(sp-9)=*os_context_register_addr(context,reg_ESP)-8;
 924     /* POPAD ignores the value of ESP:  */
 925     *(sp-8)=0;
 926     *(sp-7)=*os_context_register_addr(context,reg_EBX);
 927
 928     *(sp-6)=*os_context_register_addr(context,reg_EDX);
 929     *(sp-5)=*os_context_register_addr(context,reg_ECX);
 930     *(sp-4)=*os_context_register_addr(context,reg_EAX);
 931     *(sp-3)=*context_eflags_addr(context);
 932     *(sp-2)=*os_context_register_addr(context,reg_EBP);
 933     *(sp-1)=*os_context_pc_addr(context);
 934
 935 #endif
 936
 937 #elif defined(LISP_FEATURE_X86_64)
 938     u64 *sp=(u64 *)*os_context_register_addr(context,reg_RSP);
 939
 940     /* return address for call_into_lisp: */
 941     *(sp-18) = (u64)post_signal_tramp;
 942
 943     *(sp-17)=*os_context_register_addr(context,reg_R15);
 944     *(sp-16)=*os_context_register_addr(context,reg_R14);
 945     *(sp-15)=*os_context_register_addr(context,reg_R13);
 946     *(sp-14)=*os_context_register_addr(context,reg_R12);
 947     *(sp-13)=*os_context_register_addr(context,reg_R11);
 948     *(sp-12)=*os_context_register_addr(context,reg_R10);
 949     *(sp-11)=*os_context_register_addr(context,reg_R9);
 950     *(sp-10)=*os_context_register_addr(context,reg_R8);
 951     *(sp-9)=*os_context_register_addr(context,reg_RDI);
 952     *(sp-8)=*os_context_register_addr(context,reg_RSI);
 953     /* skip RBP and RSP */
 954     *(sp-7)=*os_context_register_addr(context,reg_RBX);
 955     *(sp-6)=*os_context_register_addr(context,reg_RDX);
 956     *(sp-5)=*os_context_register_addr(context,reg_RCX);
 957     *(sp-4)=*os_context_register_addr(context,reg_RAX);
 958     *(sp-3)=*context_eflags_addr(context);
 959     *(sp-2)=*os_context_register_addr(context,reg_RBP);
 960     *(sp-1)=*os_context_pc_addr(context);
 961
 962     *os_context_register_addr(context,reg_RDI) =
 963         (os_context_register_t)function; /* function */
 964     *os_context_register_addr(context,reg_RSI) = 0;        /* arg. array */
 965     *os_context_register_addr(context,reg_RDX) = 0;        /* no. args */
 966 #else
 967     struct thread *th=arch_os_get_current_thread();
 968     build_fake_control_stack_frames(th,context);
 969 #endif
 970
 971 #ifdef LISP_FEATURE_X86
 972
 973 #if !defined(LISP_FEATURE_DARWIN)
 974     *os_context_pc_addr(context) = (os_context_register_t)call_into_lisp;
 975     *os_context_register_addr(context,reg_ECX) = 0;
 976     *os_context_register_addr(context,reg_EBP) = (os_context_register_t)(sp-2);
 977 #ifdef __NetBSD__
 978     *os_context_register_addr(context,reg_UESP) =
 979         (os_context_register_t)(sp-15);
 980 #else
 981     *os_context_register_addr(context,reg_ESP) = (os_context_register_t)(sp-15);
 982 #endif /* __NETBSD__ */
 983 #endif /* LISP_FEATURE_DARWIN */
 984
 985 #elif defined(LISP_FEATURE_X86_64)
 986     *os_context_pc_addr(context) = (os_context_register_t)call_into_lisp;
 987     *os_context_register_addr(context,reg_RCX) = 0;
 988     *os_context_register_addr(context,reg_RBP) = (os_context_register_t)(sp-2);
 989     *os_context_register_addr(context,reg_RSP) = (os_context_register_t)(sp-18);
 990 #else
 991     /* this much of the calling convention is common to all
 992        non-x86 ports */
 993     *os_context_pc_addr(context) = (os_context_register_t)(unsigned long)code;
 994     *os_context_register_addr(context,reg_NARGS) = 0;
 995     *os_context_register_addr(context,reg_LIP) =
 996         (os_context_register_t)(unsigned long)code;
 997     *os_context_register_addr(context,reg_CFP) =
 998         (os_context_register_t)(unsigned long)current_control_frame_pointer;
 999 #endif
1000 #ifdef ARCH_HAS_NPC_REGISTER
1001     *os_context_npc_addr(context) =
1002         4 + *os_context_pc_addr(context);
1003 #endif
1004 #ifdef LISP_FEATURE_SPARC
1005     *os_context_register_addr(context,reg_CODE) =
1006         (os_context_register_t)(fun + FUN_POINTER_LOWTAG);
1007 #endif
1008     FSHOW((stderr, "/arranged return to Lisp function (0x%lx)\n",
1009            (long)function));
1010 }
1011
1012 #ifdef LISP_FEATURE_SB_THREAD
1013
1014 /* FIXME: this function can go away when all lisp handlers are invoked
1015  * via arrange_return_to_lisp_function. */
1016 void
1017 interrupt_thread_handler(int num, siginfo_t *info, void *v_context)
1018 {
1019     os_context_t *context = (os_context_t*)arch_os_get_context(&v_context);
1020
1021     FSHOW_SIGNAL((stderr,"/interrupt_thread_handler\n"));
1022     check_blockables_blocked_or_lose();
1023
1024     /* let the handler enable interrupts again when it sees fit */
1025     sigaddset_deferrable(os_context_sigmask_addr(context));
1026     arrange_return_to_lisp_function(context,
1027                                     StaticSymbolFunction(RUN_INTERRUPTION));
1028 }
1029
1030 #endif
1031
1032 /* KLUDGE: Theoretically the approach we use for undefined alien
1033  * variables should work for functions as well, but on PPC/Darwin
1034  * we get bus error at bogus addresses instead, hence this workaround,
1035  * that has the added benefit of automatically discriminating between
1036  * functions and variables.
1037  */
1038 void
1039 undefined_alien_function(void)
1040 {
1041     funcall0(StaticSymbolFunction(UNDEFINED_ALIEN_FUNCTION_ERROR));
1042 }
1043
1044 boolean
1045 handle_guard_page_triggered(os_context_t *context,os_vm_address_t addr)
1046 {
1047     struct thread *th=arch_os_get_current_thread();
1048
1049     /* note the os_context hackery here.  When the signal handler returns,
1050      * it won't go back to what it was doing ... */
1051     if(addr >= CONTROL_STACK_GUARD_PAGE(th) &&
1052        addr < CONTROL_STACK_GUARD_PAGE(th) + os_vm_page_size) {
1053         /* We hit the end of the control stack: disable guard page
1054          * protection so the error handler has some headroom, protect the
1055          * previous page so that we can catch returns from the guard page
1056          * and restore it. */
1057         corruption_warning_and_maybe_lose("Control stack exhausted");
1058         protect_control_stack_guard_page(0);
1059         protect_control_stack_return_guard_page(1);
1060
1061         arrange_return_to_lisp_function
1062             (context, StaticSymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
1063         return 1;
1064     }
1065     else if(addr >= CONTROL_STACK_RETURN_GUARD_PAGE(th) &&
1066             addr < CONTROL_STACK_RETURN_GUARD_PAGE(th) + os_vm_page_size) {
1067         /* We're returning from the guard page: reprotect it, and
1068          * unprotect this one. This works even if we somehow missed
1069          * the return-guard-page, and hit it on our way to new
1070          * exhaustion instead. */
1071         protect_control_stack_guard_page(1);
1072         protect_control_stack_return_guard_page(0);
1073         return 1;
1074     }
1075     else if (addr >= undefined_alien_address &&
1076              addr < undefined_alien_address + os_vm_page_size) {
1077         arrange_return_to_lisp_function
1078           (context, StaticSymbolFunction(UNDEFINED_ALIEN_VARIABLE_ERROR));
1079         return 1;
1080     }
1081     else return 0;
1082 }
1083 \f
1084 /*
1085  * noise to install handlers
1086  */
1087
1088 #ifndef LISP_FEATURE_WIN32
1089 /* In Linux 2.4 synchronous signals (sigtrap & co) can be delivered if
1090  * they are blocked, in Linux 2.6 the default handler is invoked
1091  * instead that usually coredumps. One might hastily think that adding
1092  * SA_NODEFER helps, but until ~2.6.13 if SA_NODEFER is specified then
1093  * the whole sa_mask is ignored and instead of not adding the signal
1094  * in question to the mask. That means if it's not blockable the
1095  * signal must be unblocked at the beginning of signal handlers.
1096  *
1097  * It turns out that NetBSD's SA_NODEFER doesn't DTRT in a different
1098  * way: if SA_NODEFER is set and the signal is in sa_mask, the signal
1099  * will be unblocked in the sigmask during the signal handler.  -- RMK
1100  * X-mas day, 2005
1101  */
1102 static volatile int sigaction_nodefer_works = -1;
1103
1104 #define SA_NODEFER_TEST_BLOCK_SIGNAL SIGABRT
1105 #define SA_NODEFER_TEST_KILL_SIGNAL SIGUSR1
1106
1107 static void
1108 sigaction_nodefer_test_handler(int signal, siginfo_t *info, void *void_context)
1109 {
1110     sigset_t empty, current;
1111     int i;
1112     sigemptyset(&empty);
1113     thread_sigmask(SIG_BLOCK, &empty, &current);
1114     /* There should be exactly two blocked signals: the two we added
1115      * to sa_mask when setting up the handler.  NetBSD doesn't block
1116      * the signal we're handling when SA_NODEFER is set; Linux before
1117      * 2.6.13 or so also doesn't block the other signal when
1118      * SA_NODEFER is set. */
1119     for(i = 1; i < NSIG; i++)
1120         if (sigismember(&current, i) !=
1121             (((i == SA_NODEFER_TEST_BLOCK_SIGNAL) || (i == signal)) ? 1 : 0)) {
1122             FSHOW_SIGNAL((stderr, "SA_NODEFER doesn't work, signal %d\n", i));
1123             sigaction_nodefer_works = 0;
1124         }
1125     if (sigaction_nodefer_works == -1)
1126         sigaction_nodefer_works = 1;
1127 }
1128
1129 static void
1130 see_if_sigaction_nodefer_works(void)
1131 {
1132     struct sigaction sa, old_sa;
1133
1134     sa.sa_flags = SA_SIGINFO | SA_NODEFER;
1135     sa.sa_sigaction = sigaction_nodefer_test_handler;
1136     sigemptyset(&sa.sa_mask);
1137     sigaddset(&sa.sa_mask, SA_NODEFER_TEST_BLOCK_SIGNAL);
1138     sigaddset(&sa.sa_mask, SA_NODEFER_TEST_KILL_SIGNAL);
1139     sigaction(SA_NODEFER_TEST_KILL_SIGNAL, &sa, &old_sa);
1140     /* Make sure no signals are blocked. */
1141     {
1142         sigset_t empty;
1143         sigemptyset(&empty);
1144         thread_sigmask(SIG_SETMASK, &empty, 0);
1145     }
1146     kill(getpid(), SA_NODEFER_TEST_KILL_SIGNAL);
1147     while (sigaction_nodefer_works == -1);
1148     sigaction(SA_NODEFER_TEST_KILL_SIGNAL, &old_sa, NULL);
1149 }
1150
1151 #undef SA_NODEFER_TEST_BLOCK_SIGNAL
1152 #undef SA_NODEFER_TEST_KILL_SIGNAL
1153
1154 static void
1155 unblock_me_trampoline(int signal, siginfo_t *info, void *void_context)
1156 {
1157     sigset_t unblock;
1158
1159     sigemptyset(&unblock);
1160     sigaddset(&unblock, signal);
1161     thread_sigmask(SIG_UNBLOCK, &unblock, 0);
1162     interrupt_handle_now_handler(signal, info, void_context);
1163 }
1164
1165 static void
1166 low_level_unblock_me_trampoline(int signal, siginfo_t *info, void *void_context)
1167 {
1168     sigset_t unblock;
1169
1170     sigemptyset(&unblock);
1171     sigaddset(&unblock, signal);
1172     thread_sigmask(SIG_UNBLOCK, &unblock, 0);
1173     (*interrupt_low_level_handlers[signal])(signal, info, void_context);
1174 }
1175
1176 void
1177 undoably_install_low_level_interrupt_handler (int signal,
1178                                               interrupt_handler_t handler)
1179 {
1180     struct sigaction sa;
1181
1182     if (0 > signal || signal >= NSIG) {
1183         lose("bad signal number %d\n", signal);
1184     }
1185
1186     if (ARE_SAME_HANDLER(handler, SIG_DFL))
1187         sa.sa_sigaction = handler;
1188     else if (sigismember(&deferrable_sigset,signal))
1189         sa.sa_sigaction = low_level_maybe_now_maybe_later;
1190     /* The use of a trampoline appears to break the
1191        arch_os_get_context() workaround for SPARC/Linux.  For now,
1192        don't use the trampoline (and so be vulnerable to the problems
1193        that SA_NODEFER is meant to solve. */
1194 #if !(defined(LISP_FEATURE_SPARC) && defined(LISP_FEATURE_LINUX))
1195     else if (!sigaction_nodefer_works &&
1196              !sigismember(&blockable_sigset, signal))
1197         sa.sa_sigaction = low_level_unblock_me_trampoline;
1198 #endif
1199     else
1200         sa.sa_sigaction = handler;
1201
1202     sigcopyset(&sa.sa_mask, &blockable_sigset);
1203     sa.sa_flags = SA_SIGINFO | SA_RESTART
1204         | (sigaction_nodefer_works ? SA_NODEFER : 0);
1205 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
1206     if((signal==SIG_MEMORY_FAULT)
1207 #ifdef SIG_INTERRUPT_THREAD
1208        || (signal==SIG_INTERRUPT_THREAD)
1209 #endif
1210        )
1211         sa.sa_flags |= SA_ONSTACK;
1212 #endif
1213
1214     sigaction(signal, &sa, NULL);
1215     interrupt_low_level_handlers[signal] =
1216         (ARE_SAME_HANDLER(handler, SIG_DFL) ? 0 : handler);
1217 }
1218 #endif
1219
1220 /* This is called from Lisp. */
1221 unsigned long
1222 install_handler(int signal, void handler(int, siginfo_t*, void*))
1223 {
1224 #ifndef LISP_FEATURE_WIN32
1225     struct sigaction sa;
1226     sigset_t old, new;
1227     union interrupt_handler oldhandler;
1228
1229     FSHOW((stderr, "/entering POSIX install_handler(%d, ..)\n", signal));
1230
1231     sigemptyset(&new);
1232     sigaddset(&new, signal);
1233     thread_sigmask(SIG_BLOCK, &new, &old);
1234
1235     FSHOW((stderr, "/interrupt_low_level_handlers[signal]=%x\n",
1236            (unsigned int)interrupt_low_level_handlers[signal]));
1237     if (interrupt_low_level_handlers[signal]==0) {
1238         if (ARE_SAME_HANDLER(handler, SIG_DFL) ||
1239             ARE_SAME_HANDLER(handler, SIG_IGN))
1240             sa.sa_sigaction = handler;
1241         else if (sigismember(&deferrable_sigset, signal))
1242             sa.sa_sigaction = maybe_now_maybe_later;
1243         else if (!sigaction_nodefer_works &&
1244                  !sigismember(&blockable_sigset, signal))
1245             sa.sa_sigaction = unblock_me_trampoline;
1246         else
1247             sa.sa_sigaction = interrupt_handle_now_handler;
1248
1249         sigcopyset(&sa.sa_mask, &blockable_sigset);
1250         sa.sa_flags = SA_SIGINFO | SA_RESTART |
1251             (sigaction_nodefer_works ? SA_NODEFER : 0);
1252         sigaction(signal, &sa, NULL);
1253     }
1254
1255     oldhandler = interrupt_handlers[signal];
1256     interrupt_handlers[signal].c = handler;
1257
1258     thread_sigmask(SIG_SETMASK, &old, 0);
1259
1260     FSHOW((stderr, "/leaving POSIX install_handler(%d, ..)\n", signal));
1261
1262     return (unsigned long)oldhandler.lisp;
1263 #else
1264     /* Probably-wrong Win32 hack */
1265     return 0;
1266 #endif
1267 }
1268
1269 /* This must not go through lisp as it's allowed anytime, even when on
1270  * the altstack. */
1271 void
1272 sigabrt_handler(int signal, siginfo_t *info, void *void_context)
1273 {
1274     lose("SIGABRT received.\n");
1275 }
1276
1277 void
1278 interrupt_init(void)
1279 {
1280 #ifndef LISP_FEATURE_WIN32
1281     int i;
1282     SHOW("entering interrupt_init()");
1283     see_if_sigaction_nodefer_works();
1284     sigemptyset(&deferrable_sigset);
1285     sigemptyset(&blockable_sigset);
1286     sigaddset_deferrable(&deferrable_sigset);
1287     sigaddset_blockable(&blockable_sigset);
1288
1289     /* Set up high level handler information. */
1290     for (i = 0; i < NSIG; i++) {
1291         interrupt_handlers[i].c =
1292             /* (The cast here blasts away the distinction between
1293              * SA_SIGACTION-style three-argument handlers and
1294              * signal(..)-style one-argument handlers, which is OK
1295              * because it works to call the 1-argument form where the
1296              * 3-argument form is expected.) */
1297             (void (*)(int, siginfo_t*, void*))SIG_DFL;
1298     }
1299     undoably_install_low_level_interrupt_handler(SIGABRT, sigabrt_handler);
1300     SHOW("returning from interrupt_init()");
1301 #endif
1302 }
1303
1304 #ifndef LISP_FEATURE_WIN32
1305 int
1306 siginfo_code(siginfo_t *info)
1307 {
1308     return info->si_code;
1309 }
1310 os_vm_address_t current_memory_fault_address;
1311
1312 void
1313 lisp_memory_fault_error(os_context_t *context, os_vm_address_t addr)
1314 {
1315    /* FIXME: This is lossy: if we get another memory fault (eg. from
1316     * another thread) before lisp has read this, we lose the information.
1317     * However, since this is mostly informative, we'll live with that for
1318     * now -- some address is better then no address in this case.
1319     */
1320     current_memory_fault_address = addr;
1321     /* To allow debugging memory faults in signal handlers and such. */
1322     corruption_warning_and_maybe_lose("Memory fault");
1323     arrange_return_to_lisp_function(context,
1324                                     StaticSymbolFunction(MEMORY_FAULT_ERROR));
1325 }
1326 #endif
1327
1328 static void
1329 unhandled_trap_error(os_context_t *context)
1330 {
1331     lispobj context_sap;
1332     fake_foreign_function_call(context);
1333     context_sap = alloc_sap(context);
1334 #ifndef LISP_FEATURE_WIN32
1335     thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
1336 #endif
1337     funcall1(StaticSymbolFunction(UNHANDLED_TRAP_ERROR), context_sap);
1338     lose("UNHANDLED-TRAP-ERROR fell through");
1339 }
1340
1341 /* Common logic for trapping instructions. How we actually handle each
1342  * case is highly architecture dependent, but the overall shape is
1343  * this. */
1344 void
1345 handle_trap(os_context_t *context, int trap)
1346 {
1347     switch(trap) {
1348     case trap_PendingInterrupt:
1349         FSHOW((stderr, "/<trap pending interrupt>\n"));
1350         arch_skip_instruction(context);
1351         interrupt_handle_pending(context);
1352         break;
1353     case trap_Error:
1354     case trap_Cerror:
1355         FSHOW((stderr, "/<trap error/cerror %d>\n", trap));
1356         interrupt_internal_error(context, trap==trap_Cerror);
1357         break;
1358     case trap_Breakpoint:
1359         arch_handle_breakpoint(context);
1360         break;
1361     case trap_FunEndBreakpoint:
1362         arch_handle_fun_end_breakpoint(context);
1363         break;
1364 #ifdef trap_AfterBreakpoint
1365     case trap_AfterBreakpoint:
1366         arch_handle_after_breakpoint(context);
1367         break;
1368 #endif
1369 #ifdef trap_SingleStepAround
1370     case trap_SingleStepAround:
1371     case trap_SingleStepBefore:
1372         arch_handle_single_step_trap(context, trap);
1373         break;
1374 #endif
1375     case trap_Halt:
1376         fake_foreign_function_call(context);
1377         lose("%%PRIMITIVE HALT called; the party is over.\n");
1378     default:
1379         unhandled_trap_error(context);
1380     }
1381 }
1382