Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / interrupt.c
CommitLineData
eeab7066
RT
1/*
2
3 This code was written as part of the CMU Common Lisp project at
4 Carnegie Mellon University, and has been placed in the public domain.
5
6*/
62957726 7
d5abee3c 8/* Interrupt handling magic. */
62957726 9
10#include <stdio.h>
34b793ce 11#include <unistd.h>
12#include <stdlib.h>
62957726 13#include <signal.h>
34b793ce 14#include <assert.h>
62957726 15
16#include "lisp.h"
3fb42466 17#include "arch.h"
62957726 18#include "internals.h"
19#include "os.h"
3fb42466 20#include "interrupt.h"
62957726 21#include "globals.h"
22#include "lispregs.h"
62957726 23#include "validate.h"
24#include "monitor.h"
25#include "gc.h"
26#include "alloc.h"
27#include "dynbind.h"
28#include "interr.h"
29
30boolean internal_errors_enabled = 0;
31
5d2cd5df 32os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
62957726 33
34union interrupt_handler interrupt_handlers[NSIG];
909ee789 35void (*interrupt_low_level_handlers[NSIG])(HANDLER_ARGS) = {0};
3fb42466 36
37static int pending_signal = 0;
909ee789 38static siginfo_t pending_code = {0};
3fb42466 39static sigset_t pending_mask;
62957726 40static boolean maybe_gc_pending = FALSE;
41
42
43/****************************************************************\
44* Utility routines used by various signal handlers. *
45\****************************************************************/
46
72f0aa1e 47void
9a8c1c2f 48build_fake_control_stack_frame(os_context_t * context)
72f0aa1e 49{
3f2ead72 50#if !(defined(i386) || defined(__x86_64))
9a8c1c2f 51 lispobj oldcont;
52
53 /* Build a fake stack frame */
54 current_control_frame_pointer = (lispobj *) SC_REG(context, reg_CSP);
55 if ((lispobj *) SC_REG(context, reg_CFP) == current_control_frame_pointer) {
56 /* There is a small window during call where the callee's frame */
57 /* isn't built yet. */
58 if (LowtagOf(SC_REG(context, reg_CODE)) == type_FunctionPointer) {
59 /* We have called, but not built the new frame, so
60 build it for them. */
61 current_control_frame_pointer[0] = SC_REG(context, reg_OCFP);
62 current_control_frame_pointer[1] = SC_REG(context, reg_LRA);
63 current_control_frame_pointer += 8;
64 /* Build our frame on top of it. */
65 oldcont = (lispobj) SC_REG(context, reg_CFP);
66 } else {
67 /* We haven't yet called, build our frame as if the
68 partial frame wasn't there. */
69 oldcont = (lispobj) SC_REG(context, reg_OCFP);
70 }
72f0aa1e 71 }
9a8c1c2f 72 /* ### We can't tell if we are still in the caller if it had to
73 reg_ALLOCate the stack frame due to stack arguments. */
74 /* ### Can anything strange happen during return? */
72f0aa1e 75 else {
9a8c1c2f 76
77 /* Normal case. */
78 oldcont = (lispobj) SC_REG(context, reg_CFP);
72f0aa1e 79 }
9a8c1c2f 80
81 current_control_stack_pointer = current_control_frame_pointer + 8;
82
83 current_control_frame_pointer[0] = oldcont;
84 current_control_frame_pointer[1] = NIL;
85 current_control_frame_pointer[2] = (lispobj) SC_REG(context, reg_CODE);
72f0aa1e 86#endif
87}
88
9a8c1c2f 89void
90fake_foreign_function_call(os_context_t * context)
62957726 91{
92 int context_index;
81936185 93
62957726 94 /* Get current LISP state from context */
95#ifdef reg_ALLOC
9a8c1c2f 96 current_dynamic_space_free_pointer = (lispobj *) SC_REG(context, reg_ALLOC);
6f4a04e5 97#ifdef alpha
9a8c1c2f 98 if ((long) current_dynamic_space_free_pointer & 1) {
99 printf("Dead in fake_foriegn_function-call, context = %x\n", context);
100 lose("");
6f4a04e5 101 }
102#endif
62957726 103#endif
104#ifdef reg_BSP
9a8c1c2f 105 current_binding_stack_pointer = (lispobj *) SC_REG(context, reg_BSP);
62957726 106#endif
9a8c1c2f 107
72f0aa1e 108 build_fake_control_stack_frame(context);
9a8c1c2f 109
62957726 110 /* Do dynamic binding of the active interrupt context index
111 and save the context in the context array. */
9a8c1c2f 112 context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2;
113
62957726 114 if (context_index >= MAX_INTERRUPTS) {
9a8c1c2f 115 fprintf(stderr,
62957726 116 "Maximum number (%d) of interrupts exceeded. Exiting.\n",
9a8c1c2f 117 MAX_INTERRUPTS);
118 exit(1);
62957726 119 }
9a8c1c2f 120
121 bind_variable(FREE_INTERRUPT_CONTEXT_INDEX, make_fixnum(context_index + 1));
122
62957726 123 lisp_interrupt_contexts[context_index] = context;
9a8c1c2f 124
62957726 125 /* No longer in Lisp now. */
126 foreign_function_call_active = 1;
127}
128
9a8c1c2f 129void
130undo_fake_foreign_function_call(os_context_t * context)
62957726 131{
132 /* Block all blockable signals */
3fb42466 133 sigset_t block;
9a8c1c2f 134
3fb42466 135 sigemptyset(&block);
136 FILLBLOCKSET(&block);
137 sigprocmask(SIG_BLOCK, &block, 0);
9a8c1c2f 138
62957726 139 /* Going back into lisp. */
140 foreign_function_call_active = 0;
9a8c1c2f 141
62957726 142 /* Undo dynamic binding. */
143 /* ### Do I really need to unbind_to_here()? */
144 unbind();
9a8c1c2f 145
62957726 146#ifdef reg_ALLOC
147 /* Put the dynamic space free pointer back into the context. */
148 SC_REG(context, reg_ALLOC) =
9a8c1c2f 149 (unsigned long) current_dynamic_space_free_pointer;
62957726 150#endif
151}
152
9a8c1c2f 153void
a6937e87 154interrupt_internal_error(HANDLER_ARGS, boolean continuable)
62957726 155{
00353423 156 ucontext_t *ucontext = (ucontext_t *) context;
fcb4d9e1 157 lispobj context_sap = NIL;
9a8c1c2f 158
342beebb 159 fake_foreign_function_call(context);
9dbbbc29 160
a6937e87 161 /* Allocate the SAP object while the interrupts are still disabled. */
f851310c 162 if (internal_errors_enabled)
a6937e87 163 context_sap = alloc_sap(context);
f851310c 164
00353423 165 sigprocmask(SIG_SETMASK, &ucontext->uc_sigmask, 0);
9dbbbc29 166
7fbcd958 167 if (internal_errors_enabled)
f851310c 168 funcall2(SymbolFunction(INTERNAL_ERROR), context_sap,
62957726 169 continuable ? T : NIL);
170 else
171 internal_error(context);
172 undo_fake_foreign_function_call(context);
173 if (continuable)
174 arch_skip_instruction(context);
175}
176
d6cb31e4
RT
177static void
178copy_sigmask(sigset_t *dst, sigset_t *src)
179{
180#ifndef __linux__
181 *dst = *src;
182#else
a993b160 183 memcpy(dst, src, NSIG / CHAR_BIT);
d6cb31e4
RT
184#endif
185}
186
9a8c1c2f 187void
188interrupt_handle_pending(os_context_t * context)
62957726 189{
44e0351e 190#ifndef i386
62957726 191 boolean were_in_lisp = !foreign_function_call_active;
44e0351e 192#endif
62957726 193
194 SetSymbolValue(INTERRUPT_PENDING, NIL);
195
196 if (maybe_gc_pending) {
197 maybe_gc_pending = FALSE;
c308db4d 198#ifndef i386
62957726 199 if (were_in_lisp)
c308db4d 200#endif
62957726 201 fake_foreign_function_call(context);
202 funcall0(SymbolFunction(MAYBE_GC));
c308db4d 203#ifndef i386
62957726 204 if (were_in_lisp)
c308db4d 205#endif
62957726 206 undo_fake_foreign_function_call(context);
207 }
d6cb31e4
RT
208
209 copy_sigmask(&context->uc_sigmask, &pending_mask);
7de331b5 210 sigemptyset(&pending_mask);
7de331b5 211
62957726 212 if (pending_signal) {
3fb42466 213 int signal;
342beebb 214 siginfo_t code;
909ee789 215
62957726 216 signal = pending_signal;
217 code = pending_code;
218 pending_signal = 0;
5ced0fdf 219 /* pending_code = 0; */
909ee789 220 interrupt_handle_now(signal, &code, context);
62957726 221 }
62957726 222}
223
224
225/****************************************************************\
eb44537a 226* interrupt_handle_now_handler, maybe_now_maybe_later *
62957726 227* the two main signal handlers. *
eb44537a 228* interrupt_handle_now *
229* is called from those to do the real work, but isn't itself *
230* a handler. *
62957726 231\****************************************************************/
232
9a8c1c2f 233void
eb44537a 234interrupt_handle_now_handler(HANDLER_ARGS)
235{
9a8c1c2f 236 interrupt_handle_now(signal, code, context);
eb44537a 237
555746e0 238#if defined(DARWIN) && defined(__ppc__)
9a8c1c2f 239 /* Work around G5 bug; fix courtesy gbyers via chandler */
eb44537a 240 sigreturn(context);
241#endif
242}
243
9a8c1c2f 244void
5ced0fdf 245interrupt_handle_now(HANDLER_ARGS)
62957726 246{
247 int were_in_lisp;
00353423 248 ucontext_t *ucontext = (ucontext_t *) context;
62957726 249 union interrupt_handler handler;
5ced0fdf 250
62957726 251 handler = interrupt_handlers[signal];
252
44eba57f 253 RESTORE_FPU(context);
254
9a8c1c2f 255 if (handler.c == (void (*)(HANDLER_ARGS)) SIG_IGN)
62957726 256 return;
257
9a8c1c2f 258 SAVE_CONTEXT();
259 /**/ were_in_lisp = !foreign_function_call_active;
3f2ead72 260#if ! (defined(i386) || defined(_x86_64))
62957726 261 if (were_in_lisp)
c308db4d 262#endif
9a8c1c2f 263 fake_foreign_function_call(context);
264
5bfcdf88 265 if (handler.c == (void (*)(HANDLER_ARGS)) SIG_DFL)
d89e9cd4 266 /* This can happen if someone tries to ignore or default on one of the */
62957726 267 /* signals we need for runtime support, and the runtime support */
268 /* decides to pass on it. */
269 lose("interrupt_handle_now: No handler for signal %d?\n", signal);
f851310c 270 else if (LowtagOf(handler.lisp) == type_FunctionPointer) {
9a8c1c2f 271 /* Allocate the SAP object while the interrupts are still
272 disabled. */
273 lispobj context_sap = alloc_sap(context);
f851310c 274
9a8c1c2f 275 /* Allow signals again. */
00353423 276 sigprocmask(SIG_SETMASK, &ucontext->uc_sigmask, 0);
9a8c1c2f 277
3fb42466 278#if 1
9a8c1c2f 279 funcall3(handler.lisp, make_fixnum(signal), make_fixnum(CODE(code)),
f851310c 280 context_sap);
3fb42466 281#else
9a8c1c2f 282 funcall3(handler.lisp, make_fixnum(signal), alloc_sap(code),
f851310c 283 alloc_sap(context));
3fb42466 284#endif
f851310c 285 } else {
9a8c1c2f 286 /* Allow signals again. */
00353423 287 sigprocmask(SIG_SETMASK, &ucontext->uc_sigmask, 0);
9a8c1c2f 288
9a8c1c2f 289 (*handler.c) (signal, code, context);
f851310c 290 }
9a8c1c2f 291
3f2ead72 292#if !(defined(i386) || defined(__x86_64))
62957726 293 if (were_in_lisp)
c308db4d 294#endif
9a8c1c2f 295 undo_fake_foreign_function_call(context);
62957726 296}
297
9a8c1c2f 298static void
572f5c8f 299setup_pending_signal(HANDLER_ARGS)
300{
00353423 301 ucontext_t *ucontext = (ucontext_t *) context;
572f5c8f 302 pending_signal = signal;
303 /*
304 * Note: We used to set pending_code = *code. This doesn't work
305 * very well on Solaris since code is sometimes NULL. AFAICT, we
306 * only care about the si_code value, so just get the si_code
307 * value. The CODE macro does something appropriate when code is
308 * NULL.
309 *
310 * A look at the Lisp handlers shows that the code value is
311 * ignored anyway.
312 *
313 */
314 pending_code.si_code = CODE(code);
d6cb31e4 315 copy_sigmask(&pending_mask, &ucontext->uc_sigmask);
00353423 316 FILLBLOCKSET(&ucontext->uc_sigmask);
572f5c8f 317}
318
319static void
5ced0fdf 320maybe_now_maybe_later(HANDLER_ARGS)
62957726 321{
342beebb 322 SAVE_CONTEXT();
572f5c8f 323 if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
324 setup_pending_signal(signal, code, context);
9a8c1c2f 325 SetSymbolValue(INTERRUPT_PENDING, T);
c308db4d 326 } else if (
3f2ead72 327#if !(defined(i386) || defined(__x86_64))
9a8c1c2f 328 (!foreign_function_call_active) &&
c308db4d 329#endif
9a8c1c2f 330 arch_pseudo_atomic_atomic(context)) {
572f5c8f 331 setup_pending_signal(signal, code, context);
62957726 332 arch_set_pseudo_atomic_interrupted(context);
9f4a1f5e 333 } else {
44eba57f 334 RESTORE_FPU(context);
9a8c1c2f 335 interrupt_handle_now(signal, code, context);
9f4a1f5e 336 }
eb44537a 337
555746e0 338#if defined(DARWIN) && defined(__ppc__)
eb44537a 339 /* Work around G5 bug; fix courtesy gbyers via chandler */
340 sigreturn(context);
341#endif
62957726 342}
343
344/****************************************************************\
345* Stuff to detect and handle hitting the gc trigger. *
346\****************************************************************/
347
348#ifndef INTERNAL_GC_TRIGGER
9a8c1c2f 349static boolean
350gc_trigger_hit(HANDLER_ARGS)
62957726 351{
34b793ce 352 if (current_auto_gc_trigger == NULL) {
62957726 353 return FALSE;
34b793ce 354 } else {
9a8c1c2f 355 lispobj *badaddr = (lispobj *) arch_get_bad_addr(signal, code, context);
62957726 356
34b793ce 357#ifdef PRINTNOISE
9a8c1c2f 358 fprintf(stderr,
359 "gc_trigger_hit: badaddr=%p, current_auto_gc_trigger=%p, limit=%p\n",
360 badaddr, current_auto_gc_trigger,
361 current_dynamic_space + dynamic_space_size);
34b793ce 362#endif
62957726 363 return (badaddr >= current_auto_gc_trigger &&
9a8c1c2f 364 (unsigned long) badaddr <
365 (unsigned long) current_dynamic_space +
366 (unsigned long) dynamic_space_size);
62957726 367 }
368}
369#endif
370
da0628eb 371#if !(defined(i386) || defined(__x86_64) || defined(GENCGC))
9a8c1c2f 372boolean
373interrupt_maybe_gc(HANDLER_ARGS)
62957726 374{
375 if (!foreign_function_call_active
376#ifndef INTERNAL_GC_TRIGGER
9a8c1c2f 377 && gc_trigger_hit(signal, code, context)
62957726 378#endif
379 ) {
380#ifndef INTERNAL_GC_TRIGGER
381 clear_auto_gc_trigger();
382#endif
383
384 if (arch_pseudo_atomic_atomic(context)) {
385 maybe_gc_pending = TRUE;
386 if (pending_signal == 0) {
d6cb31e4 387 copy_sigmask(&pending_mask, &context->uc_sigmask);
342beebb 388 FILLBLOCKSET(&context->uc_sigmask);
62957726 389 }
390 arch_set_pseudo_atomic_interrupted(context);
9a8c1c2f 391 } else {
62957726 392 fake_foreign_function_call(context);
393 funcall0(SymbolFunction(MAYBE_GC));
394 undo_fake_foreign_function_call(context);
395 }
396
397 return TRUE;
5bfcdf88 398 } else
62957726 399 return FALSE;
400}
798ec63b 401#endif
402
62957726 403/****************************************************************\
404* Noise to install handlers. *
405\****************************************************************/
406
f694a47e 407#if !(defined(i386) || defined(__x86_64))
52fca1ac 408#define SIGNAL_STACK_SIZE SIGSTKSZ
409static char altstack[SIGNAL_STACK_SIZE];
410#endif
411
670d643f 412void
9a8c1c2f 413interrupt_install_low_level_handler(int signal, void handler(HANDLER_ARGS))
62957726 414{
9a8c1c2f 415 struct sigaction sa;
416
aa96ed2c 417 sa.sa_sigaction = (void (*)(HANDLER_ARGS)) handler;
9a8c1c2f 418 sigemptyset(&sa.sa_mask);
419 FILLBLOCKSET(&sa.sa_mask);
87de7c42 420 sa.sa_flags = SA_RESTART | SA_SIGINFO;
9a8c1c2f 421
422 /* Deliver protection violations on a dedicated signal stack,
423 because, when we get that signal because of hitting a control
424 stack guard zone, it's not a good idea to use more of the
425 control stack for handling the signal. */
426 /* But we only need this on x86 since the Lisp control stack and the
427 C control stack are the same. For others, they're separate so
428 the C stack can still be used. */
d5abee3c 429#ifdef RED_ZONE_HIT
9a8c1c2f 430 if (signal == PROTECTION_VIOLATION_SIGNAL) {
431 stack_t sigstack;
432
d5abee3c 433#if (defined( i386 ) || defined(__x86_64))
9a8c1c2f 434 sigstack.ss_sp = (void *) SIGNAL_STACK_START;
52fca1ac 435#else
9a8c1c2f 436 sigstack.ss_sp = (void *) altstack;
d5abee3c 437#endif
9a8c1c2f 438 sigstack.ss_flags = 0;
439 sigstack.ss_size = SIGNAL_STACK_SIZE;
440 if (sigaltstack(&sigstack, 0) == -1)
441 perror("sigaltstack");
442 sa.sa_flags |= SA_ONSTACK;
670d643f 443 }
444#endif /* RED_ZONE_HIT */
3fb42466 445
9a8c1c2f 446 sigaction(signal, &sa, NULL);
447
670d643f 448
9a8c1c2f 449 if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL)
450 interrupt_low_level_handlers[signal] = 0;
451 else
452 interrupt_low_level_handlers[signal] = handler;
62957726 453}
454
9a8c1c2f 455unsigned long
456install_handler(int signal, void handler(HANDLER_ARGS))
3fb42466 457{
458 struct sigaction sa;
9a8c1c2f 459 sigset_t old, new;
3fb42466 460 union interrupt_handler oldhandler;
461
462 sigemptyset(&new);
463 sigaddset(&new, signal);
464 sigprocmask(SIG_BLOCK, &new, &old);
465
466 sigemptyset(&new);
467 FILLBLOCKSET(&new);
468
9a8c1c2f 469 if (interrupt_low_level_handlers[signal] == 0) {
470 if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL
471 || handler == (void (*)(HANDLER_ARGS)) SIG_IGN)
aa96ed2c 472 sa.sa_sigaction = (void (*)(HANDLER_ARGS)) handler;
3fb42466 473 else if (sigismember(&new, signal))
aa96ed2c 474 sa.sa_sigaction = (void (*)(HANDLER_ARGS)) maybe_now_maybe_later;
3fb42466 475 else
aa96ed2c
RT
476 sa.sa_sigaction = (void (*)(HANDLER_ARGS)) interrupt_handle_now_handler;
477
3fb42466 478 sigemptyset(&sa.sa_mask);
479 FILLBLOCKSET(&sa.sa_mask);
87de7c42 480 sa.sa_flags = SA_SIGINFO | SA_RESTART;
3fb42466 481
482 sigaction(signal, &sa, NULL);
483 }
484
485 oldhandler = interrupt_handlers[signal];
486 interrupt_handlers[signal].c = handler;
487
488 sigprocmask(SIG_SETMASK, &old, 0);
489
5bfcdf88 490 return (unsigned long) oldhandler.lisp;
3fb42466 491}
62957726 492
eb44537a 493#ifdef FEATURE_HEAP_OVERFLOW_CHECK
3e309c44 494void
9a8c1c2f 495interrupt_handle_space_overflow(lispobj error, os_context_t * context)
3e309c44 496{
3e4590e7 497#if defined(i386) || defined(__x86_64)
9a8c1c2f 498 SC_PC(context) = (int) ((struct function *) PTR(error))->code;
3e4590e7 499 SC_REG(context, reg_NARGS) = 0;
500#elif defined(sparc)
9a8c1c2f 501 build_fake_control_stack_frame(context);
502 /* This part should be common to all non-x86 ports */
503 SC_PC(context) = (long) ((struct function *) PTR(error))->code;
504 SC_NPC(context) = SC_PC(context) + 4;
505 SC_REG(context, reg_NARGS) = 0;
506 SC_REG(context, reg_LIP) = (long) ((struct function *) PTR(error))->code;
507 SC_REG(context, reg_CFP) = (long) current_control_frame_pointer;
508 /* This is sparc specific */
509 SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer;
aa04f6fc 510 /*
511 * Restore important Lisp regs. Are there others we need to
512 * restore?
513 */
0fc8f462 514 SC_REG(context, reg_ALLOC) = (long) current_dynamic_space_free_pointer;
aa04f6fc 515 SC_REG(context, reg_NIL) = NIL;
eb44537a 516#else
517#error interrupt_handle_space_overflow not implemented for this system
518#endif
3e309c44 519}
eb44537a 520#endif /* FEATURE_HEAP_OVERFLOW_CHECK */
3e309c44 521
9a8c1c2f 522void
523interrupt_init(void)
62957726 524{
525 int i;
526
527 for (i = 0; i < NSIG; i++)
9a8c1c2f 528 interrupt_handlers[i].c = (void (*)(HANDLER_ARGS)) SIG_DFL;
62957726 529}