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