diff options
Diffstat (limited to 'lisp/debugger.c')
| -rw-r--r-- | lisp/debugger.c | 828 |
1 files changed, 828 insertions, 0 deletions
diff --git a/lisp/debugger.c b/lisp/debugger.c new file mode 100644 index 0000000..4716699 --- /dev/null +++ b/lisp/debugger.c @@ -0,0 +1,828 @@ +/* + * Copyright (c) 2001 by The XFree86 Project, Inc. + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, + * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF + * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + * SOFTWARE. + * + * Except as contained in this notice, the name of the XFree86 Project shall + * not be used in advertising or otherwise to promote the sale, use or other + * dealings in this Software without prior written authorization from the + * XFree86 Project. + * + * Author: Paulo César Pereira de Andrade + */ + +/* $XFree86: xc/programs/xedit/lisp/debugger.c,v 1.24 2002/11/12 06:05:07 paulo Exp $ */ + +#include <ctype.h> +#include "io.h" +#include "debugger.h" +#include "write.h" + +#ifdef DEBUGGER +#define DebuggerHelp 0 +#define DebuggerAbort 1 +#define DebuggerBacktrace 2 +#define DebuggerContinue 3 +#define DebuggerFinish 4 +#define DebuggerFrame 5 +#define DebuggerNext 6 +#define DebuggerPrint 7 +#define DebuggerStep 8 +#define DebuggerBreak 9 +#define DebuggerDelete 10 +#define DebuggerDown 11 +#define DebuggerUp 12 +#define DebuggerInfo 13 +#define DebuggerWatch 14 + +#define DebuggerInfoBreakpoints 0 +#define DebuggerInfoBacktrace 1 + +/* + * Prototypes + */ +static char *format_integer(int); +static void LispDebuggerCommand(LispObj *obj); + +/* + * Initialization + */ +static struct { + char *name; + int action; +} commands[] = { + {"help", DebuggerHelp}, + {"abort", DebuggerAbort}, + {"backtrace", DebuggerBacktrace}, + {"b", DebuggerBreak}, + {"break", DebuggerBreak}, + {"bt", DebuggerBacktrace}, + {"continue", DebuggerContinue}, + {"d", DebuggerDelete}, + {"delete", DebuggerDelete}, + {"down", DebuggerDown}, + {"finish", DebuggerFinish}, + {"frame", DebuggerFrame}, + {"info", DebuggerInfo}, + {"n", DebuggerNext}, + {"next", DebuggerNext}, + {"print", DebuggerPrint}, + {"run", DebuggerContinue}, + {"s", DebuggerStep}, + {"step", DebuggerStep}, + {"up", DebuggerUp}, + {"watch", DebuggerWatch}, +}; + +static struct { + char *name; + int subaction; +} info_commands[] = { + {"breakpoints", DebuggerInfoBreakpoints}, + {"stack", DebuggerInfoBacktrace}, + {"watchpoints", DebuggerInfoBreakpoints}, +}; + +static char debugger_help[] = +"Available commands are:\n\ +\n\ +help - This message.\n\ +abort - Abort the current execution, and return to toplevel.\n\ +backtrace, bt - Print backtrace.\n\ +b, break - Set breakpoint at function name argument.\n\ +continue - Continue execution.\n\ +d, delete - Delete breakpoint(s), all breakpoint if no arguments given.\n\ +down - Set environment to frame called by the current one.\n\ +finish - Executes until current form is finished.\n\ +frame - Set environment to selected frame.\n\ +info - Prints information about the debugger state.\n\ +n, next - Evaluate next form.\n\ +print - Print value of variable name argument.\n\ +run - Continue execution.\n\ +s, step - Evaluate next form, stopping on any subforms.\n\ +up - Set environment to frame that called the current one.\n\ +\n\ +Commands may be abbreviated.\n"; + +static char debugger_info_help[] = +"Available subcommands are:\n\ +\n\ +breakpoints - List and prints status of breakpoints, and watchpoints.\n\ +stack - Backtrace of stack.\n\ +watchpoints - List and prints status of watchpoints, and breakpoints.\n\ +\n\ +Subcommands may be abbreviated.\n"; + +/* Debugger variables layout (if you change it, update description): + * + * DBG + * is a macro for lisp__data.dbglist + * is a NIL terminated list + * every element is a list in the format (NOT NIL terminated): + * (list* NAM ARG ENV HED LEX) + * where + * NAM is an ATOM for the function/macro name + * or NIL for lambda expressions + * ARG is NAM arguments (a LIST) + * ENV is the value of lisp__data.stack.base (a FIXNUM) + * LEN is the value of lisp__data.env.length (a FIXNUM) + * LEX is the value of lisp__data.env.lex (a FIXNUM) + * new elements are added to the beggining of the DBG list + * + * BRK + * is macro for lisp__data.brklist + * is a NIL terminated list + * every element is a list in the format (NIL terminated): + * (list NAM IDX TYP HIT VAR VAL FRM) + * where + * NAM is an ATOM for the name of the object at + * wich the breakpoint was added + * IDX is a FIXNUM, the breakpoint number + * must be stored, as breakpoints may be deleted + * TYP is a FIXNUM that must be an integer of enum LispBreakType + * HIT is a FIXNUM, with the number of times this breakpoint was + * hitted. + * VAR variable to watch a SYMBOL (not needed for breakpoints) + * VAL value of watched variable (not needed for breakpoints) + * FRM frame where variable started being watched + * (not needed for breakpoints) + * new elements are added to the end of the list + */ + +/* + * Implementation + */ +void +LispDebugger(LispDebugCall call, LispObj *name, LispObj *arg) +{ + int force = 0; + LispObj *obj, *prev; + + switch (call) { + case LispDebugCallBegin: + ++lisp__data.debug_level; + GCDisable(); + DBG = CONS(CONS(name, CONS(arg, CONS(FIXNUM(lisp__data.stack.base), + CONS(FIXNUM(lisp__data.env.length), + FIXNUM(lisp__data.env.lex))))), DBG); + GCEnable(); + for (obj = BRK; obj != NIL; obj = CDR(obj)) + if (ATOMID(CAR(CAR(obj))) == ATOMID(name) && + FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj))))) == + LispDebugBreakFunction) + break; + if (obj != NIL) { + long counter; + + /* if not at a fresh line */ + if (LispGetColumn(NIL)) + LispFputc(Stdout, '\n'); + LispFputs(Stdout, "BREAK #"); + LispWriteObject(NIL, CAR(CDR(CAR(obj)))); + LispFputs(Stdout, "> ("); + LispWriteObject(NIL, CAR(CAR(DBG))); + LispFputc(Stdout, ' '); + LispWriteObject(NIL, CAR(CDR(CAR(DBG)))); + LispFputs(Stdout, ")\n"); + force = 1; + /* update hits counter */ + counter = FIXNUM_VALUE(CAR(CDR(CDR(CDR(CAR(obj)))))); + CAR(CDR(CDR(CDR(CAR(obj))))) FIXNUM(counter + 1); + } + break; + case LispDebugCallEnd: + DBG = CDR(DBG); + if (lisp__data.debug_level < lisp__data.debug_step) + lisp__data.debug_step = lisp__data.debug_level; + --lisp__data.debug_level; + break; + case LispDebugCallFatal: + LispDebuggerCommand(NIL); + return; + case LispDebugCallWatch: + break; + } + + /* didn't return, check watchpoints */ + if (call == LispDebugCallEnd || call == LispDebugCallWatch) { +watch_again: + for (prev = obj = BRK; obj != NIL; prev = obj, obj = CDR(obj)) { + if (FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj))))) == + LispDebugBreakVariable) { + /* the variable */ + LispObj *wat = CAR(CDR(CDR(CDR(CDR(CAR(obj)))))); + void *sym = LispGetVarAddr(CAAR(obj)); + LispObj *frm = CAR(CDR(CDR(CDR(CDR(CDR(CDR(CAR(obj)))))))); + + if ((sym == NULL && lisp__data.debug_level <= 0) || + (sym != wat->data.opaque.data && + FIXNUM_VALUE(frm) > lisp__data.debug_level)) { + LispFputs(Stdout, "WATCH #"); + LispFputs(Stdout, format_integer(FIXNUM_VALUE(CAR(CDR(CAR(obj)))))); + LispFputs(Stdout, "> "); + LispFputs(Stdout, STRPTR(CAR(CAR(obj)))); + LispFputs(Stdout, " deleted. Variable does not exist anymore.\n"); + /* force debugger to stop */ + force = 1; + if (obj == prev) { + BRK = CDR(BRK); + goto watch_again; + } + else + RPLACD(prev, CDR(obj)); + obj = prev; + } + else { + /* current value */ + LispObj *cur = *(LispObj**)wat->data.opaque.data; + /* last value */ + LispObj *val = CAR(CDR(CDR(CDR(CDR(CDR(CAR(obj))))))); + if (XEQUAL(val, cur) == NIL) { + long counter; + + LispFputs(Stdout, "WATCH #"); + LispFputs(Stdout, format_integer(FIXNUM_VALUE(CAR(CDR(CAR(obj)))))); + LispFputs(Stdout, "> "); + LispFputs(Stdout, STRPTR(CAR(CAR(obj)))); + LispFputc(Stdout, '\n'); + + LispFputs(Stdout, "OLD: "); + LispWriteObject(NIL, val); + + LispFputs(Stdout, "\nNEW: "); + LispWriteObject(NIL, cur); + LispFputc(Stdout, '\n'); + + /* update current value */ + CAR(CDR(CDR(CDR(CDR(CDR(CAR(obj))))))) = cur; + /* update hits counter */ + counter = FIXNUM_VALUE(CAR(CDR(CDR(CDR(CAR(obj)))))); + CAR(CDR(CDR(CDR(CAR(obj))))) = FIXNUM(counter + 1); + /* force debugger to stop */ + force = 1; + } + } + } + } + + if (call == LispDebugCallWatch) + /* special call, just don't keep gc protected variables that may be + * using a lot of memory... */ + return; + } + + switch (lisp__data.debug) { + case LispDebugUnspec: + LispDebuggerCommand(NIL); + goto debugger_done; + case LispDebugRun: + if (force) + LispDebuggerCommand(NIL); + goto debugger_done; + case LispDebugFinish: + if (!force && + (call != LispDebugCallEnd || + lisp__data.debug_level != lisp__data.debug_step)) + goto debugger_done; + break; + case LispDebugNext: + if (call == LispDebugCallBegin) { + if (!force && lisp__data.debug_level != lisp__data.debug_step) + goto debugger_done; + } + else if (call == LispDebugCallEnd) { + if (!force && lisp__data.debug_level >= lisp__data.debug_step) + goto debugger_done; + } + break; + case LispDebugStep: + break; + } + + if (call == LispDebugCallBegin) { + LispFputc(Stdout, '#'); + LispFputs(Stdout, format_integer(lisp__data.debug_level)); + LispFputs(Stdout, "> ("); + LispWriteObject(NIL, CAR(CAR(DBG))); + LispFputc(Stdout, ' '); + LispWriteObject(NIL, CAR(CDR(CAR(DBG)))); + LispFputs(Stdout, ")\n"); + LispDebuggerCommand(NIL); + } + else if (call == LispDebugCallEnd) { + LispFputc(Stdout, '#'); + LispFputs(Stdout, format_integer(lisp__data.debug_level + 1)); + LispFputs(Stdout, "= "); + LispWriteObject(NIL, arg); + LispFputc(Stdout, '\n'); + LispDebuggerCommand(NIL); + } + else if (force) + LispDebuggerCommand(arg); + +debugger_done: + return; +} + +static void +LispDebuggerCommand(LispObj *args) +{ + LispObj *obj, *frm, *curframe; + int i = 0, frame, matches, action = -1, subaction = 0; + char *cmd, *arg, *ptr, line[256]; + + int envbase = lisp__data.stack.base, + envlen = lisp__data.env.length, + envlex = lisp__data.env.lex; + + frame = lisp__data.debug_level; + curframe = CAR(DBG); + + line[0] = '\0'; + arg = line; + for (;;) { + LispFputs(Stdout, DBGPROMPT); + LispFflush(Stdout); + if (LispFgets(Stdin, line, sizeof(line)) == NULL) { + LispFputc(Stdout, '\n'); + return; + } + /* get command */ + ptr = line; + while (*ptr && isspace(*ptr)) + ++ptr; + cmd = ptr; + while (*ptr && !isspace(*ptr)) + ++ptr; + if (*ptr) + *ptr++ = '\0'; + + if (*cmd) { /* if *cmd is nul, then arg may be still set */ + /* get argument(s) */ + while (*ptr && isspace(*ptr)) + ++ptr; + arg = ptr; + /* goto end of line */ + if (*ptr) { + while (*ptr) + ++ptr; + --ptr; + while (*ptr && isspace(*ptr)) + --ptr; + if (*ptr) + *++ptr = '\0'; + } + } + + if (*cmd == '\0') { + if (action < 0) { + if (lisp__data.debug == LispDebugFinish) + action = DebuggerFinish; + else if (lisp__data.debug == LispDebugNext) + action = DebuggerNext; + else if (lisp__data.debug == LispDebugStep) + action = DebuggerStep; + else if (lisp__data.debug == LispDebugRun) + action = DebuggerContinue; + else + continue; + } + } + else { + for (i = matches = 0; i < sizeof(commands) / sizeof(commands[0]); + i++) { + char *str = commands[i].name; + + ptr = cmd; + while (*ptr && *ptr == *str) { + ++ptr; + ++str; + } + if (*ptr == '\0') { + action = commands[i].action; + if (*str == '\0') { + matches = 1; + break; + } + ++matches; + } + } + if (matches == 0) { + LispFputs(Stdout, "* Command unknown: "); + LispFputs(Stdout, cmd); + LispFputs(Stdout, ". Type help for help.\n"); + continue; + } + else if (matches > 1) { + LispFputs(Stdout, "* Command is ambiguous: "); + LispFputs(Stdout, cmd); + LispFputs(Stdout, ". Type help for help.\n"); + continue; + } + } + + switch (action) { + case DebuggerHelp: + LispFputs(Stdout, debugger_help); + break; + case DebuggerInfo: + if (*arg == '\0') { + LispFputs(Stdout, debugger_info_help); + break; + } + + for (i = matches = 0; + i < sizeof(info_commands) / sizeof(info_commands[0]); + i++) { + char *str = info_commands[i].name; + + ptr = arg; + while (*ptr && *ptr == *str) { + ++ptr; + ++str; + } + if (*ptr == '\0') { + subaction = info_commands[i].subaction; + if (*str == '\0') { + matches = 1; + break; + } + ++matches; + } + } + if (matches == 0) { + LispFputs(Stdout, "* Command unknown: "); + LispFputs(Stdout, arg); + LispFputs(Stdout, ". Type info for help.\n"); + continue; + } + else if (matches > 1) { + LispFputs(Stdout, "* Command is ambiguous: "); + LispFputs(Stdout, arg); + LispFputs(Stdout, ". Type info for help.\n"); + continue; + } + + switch (subaction) { + case DebuggerInfoBreakpoints: + LispFputs(Stdout, "Num\tHits\tType\t\tWhat\n"); + for (obj = BRK; obj != NIL; obj = CDR(obj)) { + /* breakpoint number */ + LispFputc(Stdout, '#'); + LispWriteObject(NIL, CAR(CDR(CAR(obj)))); + + /* number of hits */ + LispFputc(Stdout, '\t'); + LispWriteObject(NIL, CAR(CDR(CDR(CDR(CAR(obj)))))); + + /* breakpoint type */ + LispFputc(Stdout, '\t'); + switch ((int)FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj)))))) { + case LispDebugBreakFunction: + LispFputs(Stdout, "Function"); + break; + case LispDebugBreakVariable: + LispFputs(Stdout, "Variable"); + break; + } + + /* breakpoint object */ + LispFputc(Stdout, '\t'); + LispWriteObject(NIL, CAR(CAR(obj))); + LispFputc(Stdout, '\n'); + } + break; + case DebuggerInfoBacktrace: + goto debugger_print_backtrace; + } + break; + case DebuggerAbort: + while (lisp__data.mem.level) { + --lisp__data.mem.level; + if (lisp__data.mem.mem[lisp__data.mem.level]) + free(lisp__data.mem.mem[lisp__data.mem.level]); + } + lisp__data.mem.index = 0; + LispTopLevel(); + if (!lisp__data.running) { + LispMessage("*** Fatal: nowhere to longjmp."); + abort(); + } + /* don't need to restore environment */ + siglongjmp(lisp__data.jmp, 1); + /*NOTREACHED*/ + break; + case DebuggerBreak: + for (ptr = arg; *ptr; ptr++) { + if (isspace(*ptr)) + break; + else + *ptr = toupper(*ptr); + } + + if (!*arg || *ptr || strchr(arg, '(') || strchr(arg, '(') || + strchr(arg, ';')) { + LispFputs(Stdout, "* Bad function name '"); + LispFputs(Stdout, arg); + LispFputs(Stdout, "' specified.\n"); + } + else { + for (obj = frm = BRK; obj != NIL; frm = obj, obj = CDR(obj)) + ; + i = lisp__data.debug_break; + ++lisp__data.debug_break; + GCDisable(); + obj = CONS(ATOM(arg), + CONS(FIXNUM(i), + CONS(FIXNUM(LispDebugBreakFunction), + CONS(FIXNUM(0), NIL)))); + if (BRK == NIL) + BRK = CONS(obj, NIL); + else + RPLACD(frm, CONS(obj, NIL)); + GCEnable(); + } + break; + case DebuggerWatch: { + void *sym; + int vframe; + LispObj *val, *atom; + + /* make variable name uppercase, an ATOM */ + ptr = arg; + while (*ptr) { + *ptr = toupper(*ptr); + ++ptr; + } + atom = ATOM(arg); + val = LispGetVar(atom); + if (val == NULL) { + LispFputs(Stdout, "* No variable named '"); + LispFputs(Stdout, arg); + LispFputs(Stdout, "' in the selected frame.\n"); + break; + } + + /* variable is available at the current frame */ + sym = LispGetVarAddr(atom); + + /* find the lowest frame where the variable is visible */ + vframe = 0; + if (frame > 0) { + for (; vframe < frame; vframe++) { + for (frm = DBG, i = lisp__data.debug_level; i > vframe; + frm = CDR(frm), i--) + ; + obj = CAR(frm); + lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(obj)))); + lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(obj))))); + lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(obj))))); + + if (LispGetVarAddr(atom) == sym) + /* got variable initial frame */ + break; + } + vframe = i; + if (vframe != frame) { + /* restore environment */ + for (frm = DBG, i = lisp__data.debug_level; i > frame; + frm = CDR(frm), i--) + ; + obj = CAR(frm); + lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(obj)))); + lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(obj))))); + lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(obj))))); + } + } + + i = lisp__data.debug_break; + ++lisp__data.debug_break; + for (obj = frm = BRK; obj != NIL; frm = obj, obj = CDR(obj)) + ; + + GCDisable(); + obj = CONS(atom, /* NAM */ + CONS(FIXNUM(i), /* IDX */ + CONS(FIXNUM(LispDebugBreakVariable), /* TYP */ + CONS(FIXNUM(0), /* HIT */ + CONS(OPAQUE(sym, 0), /* VAR */ + CONS(val, /* VAL */ + CONS(FIXNUM(vframe),/* FRM */ + NIL))))))); + + /* add watchpoint */ + if (BRK == NIL) + BRK = CONS(obj, NIL); + else + RPLACD(frm, CONS(obj, NIL)); + GCEnable(); + } break; + case DebuggerDelete: + if (*arg == 0) { + int confirm = 0; + + for (;;) { + int ch; + + LispFputs(Stdout, "* Delete all breakpoints? (y or n) "); + LispFflush(Stdout); + if ((ch = LispFgetc(Stdin)) == '\n') + continue; + while ((i = LispFgetc(Stdin)) != '\n' && i != EOF) + ; + if (tolower(ch) == 'n') + break; + else if (tolower(ch) == 'y') { + confirm = 1; + break; + } + } + if (confirm) + BRK = NIL; + } + else { + for (ptr = arg; *ptr;) { + while (*ptr && isdigit(*ptr)) + ++ptr; + if (*ptr && !isspace(*ptr)) { + *ptr = '\0'; + LispFputs(Stdout, "* Bad breakpoint number '"); + LispFputs(Stdout, arg); + LispFputs(Stdout, "' specified.\n"); + break; + } + i = atoi(arg); + for (obj = frm = BRK; frm != NIL; + obj = frm, frm = CDR(frm)) + if (FIXNUM_VALUE(CAR(CDR(CAR(frm)))) == i) + break; + if (frm == NIL) { + LispFputs(Stdout, "* No breakpoint number "); + LispFputs(Stdout, arg); + LispFputs(Stdout, " available.\n"); + break; + } + if (obj == frm) + BRK = CDR(BRK); + else + RPLACD(obj, CDR(frm)); + while (*ptr && isspace(*ptr)) + ++ptr; + arg = ptr; + } + } + break; + case DebuggerFrame: + i = -1; + ptr = arg; + if (*ptr) { + i = 0; + while (*ptr && isdigit(*ptr)) { + i *= 10; + i += *ptr - '0'; + ++ptr; + } + if (*ptr) { + LispFputs(Stdout, "* Frame identifier must " + "be a positive number.\n"); + break; + } + } + else + goto debugger_print_frame; + if (i >= 0 && i <= lisp__data.debug_level) + goto debugger_new_frame; + LispFputs(Stdout, "* No such frame "); + LispFputs(Stdout, format_integer(i)); + LispFputs(Stdout, ".\n"); + break; + case DebuggerDown: + if (frame + 1 > lisp__data.debug_level) { + LispFputs(Stdout, "* Cannot go down.\n"); + break; + } + i = frame + 1; + goto debugger_new_frame; + break; + case DebuggerUp: + if (frame == 0) { + LispFputs(Stdout, "* Cannot go up.\n"); + break; + } + i = frame - 1; + goto debugger_new_frame; + break; + case DebuggerPrint: + ptr = arg; + while (*ptr) { + *ptr = toupper(*ptr); + ++ptr; + } + obj = LispGetVar(ATOM(arg)); + if (obj != NULL) { + LispWriteObject(NIL, obj); + LispFputc(Stdout, '\n'); + } + else { + LispFputs(Stdout, "* No variable named '"); + LispFputs(Stdout, arg); + LispFputs(Stdout, "' in the selected frame.\n"); + } + break; + case DebuggerBacktrace: +debugger_print_backtrace: + if (DBG == NIL) { + LispFputs(Stdout, "* No stack.\n"); + break; + } + DBG = LispReverse(DBG); + for (obj = DBG, i = 0; obj != NIL; obj = CDR(obj), i++) { + frm = CAR(obj); + LispFputc(Stdout, '#'); + LispFputs(Stdout, format_integer(i)); + LispFputs(Stdout, "> ("); + LispWriteObject(NIL, CAR(frm)); + LispFputc(Stdout, ' '); + LispWriteObject(NIL, CAR(CDR(frm))); + LispFputs(Stdout, ")\n"); + } + DBG = LispReverse(DBG); + break; + case DebuggerContinue: + lisp__data.debug = LispDebugRun; + goto debugger_command_done; + case DebuggerFinish: + if (lisp__data.debug != LispDebugFinish) { + lisp__data.debug_step = lisp__data.debug_level - 2; + lisp__data.debug = LispDebugFinish; + } + else + lisp__data.debug_step = lisp__data.debug_level - 1; + goto debugger_command_done; + case DebuggerNext: + if (lisp__data.debug != LispDebugNext) { + lisp__data.debug = LispDebugNext; + lisp__data.debug_step = lisp__data.debug_level + 1; + } + goto debugger_command_done; + case DebuggerStep: + lisp__data.debug = LispDebugStep; + goto debugger_command_done; + } + continue; + +debugger_new_frame: + /* goto here with i as the new frame value, after error checking */ + if (i != frame) { + frame = i; + for (frm = DBG, i = lisp__data.debug_level; + i > frame; frm = CDR(frm), i--) + ; + curframe = CAR(frm); + lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(curframe)))); + lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(curframe))))); + lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(curframe))))); + } +debugger_print_frame: + LispFputc(Stdout, '#'); + LispFputs(Stdout, format_integer(frame)); + LispFputs(Stdout, "> ("); + LispWriteObject(NIL, CAR(curframe)); + LispFputc(Stdout, ' '); + LispWriteObject(NIL, CAR(CDR(curframe))); + LispFputs(Stdout, ")\n"); + } + +debugger_command_done: + lisp__data.stack.base = envbase; + lisp__data.env.length = envlen; + lisp__data.env.lex = envlex; +} + +static char * +format_integer(int integer) +{ + static char buffer[16]; + + sprintf(buffer, "%d", integer); + + return (buffer); +} + +#endif /* DEBUGGER */ |