qbit/xenocara
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
5150e677a9
xenocara/app/xedit/lisp/debugger.c
matthieu 99a72825ec Update to xedit 1.2.2
2015-05-10 10:07:47 +00:00

829 lines
22 KiB
C
Raw Blame History

/*
* 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.24tsi Exp $ */
#include <ctype.h>
#include "lisp/io.h"
#include "lisp/debugger.h"
#include "lisp/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 {
const char *name;
int action;
} const 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 {
const char *name;
int subaction;
} const info_commands[] = {
{"breakpoints", DebuggerInfoBreakpoints},
{"stack", DebuggerInfoBacktrace},
{"watchpoints", DebuggerInfoBreakpoints},
};
static const 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 const 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++) {
const 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++) {
const 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 */
Reference in New Issue View Git Blame Copy Permalink