diff --git a/ldb/backtrace.c b/ldb/backtrace.c index d454b61e8471ecfdc6bbe71836872a55d784e6dc..5402e29880e6ce6e2caa1b35042fc9ca8935250e 100644 --- a/ldb/backtrace.c +++ b/ldb/backtrace.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/backtrace.c,v 1.3 1990/04/27 01:55:15 wlott Exp $ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/backtrace.c,v 1.4 1990/05/24 17:46:03 wlott Exp $ * * Simple backtrace facility. More or less from Rob's lisp version. */ @@ -22,6 +22,7 @@ struct call_frame { struct call_info { struct call_frame *frame; + int interrupted; struct code *code; lispobj lra; int pc; /* Note: this is the trace file offset, not the actual pc. */ @@ -33,53 +34,30 @@ static struct code * code_pointer(object) lispobj object; { - lispobj *headerp, header; - int type, len; - - headerp = (lispobj *) PTR(object); - header = *headerp; - type = TypeOf(header); - - switch (type) { - case type_CodeHeader: - break; - case type_ReturnPcHeader: - case type_FunctionHeader: - case type_ClosureFunctionHeader: - len = HEADER_LENGTH(header); - if (len == 0) - headerp = NULL; - else - headerp -= len; - break; - default: - headerp = NULL; - } - - return (struct code *) headerp; -} - -static -struct call_frame * -current_cont() -{ - int free; + lispobj *headerp, header; + int type, len; + + headerp = (lispobj *) PTR(object); + header = *headerp; + type = TypeOf(header); + + switch (type) { + case type_CodeHeader: + break; + case type_ReturnPcHeader: + case type_FunctionHeader: + case type_ClosureFunctionHeader: + len = HEADER_LENGTH(header); + if (len == 0) + headerp = NULL; + else + headerp -= len; + break; + default: + headerp = NULL; + } - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; - - if (free == 0) - return NULL; - else { - struct sigcontext *csp; - struct call_frame *cont; - - csp = lisp_interrupt_contexts[free-1]; - cont = (struct call_frame *)csp->sc_regs[CONT]; - if ((lispobj *)cont == current_control_stack_pointer) - /* We were attempting to call an undefined function. */ - ; - return cont; - } + return (struct code *) headerp; } static @@ -90,6 +68,19 @@ struct call_frame *pointer; ((char *) pointer < (char *) current_control_stack_pointer)); } +static void +info_from_lisp_state(info) +struct call_info *info; +{ + info->frame = (struct call_frame *)current_control_frame_pointer; + info->interrupted = 0; + info->code = NULL; + info->lra = 0; + info->pc = 0; + + previous_info(info); +} + static void info_from_sigcontext(info, csp) struct call_info *info; @@ -97,8 +88,8 @@ struct sigcontext *csp; { unsigned long pc; - if (csp->sc_regs[CONT] == csp->sc_regs[CSP]) { - /* We were attempting to call an undefined function. */ + if (LowtagOf(csp->sc_regs[CODE]) == type_FunctionPointer) { + /* We tried to call a function, but crapped out before $CODE could be fixed up. Probably an undefined function. */ info->frame = (struct call_frame *)csp->sc_regs[OLDCONT]; info->lra = (lispobj)csp->sc_regs[LRA]; info->code = code_pointer(info->lra); @@ -111,7 +102,7 @@ struct sigcontext *csp; pc = csp->sc_pc; } if (info->code != NULL) - info->pc = (pc - (unsigned long) info->code) / sizeof(lispobj) - HEADER_LENGTH(info->code->header); + info->pc = pc - (unsigned long) info->code - HEADER_LENGTH(info->code->header); else info->pc = 0; } @@ -120,23 +111,41 @@ static int previous_info(info) struct call_info *info; { + struct call_frame *this_frame; + int free; + struct sigcontext *csp; + if (!cs_valid_pointer_p(info->frame)) { printf("Bogus callee value (0x%08x).\n", (unsigned long)info->frame); return 0; } - info->lra = info->frame->saved_lra; - info->frame = info->frame->old_cont; + this_frame = info->frame; + info->lra = this_frame->saved_lra; + info->frame = this_frame->old_cont; - if (info->frame == NULL) + if (info->frame == NULL || info->frame == this_frame) return 0; info->code = code_pointer(info->lra); - if (info->code != NULL) + + if (info->code == (struct code *)PTR(info->lra)) { + /* We were interrupted. Find the correct sigcontext. */ + free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; + while (free-- > 0) { + csp = lisp_interrupt_contexts[free]; + if ((struct call_frame *)(csp->sc_regs[CONT]) == info->frame) + info_from_sigcontext(info, csp); + } + info->interrupted = 1; + } + else if (info->code != NULL) info->pc = ((unsigned long)PTR(info->lra) - (unsigned long) info->code) / sizeof(lispobj) - HEADER_LENGTH(info->code->header); else info->pc = 0; + + return 1; } @@ -145,25 +154,18 @@ backtrace(nframes) int nframes; { struct call_info info; - int free; - - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; - if (free == 0) { - printf("Nothing to backtrace.\n"); - return; - } - - info_from_sigcontext(&info, lisp_interrupt_contexts[free-1]); + info_from_lisp_state(&info); do { - printf("<Frame 0x%08x, CODE: 0x%08x, ", - (unsigned long) info.frame, - (unsigned long) info.code); - + printf("<Frame 0x%08x%s, ", (unsigned long) info.frame, + info.interrupted ? " [interrupted]" : ""); + if (info.code != (struct code *) 0) { lispobj function; + printf("CODE: 0x%08x, ", (unsigned long) info.code | type_OtherPointer); + function = info.code->entry_points; while (function != NIL) { struct function_header *header; @@ -197,13 +199,18 @@ int nframes; function = header->next; } } + else + printf("CODE: ???, "); if (info.lra != 0) printf("LRA: 0x%08x, ", (unsigned long)info.lra); else printf("<no LRA>, "); - printf("PC: %d>\n", info.pc); + if (info.pc) + printf("PC: 0x%x>\n", info.pc); + else + printf("PC: ???>\n"); } while (--nframes > 0 && previous_info(&info)); } diff --git a/ldb/globals.c b/ldb/globals.c index 6fb398860182ee317e6b821583146e78f2af9d2d..9863b3393faf40d53e9ee4b709bf13b347a49a78 100644 --- a/ldb/globals.c +++ b/ldb/globals.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.c,v 1.1 1990/03/28 22:47:26 ch Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.c,v 1.2 1990/05/24 17:46:05 wlott Exp $ */ /* Variables everybody needs to look at or frob on. */ @@ -10,6 +10,7 @@ int foreign_function_call_active; unsigned long saved_global_pointer; lispobj *current_control_stack_pointer; +lispobj *current_control_frame_pointer; lispobj *current_binding_stack_pointer; unsigned long current_flags_register; @@ -36,6 +37,7 @@ globals_init() /* Initialize the current lisp state. */ current_control_stack_pointer = control_stack; + current_control_frame_pointer = (lispobj *)0; current_binding_stack_pointer = binding_stack; current_flags_register = 1<<flag_Atomic; } diff --git a/ldb/globals.h b/ldb/globals.h index 68d838f64168950225b9b887713a36924405be88..2f08a3681b659be5682ff39564fdf2d790f4c891 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.1 1990/03/28 22:47:35 ch Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.h,v 1.2 1990/05/24 17:46:07 wlott Exp $ */ #if !defined(_INCLUDE_GLOBALS_H_) #define _INCLUDED_GLOBALS_H_ @@ -12,6 +12,7 @@ extern int foreign_function_call_active; extern unsigned long saved_global_pointer; extern lispobj *current_control_stack_pointer; +extern lispobj *current_control_frame_pointer; extern lispobj *current_binding_stack_pointer; extern unsigned long current_flags_register; @@ -33,6 +34,7 @@ extern lispobj *current_dynamic_space_free_pointer; .extern current_dynamic_space_free_pointer 4 .extern current_control_stack_pointer 4 +.extern current_control_frame_pointer 4 .extern current_binding_stack_pointer 4 .extern current_flags_register 4 diff --git a/ldb/interrupt.c b/ldb/interrupt.c index f9e830cde8ee0ec47f48bbf35ce6c265ce85a8b1..3e43ba52c2d0c64d828cf6949a29cf5035b76b2d 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.3 1990/03/29 21:19:34 ch Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/interrupt.c,v 1.4 1990/05/24 17:46:09 wlott Exp $ */ /* Interrupt handing magic. */ @@ -24,7 +24,7 @@ struct sigcontext *context; { int were_in_lisp; union interrupt_handler handler; - lispobj args[6]; /* Six is the minimum */ + lispobj *args; lispobj callname, function; handler = interrupt_handlers[signal]; @@ -36,12 +36,20 @@ struct sigcontext *context; /* Get current LISP state from context */ current_dynamic_space_free_pointer = (lispobj *) context->sc_regs[ALLOC]; - current_control_stack_pointer = - (lispobj *) context->sc_regs[CSP]; 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]; + current_control_stack_pointer = + current_control_frame_pointer + 8; + current_control_frame_pointer[0] = + context->sc_regs[CONT]; + current_control_frame_pointer[1] = + context->sc_regs[CODE]; + /* Restore the GP */ set_global_pointer(saved_global_pointer); @@ -68,6 +76,8 @@ struct sigcontext *context; 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); @@ -152,18 +162,71 @@ struct sigcontext *context; handle_now(signal, code, context); } -static fpe_handler(signal, code, context) -int signal, code; +#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2) + +static boolean handle_integer_overflow(context) struct sigcontext *context; { - switch (signal) { - case EXC_OV: - /* integer overflow. Make a bignum. */ - /* For now, drop through. */ + 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 >> 15) & 0x1f; + rd = (bad_inst >> 10) & 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: + return FALSE; + } + + case 0x8: /* ADDI */ + result = FIXNUM_VALUE(context->sc_regs[rs]) + (immed>>2); + dest = rt; + break; default: - handle_now(signal, code, context); - } + return FALSE; + } + + 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; + + return TRUE; +} + +static fpe_handler(signal, code, context) +int signal, code; +struct sigcontext *context; +{ + if ((context->sc_cause & CAUSE_EXCMASK) != EXC_OV || !handle_integer_overflow(context)) + handle_now(signal, code, context); } void install_handler(signal, handler) diff --git a/ldb/mips-assem.s b/ldb/mips-assem.s index ce641e61ea9040f5b344b37d7864c9bc58c2da73..89569d389c935744b91e3f3c9c175c5f4f755c54 100644 --- a/ldb/mips-assem.s +++ b/ldb/mips-assem.s @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/mips-assem.s,v 1.4 1990/04/02 23:50:26 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/mips-assem.s,v 1.5 1990/05/24 17:44:00 wlott Exp $ */ #include <machine/regdef.h> #include "lisp.h" @@ -84,6 +84,7 @@ call_into_lisp: lw ALLOC, current_dynamic_space_free_pointer lw BSP, current_binding_stack_pointer lw CSP, current_control_stack_pointer + lw OLDCONT, current_control_frame_pointer /* Check for interrupt */ and FLAGS, (0xffff^(1<<flag_Atomic)) @@ -100,22 +101,18 @@ call_into_lisp: /* Pass in args */ move CNAME, $4 move LEXENV, $5 - move ARGS, $6 + move CONT, $6 sll NARGS, $7, 2 - lw A0, 0(ARGS) - lw A1, 4(ARGS) - lw A2, 8(ARGS) - lw A3, 12(ARGS) - lw A4, 16(ARGS) - lw A5, 20(ARGS) + lw A0, 0(CONT) + lw A1, 4(CONT) + lw A2, 8(CONT) + lw A3, 12(CONT) + lw A4, 16(CONT) + lw A5, 20(CONT) /* Calculate LRA */ la LRA, lra + type_OtherPointer - /* Establish context pointers */ - move OLDCONT, $0 /* C doesn't have a context ptr */ - move CONT, CSP - /* Indirect closure */ lw CODE, 4-1(LEXENV) @@ -130,7 +127,7 @@ lra: .word type_ReturnPcHeader /* Multiple value return spot, clear stack */ - move CSP, ARGS + move CSP, OLDCONT nop /* Pass one return value back to C land. */ @@ -143,6 +140,7 @@ lra: sw ALLOC, current_dynamic_space_free_pointer sw BSP, current_binding_stack_pointer sw CSP, current_control_stack_pointer + sw CONT, current_control_frame_pointer sw FLAGS, current_flags_register /* Back in foreign function call */ @@ -189,16 +187,24 @@ lra: .globl call_into_c .ent call_into_c call_into_c: - .set noreorder + /* Set up a stack frame. */ + move OLDCONT, CONT + move CONT, CSP + addu CSP, CONT, 32 + sw OLDCONT, 0(CONT) + sw LRA, 4(CONT) + /* Note: the C stack is already set up. */ - + /* Set the pseudo-atomic flag. */ + .set noreorder or FLAGS, (1<<flag_Atomic) /* Save lisp state. */ sw ALLOC, current_dynamic_space_free_pointer sw BSP, current_binding_stack_pointer sw CSP, current_control_stack_pointer + sw CONT, current_control_frame_pointer sw FLAGS, current_flags_register /* Mark us as in C land. */ @@ -252,7 +258,6 @@ call_into_c: /* Restore other lisp state. */ lw ALLOC, current_dynamic_space_free_pointer lw BSP, current_binding_stack_pointer - lw CSP, current_control_stack_pointer /* Check for interrupt */ and FLAGS, (0xffff^(1<<flag_Atomic)) @@ -266,6 +271,11 @@ call_into_c: .set reorder + /* Reset the lisp stack. */ + /* Note: OLDCONT and CONT are in saved regs. */ + move CSP, CONT + move CONT, OLDCONT + /* Return to LISP. */ addu a0, LRA, 4-type_OtherPointer j a0 diff --git a/ldb/monitor.c b/ldb/monitor.c index 90d92e34581e32174b73bf932994cf8f8471d1f3..eba74d6d2f1924395cc89dc1d0a36466e5b410bc 100644 --- a/ldb/monitor.c +++ b/ldb/monitor.c @@ -120,6 +120,7 @@ char **ptr; printf("DYNAMIC\t=\t0x%08x\n", current_dynamic_space); printf("ALLOC\t=\t0x%08x\n", current_dynamic_space_free_pointer); printf("CSP\t=\t0x%08x\n", current_control_stack_pointer); + printf("FP\t=\t0x%08x\n", current_control_frame_pointer); printf("BSP\t=\t0x%08x\n", current_binding_stack_pointer); printf("FLAGS\t=\t0x%08x\n", current_flags_register); } @@ -188,11 +189,10 @@ char **ptr; { extern lispobj call_into_lisp(); - static lispobj args[16]; int start_level = level; lispobj call_name = parse_lispobj(ptr); - lispobj function, result, arg, *argptr; + lispobj function, result, arg, *args; int numargs; if (LowtagOf(call_name) == type_OtherPointer) { @@ -218,13 +218,12 @@ char **ptr; function = call_name; numargs = 0; - argptr = args; + args = current_control_stack_pointer; while (more_p(ptr)) { - *argptr++ = parse_lispobj(ptr); + current_control_stack_pointer++; + current_control_stack_pointer[-1] = parse_lispobj(ptr); numargs++; } - while (argptr < args + 6) - *argptr++ = NIL; result = call_into_lisp(call_name, function, args, numargs); @@ -421,8 +420,8 @@ char **ptr; backtrace(n); } -static void sub_monitor(csp, bsp) -lispobj *csp, *bsp; +static void sub_monitor(csp, fp, bsp) +lispobj *csp, *fp, *bsp; { extern char *egets(); struct cmd *cmd, *found; @@ -435,6 +434,10 @@ lispobj *csp, *bsp; printf("CSP changed from 0x%x to 0x%x; Restoring.\n", csp, new); current_control_stack_pointer = csp; } + if ((new = current_control_frame_pointer) != fp) { + printf("FP changed from 0x%x to 0x%x; Restoring.\n", fp, new); + current_control_frame_pointer = csp; + } if ((new = current_binding_stack_pointer) != bsp) { printf("BSP changed from 0x%x to 0x%x; Restoring.\n", bsp, new); current_binding_stack_pointer = bsp; @@ -479,9 +482,10 @@ lispobj *csp, *bsp; void monitor() { jmp_buf oldbuf; - lispobj *csp, *bsp; + lispobj *csp, *fp, *bsp; csp = current_control_stack_pointer; + fp = current_control_frame_pointer; bsp = current_binding_stack_pointer; bcopy(curbuf, oldbuf, sizeof(oldbuf)); @@ -496,7 +500,7 @@ void monitor() setjmp(curbuf); - sub_monitor(csp, bsp); + sub_monitor(csp, fp, bsp); done = FALSE;