diff --git a/ldb/alloc.c b/ldb/alloc.c index 35d0e340310a5728bd85daaa25dc4d3850d806fc..ec58c4a11a59ad4a365066672372394235912c4e 100644 --- a/ldb/alloc.c +++ b/ldb/alloc.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/alloc.c,v 1.4 1990/09/27 06:32:32 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/alloc.c,v 1.5 1990/10/13 04:48:16 wlott Exp $ */ #include "lisp.h" #include "ldb.h" #include "alloc.h" @@ -20,6 +20,14 @@ int bytes; result = current_dynamic_space_free_pointer; current_dynamic_space_free_pointer += (bytes / sizeof(lispobj)); + if (current_auto_gc_trigger && + current_dynamic_space_free_pointer > current_auto_gc_trigger) { + /* We can't GC while in C land, so just dink the trigger. */ + clear_auto_gc_trigger(); + set_auto_gc_trigger((char *)current_dynamic_space_free_pointer - + (char *)current_dynamic_space); + } + return result; } diff --git a/ldb/gc.c b/ldb/gc.c index e34e442b1a74947efe67d819bf52c6e0dbbcdcf7..70c74e0f0eef48c58b382dd7d6ff52538448d4e7 100644 --- a/ldb/gc.c +++ b/ldb/gc.c @@ -1,7 +1,7 @@ /* * Stop and Copy GC based on Cheney's algorithm. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.14 1990/10/02 23:04:18 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.15 1990/10/13 04:49:50 wlott Exp $ * * Written by Christopher Hoover. */ @@ -1806,3 +1806,28 @@ gc_init() sizetab[type_WeakPointer] = size_weak_pointer; sizetab[type_StructureHeader] = size_vector; } + + + +/* Noise to manipulate the gc trigger stuff. */ + +void set_auto_gc_trigger(dynamic_usage) + unsigned long dynamic_usage; +{ + vm_address_t addr; + vm_size_t length; + + addr = round_page((vm_address_t)current_dynamic_space + dynamic_usage); + length = DYNAMIC_SPACE_SIZE + (vm_address_t)current_dynamic_space - addr; + + os_protect(addr, length, 0); + current_auto_gc_trigger = (lispobj *)addr; +} + +void clear_auto_gc_trigger() +{ + os_protect((vm_address_t)current_dynamic_space, DYNAMIC_SPACE_SIZE, + VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE); + current_auto_gc_trigger = NULL; +} + diff --git a/ldb/globals.c b/ldb/globals.c index ba55b3ac6feea116d73cb3f25b2cbbb2f04c8cb9..06f24be50aa83bc5cef670b32f3520f2d68e47c4 100644 --- a/ldb/globals.c +++ b/ldb/globals.c @@ -1,7 +1,9 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.c,v 1.4 1990/09/21 05:56:31 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.c,v 1.5 1990/10/13 04:49:57 wlott Exp $ */ /* Variables everybody needs to look at or frob on. */ +#include <stdio.h> + #include "lisp.h" #include "globals.h" @@ -27,6 +29,7 @@ lispobj *binding_stack; lispobj *current_dynamic_space; lispobj *current_dynamic_space_free_pointer; +lispobj *current_auto_gc_trigger; globals_init() { @@ -38,6 +41,9 @@ globals_init() saved_global_pointer = current_global_pointer(); #endif + /* No GC trigger yet */ + current_auto_gc_trigger = NULL; + /* Set foreign function call active. */ foreign_function_call_active = 1; diff --git a/ldb/globals.h b/ldb/globals.h index f13b600072882181f45f76258a288015165f8ed2..23b5fa356f17fbf98fc5a93d753aa7544c423c12 100644 --- a/ldb/globals.h +++ b/ldb/globals.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.h,v 1.4 1990/09/21 05:56:46 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.h,v 1.5 1990/10/13 04:49:59 wlott Exp $ */ #if !defined(_INCLUDE_GLOBALS_H_) #define _INCLUDED_GLOBALS_H_ @@ -29,6 +29,7 @@ extern lispobj *binding_stack; extern lispobj *current_dynamic_space; extern lispobj *current_dynamic_space_free_pointer; +extern lispobj *current_auto_gc_trigger; #else diff --git a/ldb/interrupt.c b/ldb/interrupt.c index de6cb38ff429a5f5f74cddaea9ac62998aa4d4b4..fb733a7bfa6c738c2e5753099ed17db11a7f8b2d 100644 --- a/ldb/interrupt.c +++ b/ldb/interrupt.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/interrupt.c,v 1.9 1990/09/21 05:59:35 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/interrupt.c,v 1.10 1990/10/13 04:50:01 wlott Exp $ */ /* Interrupt handing magic. */ @@ -12,136 +12,139 @@ #include "globals.h" #include "lispregs.h" #include "interrupt.h" +#include "validate.h" + +#define crap_out(msg) do { write(2, msg, sizeof(msg)); abort(); } while (0) struct sigcontext *lisp_interrupt_contexts[MAX_INTERRUPTS]; union interrupt_handler interrupt_handlers[NSIG]; -static int pending_signal, pending_code, pending_mask; +static int pending_signal = 0, pending_code = 0, pending_mask = 0; +static boolean maybe_gc_pending = FALSE; + +static void fake_foreign_function_call(context) + struct sigcontext *context; +{ + int context_index; + lispobj oldcont; + + /* Get current LISP state from context */ + current_dynamic_space_free_pointer = (lispobj *) context->sc_regs[ALLOC]; + current_binding_stack_pointer = (lispobj *) context->sc_regs[BSP]; + current_flags_register = context->sc_regs[FLAGS]|(1<<flag_Atomic); + + /* Build a fake stack frame */ + current_control_frame_pointer = (lispobj *) context->sc_regs[CSP]; + if ((lispobj *)context->sc_regs[CONT]==current_control_frame_pointer) { + /* There is a small window during call where the callee's frame */ + /* isn't built yet. */ + if (LowtagOf(context->sc_regs[CODE]) == type_FunctionPointer) { + /* We have called, but not built the new frame, so + build it for them. */ + current_control_frame_pointer[0] = context->sc_regs[OLDCONT]; + current_control_frame_pointer[1] = context->sc_regs[LRA]; + current_control_frame_pointer += 8; + /* Build our frame on top of it. */ + oldcont = (lispobj)context->sc_regs[CONT]; + } + else { + /* We haven't yet called, build our frame as if the + partial frame wasn't there. */ + oldcont = (lispobj)context->sc_regs[OLDCONT]; + } + } + /* ### We can't tell if we are still in the caller if it had to + allocate the stack frame due to stack arguments. */ + /* ### Can anything strange happen during return? */ + else + /* Normal case. */ + oldcont = (lispobj)context->sc_regs[CONT]; + + current_control_stack_pointer = current_control_frame_pointer + 8; + current_control_frame_pointer[0] = oldcont; + current_control_frame_pointer[1] = NIL; + current_control_frame_pointer[2] = (lispobj)context->sc_regs[CODE]; + +#ifdef mips + /* Restore the GP */ + set_global_pointer(saved_global_pointer); +#endif + + /* Do dynamic binding of the active interrupt context index + and save the context in the context array. */ + context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; + + if (context_index >= MAX_INTERRUPTS) { + fprintf("Maximum number (%d) of interrupts exceeded. Exiting.\n", + MAX_INTERRUPTS); + exit(1); + } + + bind_variable(FREE_INTERRUPT_CONTEXT_INDEX, fixnum(context_index + 1)); + + lisp_interrupt_contexts[context_index] = context; + + /* No longer in Lisp now. */ + foreign_function_call_active = 1; +} +static void undo_fake_foreign_function_call(context) + struct sigcontext *context; +{ + /* Block all blockable signals */ + sigblock(BLOCKABLE); + + /* Going back into lisp. */ + foreign_function_call_active = 0; + + /* Undo dynamic binding. */ + /* ### Do I really need to unbind_to_here()? */ + unbind(); + + /* Put the dynamic space free pointer back into the context. */ + context->sc_regs[ALLOC] = + (unsigned long) current_dynamic_space_free_pointer; +} static handle_now(signal, code, context) int signal, code; struct sigcontext *context; { - int were_in_lisp; - union interrupt_handler handler; - lispobj *args; - lispobj callname, function; - long mask; - - handler = interrupt_handlers[signal]; - were_in_lisp = !foreign_function_call_active; - - if (were_in_lisp) { - int context_index; - lispobj oldcont; - - /* Get current LISP state from context */ - current_dynamic_space_free_pointer = - (lispobj *) context->sc_regs[ALLOC]; - current_binding_stack_pointer = - (lispobj *) context->sc_regs[BSP]; - current_flags_register = context->sc_regs[FLAGS]|(1<<flag_Atomic); - - /* Build a fake stack frame */ - current_control_frame_pointer = - (lispobj *) context->sc_regs[CSP]; - if ((lispobj *)context->sc_regs[CONT] == current_control_frame_pointer) { - /* There is a small window during call where the callee's frame isn't built yet. */ - if (LowtagOf(context->sc_regs[CODE]) == type_FunctionPointer) { - /* We have called, but not built the new frame, so - build it for them. */ - current_control_frame_pointer[0] = - context->sc_regs[OLDCONT]; - current_control_frame_pointer[1] = - context->sc_regs[LRA]; - current_control_frame_pointer += 8; - /* Build our frame on top of it. */ - oldcont = (lispobj)context->sc_regs[CONT]; - } - else { - /* We haven't yet called, build our frame as if the - partial frame wasn't there. */ - oldcont = (lispobj)context->sc_regs[OLDCONT]; - } - } - /* ### We can't tell if we are still in the caller if it had to - allocate the stack frame due to stack arguments. */ - /* ### Can anything strange happen during return? */ - else - /* Normal case. */ - oldcont = (lispobj)context->sc_regs[CONT]; - - current_control_stack_pointer = - current_control_frame_pointer + 8; - current_control_frame_pointer[0] = oldcont; - current_control_frame_pointer[1] = NIL; - current_control_frame_pointer[2] = - (lispobj)context->sc_regs[CODE]; - -#ifdef mips - /* Restore the GP */ - set_global_pointer(saved_global_pointer); -#endif - - /* Do dynamic binding of the active interrupt context index - and save the context in the context array. */ - context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; - - if (context_index >= MAX_INTERRUPTS) { - fprintf("Maximum number (%d) of interrupts exceeded. Exiting.\n", - MAX_INTERRUPTS); - exit(1); - } - - bind_variable(FREE_INTERRUPT_CONTEXT_INDEX, - fixnum(context_index + 1)); - - lisp_interrupt_contexts[context_index] = context; - - /* No longer in Lisp now. */ - foreign_function_call_active = 1; - } - - /* Allow signals again. */ - sigsetmask(context->sc_mask); - - if (LowtagOf(handler.lisp) == type_EvenFixnum || - LowtagOf(handler.lisp) == type_OddFixnum) - (*handler.c)(signal, code, context); - else { - args = current_control_stack_pointer; - current_control_stack_pointer += 3; - args[0] = fixnum(signal); - args[1] = fixnum(code); - args[2] = alloc_sap(context); - callname = handler.lisp; - if (LowtagOf(callname) == type_FunctionPointer) - function = callname; - else - function = ((struct symbol *)PTR(callname))->function; - call_into_lisp(callname, function, args, 3); - } - - if (were_in_lisp) { - int context_index; - - /* Block all blockable signals */ - sigblock(BLOCKABLE); - - /* Going back into lisp. */ - foreign_function_call_active = 0; - - /* Undo dynamic binding. */ - /* ### Do I really need to unbind_to_here()? */ - unbind(); - - /* Put the dynamic space free pointer back into the context. */ - context->sc_regs[ALLOC] = - (unsigned long) current_dynamic_space_free_pointer; - - } + int were_in_lisp; + union interrupt_handler handler; + lispobj *args; + lispobj callname, function; + long mask; + + handler = interrupt_handlers[signal]; + were_in_lisp = !foreign_function_call_active; + + if (were_in_lisp) + fake_foreign_function_call(context); + + /* Allow signals again. */ + sigsetmask(context->sc_mask); + + if (LowtagOf(handler.lisp) == type_EvenFixnum || + LowtagOf(handler.lisp) == type_OddFixnum) + (*handler.c)(signal, code, context); + else { + args = current_control_stack_pointer; + current_control_stack_pointer += 3; + args[0] = fixnum(signal); + args[1] = fixnum(code); + args[2] = alloc_sap(context); + callname = handler.lisp; + if (LowtagOf(callname) == type_FunctionPointer) + function = callname; + else + function = ((struct symbol *)PTR(callname))->function; + call_into_lisp(callname, function, args, 3); + } + + if (were_in_lisp) + undo_fake_foreign_function_call(context); } static maybe_now_maybe_later(signal, code, context) @@ -165,22 +168,146 @@ struct sigcontext *context; handle_now(signal, code, context); } +static void skip_instruction(context) + struct sigcontext *context; +{ + /* Skip the offending instruction */ + if (context->sc_cause & CAUSE_BD) + emulate_branch(context, *(unsigned long *)context->sc_pc); + else + context->sc_pc += 4; +} + +#define call_maybe_gc() \ + call_into_lisp(MAYBE_GC, SymbolFunction(MAYBE_GC), \ + current_control_stack_pointer, 0) + static trap_handler(signal, code, context) int signal, code; struct sigcontext *context; { if (code == trap_PendingInterrupt) { - signal = pending_signal; - code = pending_code; - context->sc_mask = pending_mask; - pending_signal = 0; - pending_code = 0; - pending_mask = 0; + if (foreign_function_call_active) + crap_out("Oh no, got a PendingInterrupt while foreign function call was active.\n"); + + context->sc_regs[FLAGS] &= ~(1<<flag_Interrupted); SetSymbolValue(INTERRUPT_PENDING, NIL); + if (maybe_gc_pending) { + maybe_gc_pending = FALSE; + fake_foreign_function_call(context); + call_maybe_gc(); + undo_fake_foreign_function_call(context); + } + if (pending_signal) { + signal = pending_signal; + code = pending_code; + context->sc_mask = pending_mask; + pending_signal = 0; + pending_code = 0; + pending_mask = 0; + handle_now(signal, code, context); + } + skip_instruction(context); } - handle_now(signal, code, context); + else + handle_now(signal, code, context); } +#ifdef mips +static sigfpe_handler(signal, code, context) +int signal, code; +struct sigcontext *context; +{ + unsigned long bad_inst; + unsigned int op, rs, rt, rd, funct, dest; + int immed; + long result; + + if (context->sc_cause & CAUSE_BD) + bad_inst = *(unsigned long *)(context->sc_pc + 4); + else + bad_inst = *(unsigned long *)(context->sc_pc); + + op = (bad_inst >> 26) & 0x3f; + rs = (bad_inst >> 21) & 0x1f; + rt = (bad_inst >> 16) & 0x1f; + rd = (bad_inst >> 11) & 0x1f; + funct = bad_inst & 0x3f; + immed = (((int)(bad_inst & 0xffff)) << 16) >> 16; + +#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2) + + switch (op) { + case 0x0: /* SPECIAL */ + switch (funct) { + case 0x20: /* ADD */ + result = FIXNUM_VALUE(context->sc_regs[rs]) + FIXNUM_VALUE(context->sc_regs[rt]); + dest = rd; + break; + + case 0x22: /* SUB */ + result = FIXNUM_VALUE(context->sc_regs[rs]) - FIXNUM_VALUE(context->sc_regs[rt]); + dest = rd; + break; + + default: + dest = 32; + break; + } + break; + + case 0x8: /* ADDI */ + result = FIXNUM_VALUE(context->sc_regs[rs]) + (immed>>2); + dest = rt; + break; + + default: + dest = 32; + break; + } + + if (dest < 32) { + set_global_pointer(saved_global_pointer); + + context->sc_regs[dest] = alloc_number(result); + + skip_instruction(context); + + } + else + handle_now(signal, code, context); +} +#undef FIXNUM_VALUE + + +static sigbus_handler(signal, code, context) +int signal, code; +struct sigcontext *context; +{ + lispobj *badaddr; + + badaddr = (lispobj *)context->sc_badvaddr; + + if (!foreign_function_call_active && badaddr >= current_dynamic_space && badaddr < current_dynamic_space + DYNAMIC_SPACE_SIZE) { + set_global_pointer(saved_global_pointer); + clear_auto_gc_trigger(); + + if (context->sc_regs[FLAGS] & (1<<flag_Atomic)) { + maybe_gc_pending = TRUE; + context->sc_mask |= BLOCKABLE; + context->sc_regs[FLAGS] |= (1<<flag_Interrupted); + } + else { + fake_foreign_function_call(context); + call_maybe_gc(); + undo_fake_foreign_function_call(context); + } + } + else + handle_now(signal, code, context); +} +#endif + unsigned long install_handler(signal, handler) int signal; union interrupt_handler handler; @@ -191,6 +318,12 @@ union interrupt_handler handler; if (signal == SIGTRAP) sv.sv_handler = trap_handler; +#ifdef mips + else if (signal == SIGFPE) + sv.sv_handler = sigfpe_handler; + else if (signal == SIGBUS) + sv.sv_handler = sigbus_handler; +#endif else if (handler.c == SIG_DFL || handler.c == SIG_IGN) sv.sv_handler = handler.c; else if (sigmask(signal)&BLOCKABLE) @@ -218,4 +351,3 @@ interrupt_init() for (i = 0; i < NSIG; i++) interrupt_handlers[i].c = SIG_DFL; } - diff --git a/ldb/test.c b/ldb/test.c index a9f066f493481467a2c3934a7ad424a903f86e06..cfd61a42760ae3c00f006f4f0d53ee6af7c25a13 100644 --- a/ldb/test.c +++ b/ldb/test.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/test.c,v 1.8 1990/09/08 10:59:34 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/test.c,v 1.9 1990/10/13 04:50:03 wlott Exp $ */ /* Extra random routines for testing stuff. */ #include <signal.h> @@ -160,104 +160,10 @@ struct sigcontext *context; -#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2) - -#ifdef mips -static sigfpe_handler(signal, code, context) -int signal, code; -struct sigcontext *context; -{ - unsigned long bad_inst; - unsigned int op, rs, rt, rd, funct, dest; - int immed; - long result; - - if (context->sc_cause & CAUSE_BD) - bad_inst = *(unsigned long *)(context->sc_pc + 4); - else - bad_inst = *(unsigned long *)(context->sc_pc); - - op = (bad_inst >> 26) & 0x3f; - rs = (bad_inst >> 21) & 0x1f; - rt = (bad_inst >> 16) & 0x1f; - rd = (bad_inst >> 11) & 0x1f; - funct = bad_inst & 0x3f; - immed = (((int)(bad_inst & 0xffff)) << 16) >> 16; - - switch (op) { - case 0x0: /* SPECIAL */ - switch (funct) { - case 0x20: /* ADD */ - result = FIXNUM_VALUE(context->sc_regs[rs]) + FIXNUM_VALUE(context->sc_regs[rt]); - dest = rd; - break; - - case 0x22: /* SUB */ - result = FIXNUM_VALUE(context->sc_regs[rs]) - FIXNUM_VALUE(context->sc_regs[rt]); - dest = rd; - break; - - default: - signal_handler(signal, code, context); - return; - } - break; - - case 0x8: /* ADDI */ - result = FIXNUM_VALUE(context->sc_regs[rs]) + (immed>>2); - dest = rt; - break; - - default: - signal_handler(signal, code, context); - return; - } - - context->sc_regs[dest] = alloc_number(result); - - /* Skip the offending instruction */ - if (context->sc_cause & CAUSE_BD) - emulate_branch(context, *(unsigned long *)context->sc_pc); - else - context->sc_pc += 4; -} -#endif - - - -static sigsegv_handler(signal, code, context) -int signal, code; -struct sigcontext *context; -{ -#if 0 - if (bogus_page == guard_page) { - unprotext(guard_page); - if ((!foreign_function_call_active) && - (context->sc_regs[FLAGS] & (1<<flag_Atomic))) { - pending_signal = signal; - pending_code = code; - pending_mask = context->sc_mask; - context->sc_mask |= BLOCKABLE; - context->sc_regs[FLAGS] |= (1<<flag_Interrupted); - } - /* ### Fix this */ - SetSymbolValue(GC_TRIGGER_HIT, T); - } - else -#endif -} - - - test_init() { - extern int throw_to_monitor(); - install_handler(SIGINT, signal_handler); install_handler(SIGTRAP, signal_handler); -#ifdef mips - install_handler(SIGFPE, sigfpe_handler); -#endif }