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