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