debugger.c revision f765521f 
1/*
2 * Copyright (c) 2001 by The XFree86 Project, Inc.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a
5 * copy of this software and associated documentation files (the "Software"),
6 * to deal in the Software without restriction, including without limitation
7 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
8 * and/or sell copies of the Software, and to permit persons to whom the
9 * Software is furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
21 *
22 * Except as contained in this notice, the name of the XFree86 Project shall
23 * not be used in advertising or otherwise to promote the sale, use or other
24 * dealings in this Software without prior written authorization from the
25 * XFree86 Project.
26 *
27 * Author: Paulo César Pereira de Andrade
28 */
29
30/* $XFree86: xc/programs/xedit/lisp/debugger.c,v 1.24tsi Exp $ */
31
32#include <ctype.h>
33#include "lisp/io.h"
34#include "lisp/debugger.h"
35#include "lisp/write.h"
36
37#ifdef DEBUGGER
38#define DebuggerHelp		0
39#define DebuggerAbort		1
40#define DebuggerBacktrace	2
41#define DebuggerContinue	3
42#define DebuggerFinish		4
43#define DebuggerFrame		5
44#define DebuggerNext		6
45#define DebuggerPrint		7
46#define DebuggerStep		8
47#define DebuggerBreak		9
48#define DebuggerDelete		10
49#define DebuggerDown		11
50#define DebuggerUp		12
51#define DebuggerInfo		13
52#define DebuggerWatch		14
53
54#define DebuggerInfoBreakpoints	0
55#define DebuggerInfoBacktrace	1
56
57/*
58 * Prototypes
59 */
60static char *format_integer(int);
61static void LispDebuggerCommand(LispObj *obj);
62
63/*
64 * Initialization
65 */
66static struct {
67    const char *name;
68    int action;
69} const commands[] = {
70    {"help",		DebuggerHelp},
71    {"abort",		DebuggerAbort},
72    {"backtrace",	DebuggerBacktrace},
73    {"b",		DebuggerBreak},
74    {"break",		DebuggerBreak},
75    {"bt",		DebuggerBacktrace},
76    {"continue",	DebuggerContinue},
77    {"d",		DebuggerDelete},
78    {"delete",		DebuggerDelete},
79    {"down",		DebuggerDown},
80    {"finish",		DebuggerFinish},
81    {"frame",		DebuggerFrame},
82    {"info",		DebuggerInfo},
83    {"n",		DebuggerNext},
84    {"next",		DebuggerNext},
85    {"print",		DebuggerPrint},
86    {"run",		DebuggerContinue},
87    {"s",		DebuggerStep},
88    {"step",		DebuggerStep},
89    {"up",		DebuggerUp},
90    {"watch",		DebuggerWatch},
91};
92
93static struct {
94    const char *name;
95    int subaction;
96} const info_commands[] = {
97    {"breakpoints",	DebuggerInfoBreakpoints},
98    {"stack",		DebuggerInfoBacktrace},
99    {"watchpoints",	DebuggerInfoBreakpoints},
100};
101
102static const char *debugger_help =
103"Available commands are:\n\
104\n\
105help		- This message.\n\
106abort		- Abort the current execution, and return to toplevel.\n\
107backtrace, bt	- Print backtrace.\n\
108b, break	- Set breakpoint at function name argument.\n\
109continue	- Continue execution.\n\
110d, delete	- Delete breakpoint(s), all breakpoint if no arguments given.\n\
111down		- Set environment to frame called by the current one.\n\
112finish		- Executes until current form is finished.\n\
113frame		- Set environment to selected frame.\n\
114info		- Prints information about the debugger state.\n\
115n, next		- Evaluate next form.\n\
116print		- Print value of variable name argument.\n\
117run		- Continue execution.\n\
118s, step		- Evaluate next form, stopping on any subforms.\n\
119up		- Set environment to frame that called the current one.\n\
120\n\
121Commands may be abbreviated.\n";
122
123static const char *debugger_info_help =
124"Available subcommands are:\n\
125\n\
126breakpoints	- List and prints status of breakpoints, and watchpoints.\n\
127stack		- Backtrace of stack.\n\
128watchpoints	- List and prints status of watchpoints, and breakpoints.\n\
129\n\
130Subcommands may be abbreviated.\n";
131
132/* Debugger variables layout (if you change it, update description):
133 *
134 * DBG
135 *	is a macro for lisp__data.dbglist
136 *	is a NIL terminated list
137 *	every element is a list in the format (NOT NIL terminated):
138 *	(list* NAM ARG ENV HED LEX)
139 *	where
140 *		NAM is an ATOM for the function/macro name
141 *		    or NIL for lambda expressions
142 *		ARG is NAM arguments (a LIST)
143 *		ENV is the value of lisp__data.stack.base (a FIXNUM)
144 *		LEN is the value of lisp__data.env.length (a FIXNUM)
145 *		LEX is the value of lisp__data.env.lex (a FIXNUM)
146 *	new elements are added to the beggining of the DBG list
147 *
148 * BRK
149 *	is macro for lisp__data.brklist
150 *	is a NIL terminated list
151 *	every element is a list in the format (NIL terminated):
152 *	(list NAM IDX TYP HIT VAR VAL FRM)
153 *	where
154 *		NAM is an ATOM for the name of the object at
155 *		    wich the breakpoint was added
156 *		IDX is a FIXNUM, the breakpoint number
157 *		    must be stored, as breakpoints may be deleted
158 *		TYP is a FIXNUM that must be an integer of enum LispBreakType
159 *		HIT is a FIXNUM, with the number of times this breakpoint was
160 *		    hitted.
161 *		VAR variable to watch a SYMBOL	(not needed for breakpoints)
162 *		VAL value of watched variable	(not needed for breakpoints)
163 *		FRM frame where variable started being watched
164 *						(not needed for breakpoints)
165 *	new elements are added to the end of the list
166 */
167
168/*
169 * Implementation
170 */
171void
172LispDebugger(LispDebugCall call, LispObj *name, LispObj *arg)
173{
174    int force = 0;
175    LispObj *obj, *prev;
176
177    switch (call) {
178	case LispDebugCallBegin:
179	    ++lisp__data.debug_level;
180	    GCDisable();
181	    DBG = CONS(CONS(name, CONS(arg, CONS(FIXNUM(lisp__data.stack.base),
182		       CONS(FIXNUM(lisp__data.env.length),
183			    FIXNUM(lisp__data.env.lex))))), DBG);
184	    GCEnable();
185	    for (obj = BRK; obj != NIL; obj = CDR(obj))
186		if (ATOMID(CAR(CAR(obj))) == ATOMID(name) &&
187		    FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj))))) ==
188		    LispDebugBreakFunction)
189		    break;
190	    if (obj != NIL) {
191		long counter;
192
193		/* if not at a fresh line */
194		if (LispGetColumn(NIL))
195		    LispFputc(Stdout, '\n');
196		LispFputs(Stdout, "BREAK #");
197		LispWriteObject(NIL, CAR(CDR(CAR(obj))));
198		LispFputs(Stdout, "> (");
199		LispWriteObject(NIL, CAR(CAR(DBG)));
200		LispFputc(Stdout, ' ');
201		LispWriteObject(NIL, CAR(CDR(CAR(DBG))));
202		LispFputs(Stdout, ")\n");
203		force = 1;
204		/* update hits counter */
205		counter = FIXNUM_VALUE(CAR(CDR(CDR(CDR(CAR(obj))))));
206		CAR(CDR(CDR(CDR(CAR(obj))))) FIXNUM(counter + 1);
207	    }
208	    break;
209	case LispDebugCallEnd:
210	    DBG = CDR(DBG);
211	    if (lisp__data.debug_level < lisp__data.debug_step)
212		lisp__data.debug_step = lisp__data.debug_level;
213	    --lisp__data.debug_level;
214	    break;
215	case LispDebugCallFatal:
216	    LispDebuggerCommand(NIL);
217	    return;
218	case LispDebugCallWatch:
219	    break;
220    }
221
222    /* didn't return, check watchpoints */
223    if (call == LispDebugCallEnd || call == LispDebugCallWatch) {
224watch_again:
225	for (prev = obj = BRK; obj != NIL; prev = obj, obj = CDR(obj)) {
226	    if (FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj))))) ==
227		LispDebugBreakVariable) {
228		/* the variable */
229		LispObj *wat = CAR(CDR(CDR(CDR(CDR(CAR(obj))))));
230		void *sym = LispGetVarAddr(CAAR(obj));
231		LispObj *frm = CAR(CDR(CDR(CDR(CDR(CDR(CDR(CAR(obj))))))));
232
233		if ((sym == NULL && lisp__data.debug_level <= 0) ||
234		    (sym != wat->data.opaque.data &&
235		     FIXNUM_VALUE(frm) > lisp__data.debug_level)) {
236		    LispFputs(Stdout, "WATCH #");
237		    LispFputs(Stdout, format_integer(FIXNUM_VALUE(CAR(CDR(CAR(obj))))));
238		    LispFputs(Stdout, "> ");
239		    LispFputs(Stdout, STRPTR(CAR(CAR(obj))));
240		    LispFputs(Stdout, " deleted. Variable does not exist anymore.\n");
241		    /* force debugger to stop */
242		    force = 1;
243		    if (obj == prev) {
244			BRK = CDR(BRK);
245			goto watch_again;
246		    }
247		    else
248			RPLACD(prev, CDR(obj));
249		    obj = prev;
250		}
251		else {
252		    /* current value */
253		    LispObj *cur = *(LispObj**)wat->data.opaque.data;
254		    /* last value */
255		    LispObj *val = CAR(CDR(CDR(CDR(CDR(CDR(CAR(obj)))))));
256		    if (XEQUAL(val, cur) == NIL) {
257			long counter;
258
259			LispFputs(Stdout, "WATCH #");
260			LispFputs(Stdout, format_integer(FIXNUM_VALUE(CAR(CDR(CAR(obj))))));
261			LispFputs(Stdout, "> ");
262			LispFputs(Stdout, STRPTR(CAR(CAR(obj))));
263			LispFputc(Stdout, '\n');
264
265			LispFputs(Stdout, "OLD: ");
266			LispWriteObject(NIL, val);
267
268			LispFputs(Stdout, "\nNEW: ");
269			LispWriteObject(NIL, cur);
270			LispFputc(Stdout, '\n');
271
272			/* update current value */
273			CAR(CDR(CDR(CDR(CDR(CDR(CAR(obj))))))) = cur;
274			/* update hits counter */
275			counter = FIXNUM_VALUE(CAR(CDR(CDR(CDR(CAR(obj))))));
276			CAR(CDR(CDR(CDR(CAR(obj))))) = FIXNUM(counter + 1);
277			/* force debugger to stop */
278			force = 1;
279		    }
280		}
281	    }
282	}
283
284	if (call == LispDebugCallWatch)
285	    /* special call, just don't keep gc protected variables that may be
286	     * using a lot of memory... */
287	    return;
288    }
289
290    switch (lisp__data.debug) {
291	case LispDebugUnspec:
292	    LispDebuggerCommand(NIL);
293	    goto debugger_done;
294	case LispDebugRun:
295	    if (force)
296		LispDebuggerCommand(NIL);
297	    goto debugger_done;
298	case LispDebugFinish:
299	    if (!force &&
300		(call != LispDebugCallEnd ||
301		 lisp__data.debug_level != lisp__data.debug_step))
302		goto debugger_done;
303	    break;
304	case LispDebugNext:
305	    if (call == LispDebugCallBegin) {
306		if (!force && lisp__data.debug_level != lisp__data.debug_step)
307		    goto debugger_done;
308	    }
309	    else if (call == LispDebugCallEnd) {
310		if (!force && lisp__data.debug_level >= lisp__data.debug_step)
311		    goto debugger_done;
312	    }
313	    break;
314	case LispDebugStep:
315	    break;
316    }
317
318    if (call == LispDebugCallBegin) {
319	LispFputc(Stdout, '#');
320	LispFputs(Stdout, format_integer(lisp__data.debug_level));
321	LispFputs(Stdout, "> (");
322	LispWriteObject(NIL, CAR(CAR(DBG)));
323	LispFputc(Stdout, ' ');
324	LispWriteObject(NIL, CAR(CDR(CAR(DBG))));
325	LispFputs(Stdout, ")\n");
326	LispDebuggerCommand(NIL);
327    }
328    else if (call == LispDebugCallEnd) {
329	LispFputc(Stdout, '#');
330	LispFputs(Stdout, format_integer(lisp__data.debug_level + 1));
331	LispFputs(Stdout, "= ");
332	LispWriteObject(NIL, arg);
333	LispFputc(Stdout, '\n');
334	LispDebuggerCommand(NIL);
335    }
336    else if (force)
337	LispDebuggerCommand(arg);
338
339debugger_done:
340    return;
341}
342
343static void
344LispDebuggerCommand(LispObj *args)
345{
346    LispObj *obj, *frm, *curframe;
347    int i = 0, frame, matches, action = -1, subaction = 0;
348    char *cmd, *arg, *ptr, line[256];
349
350    int envbase = lisp__data.stack.base,
351	envlen = lisp__data.env.length,
352	envlex = lisp__data.env.lex;
353
354    frame = lisp__data.debug_level;
355    curframe = CAR(DBG);
356
357    line[0] = '\0';
358    arg = line;
359    for (;;) {
360	LispFputs(Stdout, DBGPROMPT);
361	LispFflush(Stdout);
362	if (LispFgets(Stdin, line, sizeof(line)) == NULL) {
363	    LispFputc(Stdout, '\n');
364	    return;
365	}
366	/* get command */
367	ptr = line;
368	while (*ptr && isspace(*ptr))
369	    ++ptr;
370	cmd = ptr;
371	while (*ptr && !isspace(*ptr))
372	    ++ptr;
373	if (*ptr)
374	    *ptr++ = '\0';
375
376	if (*cmd) {	/* if *cmd is nul, then arg may be still set */
377	    /* get argument(s) */
378	    while (*ptr && isspace(*ptr))
379		++ptr;
380	    arg = ptr;
381	    /* goto end of line */
382	    if (*ptr) {
383		while (*ptr)
384		    ++ptr;
385		--ptr;
386		while (*ptr && isspace(*ptr))
387		    --ptr;
388		if (*ptr)
389		    *++ptr = '\0';
390	    }
391	}
392
393	if (*cmd == '\0') {
394	    if (action < 0) {
395		if (lisp__data.debug == LispDebugFinish)
396		    action = DebuggerFinish;
397		else if (lisp__data.debug == LispDebugNext)
398		    action = DebuggerNext;
399		else if (lisp__data.debug == LispDebugStep)
400		    action = DebuggerStep;
401		else if (lisp__data.debug == LispDebugRun)
402		    action = DebuggerContinue;
403		else
404		    continue;
405	    }
406	}
407	else {
408	    for (i = matches = 0; i < sizeof(commands) / sizeof(commands[0]);
409		 i++) {
410		const char *str = commands[i].name;
411
412		ptr = cmd;
413		while (*ptr && *ptr == *str) {
414		    ++ptr;
415		    ++str;
416		}
417		if (*ptr == '\0') {
418		    action = commands[i].action;
419		    if (*str == '\0') {
420			matches = 1;
421			break;
422		    }
423		    ++matches;
424		}
425	    }
426	    if (matches == 0) {
427		LispFputs(Stdout, "* Command unknown: ");
428		LispFputs(Stdout, cmd);
429		LispFputs(Stdout, ". Type help for help.\n");
430		continue;
431	    }
432	    else if (matches > 1) {
433		LispFputs(Stdout, "* Command is ambiguous: ");
434		LispFputs(Stdout, cmd);
435		LispFputs(Stdout, ". Type help for help.\n");
436		continue;
437	    }
438	}
439
440	switch (action) {
441	    case DebuggerHelp:
442		LispFputs(Stdout, debugger_help);
443		break;
444	    case DebuggerInfo:
445		if (*arg == '\0') {
446		    LispFputs(Stdout, debugger_info_help);
447		    break;
448		}
449
450		for (i = matches = 0;
451		     i < sizeof(info_commands) / sizeof(info_commands[0]);
452		     i++) {
453		    const char *str = info_commands[i].name;
454
455		    ptr = arg;
456		    while (*ptr && *ptr == *str) {
457			++ptr;
458			++str;
459		    }
460		    if (*ptr == '\0') {
461			subaction = info_commands[i].subaction;
462			if (*str == '\0') {
463			    matches = 1;
464			    break;
465			}
466			++matches;
467		    }
468		}
469		if (matches == 0) {
470		    LispFputs(Stdout, "* Command unknown: ");
471		    LispFputs(Stdout, arg);
472		    LispFputs(Stdout, ". Type info for help.\n");
473		    continue;
474		}
475		else if (matches > 1) {
476		    LispFputs(Stdout, "* Command is ambiguous: ");
477		    LispFputs(Stdout, arg);
478		    LispFputs(Stdout, ". Type info for help.\n");
479		    continue;
480		}
481
482		switch (subaction) {
483		    case DebuggerInfoBreakpoints:
484			LispFputs(Stdout, "Num\tHits\tType\t\tWhat\n");
485			for (obj = BRK; obj != NIL; obj = CDR(obj)) {
486			    /* breakpoint number */
487			    LispFputc(Stdout, '#');
488			    LispWriteObject(NIL, CAR(CDR(CAR(obj))));
489
490			    /* number of hits */
491			    LispFputc(Stdout, '\t');
492			    LispWriteObject(NIL, CAR(CDR(CDR(CDR(CAR(obj))))));
493
494			    /* breakpoint type */
495			    LispFputc(Stdout, '\t');
496			    switch ((int)FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj)))))) {
497				case LispDebugBreakFunction:
498				    LispFputs(Stdout, "Function");
499				    break;
500				case LispDebugBreakVariable:
501				    LispFputs(Stdout, "Variable");
502				    break;
503			    }
504
505			    /* breakpoint object */
506			    LispFputc(Stdout, '\t');
507			    LispWriteObject(NIL, CAR(CAR(obj)));
508			    LispFputc(Stdout, '\n');
509			}
510			break;
511		    case DebuggerInfoBacktrace:
512			goto debugger_print_backtrace;
513		}
514		break;
515	    case DebuggerAbort:
516		while (lisp__data.mem.level) {
517		    --lisp__data.mem.level;
518		    if (lisp__data.mem.mem[lisp__data.mem.level])
519			free(lisp__data.mem.mem[lisp__data.mem.level]);
520		}
521		lisp__data.mem.index = 0;
522		LispTopLevel();
523		if (!lisp__data.running) {
524		    LispMessage("*** Fatal: nowhere to longjmp.");
525		    abort();
526		}
527		/* don't need to restore environment */
528		siglongjmp(lisp__data.jmp, 1);
529		/*NOTREACHED*/
530		break;
531	    case DebuggerBreak:
532		for (ptr = arg; *ptr; ptr++) {
533		    if (isspace(*ptr))
534			break;
535		    else
536			*ptr = toupper(*ptr);
537		}
538
539		if (!*arg || *ptr || strchr(arg, '(') || strchr(arg, '(') ||
540		    strchr(arg, ';')) {
541		    LispFputs(Stdout, "* Bad function name '");
542		    LispFputs(Stdout, arg);
543		    LispFputs(Stdout, "' specified.\n");
544		}
545		else {
546		    for (obj = frm = BRK; obj != NIL; frm = obj, obj = CDR(obj))
547			;
548		    i = lisp__data.debug_break;
549		    ++lisp__data.debug_break;
550		    GCDisable();
551		    obj = CONS(ATOM(arg),
552			       CONS(FIXNUM(i),
553				    CONS(FIXNUM(LispDebugBreakFunction),
554					 CONS(FIXNUM(0), NIL))));
555		    if (BRK == NIL)
556			BRK = CONS(obj, NIL);
557		    else
558			RPLACD(frm, CONS(obj, NIL));
559		    GCEnable();
560		}
561		break;
562	    case DebuggerWatch: {
563		void *sym;
564		int vframe;
565		LispObj *val, *atom;
566
567		/* make variable name uppercase, an ATOM */
568		ptr = arg;
569		while (*ptr) {
570		    *ptr = toupper(*ptr);
571		    ++ptr;
572		}
573		atom = ATOM(arg);
574		val = LispGetVar(atom);
575		if (val == NULL) {
576		    LispFputs(Stdout, "* No variable named '");
577		    LispFputs(Stdout, arg);
578		    LispFputs(Stdout, "' in the selected frame.\n");
579		    break;
580		}
581
582		/* variable is available at the current frame */
583		sym = LispGetVarAddr(atom);
584
585		/* find the lowest frame where the variable is visible */
586		vframe = 0;
587		if (frame > 0) {
588		    for (; vframe < frame; vframe++) {
589			for (frm = DBG, i = lisp__data.debug_level; i > vframe;
590			     frm = CDR(frm), i--)
591			    ;
592			obj = CAR(frm);
593			lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(obj))));
594			lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(obj)))));
595			lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(obj)))));
596
597			if (LispGetVarAddr(atom) == sym)
598			    /* got variable initial frame */
599			    break;
600		    }
601		    vframe = i;
602		    if (vframe != frame) {
603			/* restore environment */
604			for (frm = DBG, i = lisp__data.debug_level; i > frame;
605			     frm = CDR(frm), i--)
606			    ;
607			obj = CAR(frm);
608			lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(obj))));
609			lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(obj)))));
610			lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(obj)))));
611		    }
612		}
613
614		i = lisp__data.debug_break;
615		++lisp__data.debug_break;
616		for (obj = frm = BRK; obj != NIL; frm = obj, obj = CDR(obj))
617		    ;
618
619		GCDisable();
620		obj = CONS(atom,					/* NAM */
621			   CONS(FIXNUM(i),				/* IDX */
622				CONS(FIXNUM(LispDebugBreakVariable),	/* TYP */
623				     CONS(FIXNUM(0),			/* HIT */
624					  CONS(OPAQUE(sym, 0),		/* VAR */
625					       CONS(val,		/* VAL */
626						    CONS(FIXNUM(vframe),/* FRM */
627							      NIL)))))));
628
629		/* add watchpoint */
630		if (BRK == NIL)
631		    BRK = CONS(obj, NIL);
632		else
633		    RPLACD(frm, CONS(obj, NIL));
634		GCEnable();
635	    }	break;
636	    case DebuggerDelete:
637		if (*arg == 0) {
638		    int confirm = 0;
639
640		    for (;;) {
641			int ch;
642
643			LispFputs(Stdout, "* Delete all breakpoints? (y or n) ");
644			LispFflush(Stdout);
645			if ((ch = LispFgetc(Stdin)) == '\n')
646			    continue;
647			while ((i = LispFgetc(Stdin)) != '\n' && i != EOF)
648			    ;
649			if (tolower(ch) == 'n')
650			    break;
651			else if (tolower(ch) == 'y') {
652			    confirm = 1;
653			    break;
654			}
655		    }
656		    if (confirm)
657			BRK = NIL;
658		}
659		else {
660		    for (ptr = arg; *ptr;) {
661			while (*ptr && isdigit(*ptr))
662			    ++ptr;
663			if (*ptr && !isspace(*ptr)) {
664			    *ptr = '\0';
665			    LispFputs(Stdout, "* Bad breakpoint number '");
666			    LispFputs(Stdout, arg);
667			    LispFputs(Stdout, "' specified.\n");
668			    break;
669			}
670			i = atoi(arg);
671			for (obj = frm = BRK; frm != NIL;
672			     obj = frm, frm = CDR(frm))
673			    if (FIXNUM_VALUE(CAR(CDR(CAR(frm)))) == i)
674				break;
675			if (frm == NIL) {
676			    LispFputs(Stdout, "* No breakpoint number ");
677			    LispFputs(Stdout, arg);
678			    LispFputs(Stdout, " available.\n");
679			    break;
680			}
681			if (obj == frm)
682			    BRK = CDR(BRK);
683			else
684			    RPLACD(obj, CDR(frm));
685			while (*ptr && isspace(*ptr))
686			    ++ptr;
687			arg = ptr;
688		    }
689		}
690		break;
691	    case DebuggerFrame:
692		i = -1;
693		ptr = arg;
694		if (*ptr) {
695		    i = 0;
696		    while (*ptr && isdigit(*ptr)) {
697			i *= 10;
698			i += *ptr - '0';
699			++ptr;
700		    }
701		    if (*ptr) {
702			LispFputs(Stdout, "* Frame identifier must "
703				"be a positive number.\n");
704			break;
705		    }
706		}
707		else
708		    goto debugger_print_frame;
709		if (i >= 0 && i <= lisp__data.debug_level)
710		    goto debugger_new_frame;
711		LispFputs(Stdout, "* No such frame ");
712		LispFputs(Stdout, format_integer(i));
713		LispFputs(Stdout, ".\n");
714		break;
715	    case DebuggerDown:
716		if (frame + 1 > lisp__data.debug_level) {
717		    LispFputs(Stdout, "* Cannot go down.\n");
718		    break;
719		}
720		i = frame + 1;
721		goto debugger_new_frame;
722		break;
723	    case DebuggerUp:
724		if (frame == 0) {
725		    LispFputs(Stdout, "* Cannot go up.\n");
726		    break;
727		}
728		i = frame - 1;
729		goto debugger_new_frame;
730		break;
731	    case DebuggerPrint:
732		ptr = arg;
733		while (*ptr) {
734		    *ptr = toupper(*ptr);
735		    ++ptr;
736		}
737		obj = LispGetVar(ATOM(arg));
738		if (obj != NULL) {
739		    LispWriteObject(NIL, obj);
740		    LispFputc(Stdout, '\n');
741		}
742		else {
743		    LispFputs(Stdout, "* No variable named '");
744		    LispFputs(Stdout, arg);
745		    LispFputs(Stdout, "' in the selected frame.\n");
746		}
747		break;
748	    case DebuggerBacktrace:
749debugger_print_backtrace:
750		if (DBG == NIL) {
751		    LispFputs(Stdout, "* No stack.\n");
752		    break;
753		}
754		DBG = LispReverse(DBG);
755		for (obj = DBG, i = 0; obj != NIL; obj = CDR(obj), i++) {
756		    frm = CAR(obj);
757		    LispFputc(Stdout, '#');
758		    LispFputs(Stdout, format_integer(i));
759		    LispFputs(Stdout, "> (");
760		    LispWriteObject(NIL, CAR(frm));
761		    LispFputc(Stdout, ' ');
762		    LispWriteObject(NIL, CAR(CDR(frm)));
763		    LispFputs(Stdout, ")\n");
764		}
765		DBG = LispReverse(DBG);
766		break;
767	    case DebuggerContinue:
768		lisp__data.debug = LispDebugRun;
769		goto debugger_command_done;
770	    case DebuggerFinish:
771		if (lisp__data.debug != LispDebugFinish) {
772		    lisp__data.debug_step = lisp__data.debug_level - 2;
773		    lisp__data.debug = LispDebugFinish;
774		}
775		else
776		    lisp__data.debug_step = lisp__data.debug_level - 1;
777		goto debugger_command_done;
778	    case DebuggerNext:
779		if (lisp__data.debug != LispDebugNext) {
780		    lisp__data.debug = LispDebugNext;
781		    lisp__data.debug_step = lisp__data.debug_level + 1;
782		}
783		goto debugger_command_done;
784	    case DebuggerStep:
785		lisp__data.debug = LispDebugStep;
786		goto debugger_command_done;
787	}
788	continue;
789
790debugger_new_frame:
791	/* goto here with i as the new frame value, after error checking */
792	if (i != frame) {
793	    frame = i;
794	    for (frm = DBG, i = lisp__data.debug_level;
795		 i > frame; frm = CDR(frm), i--)
796		;
797	    curframe = CAR(frm);
798	    lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(curframe))));
799	    lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(curframe)))));
800	    lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(curframe)))));
801	}
802debugger_print_frame:
803	LispFputc(Stdout, '#');
804	LispFputs(Stdout, format_integer(frame));
805	LispFputs(Stdout, "> (");
806	LispWriteObject(NIL, CAR(curframe));
807	LispFputc(Stdout, ' ');
808	LispWriteObject(NIL, CAR(CDR(curframe)));
809	LispFputs(Stdout, ")\n");
810    }
811
812debugger_command_done:
813    lisp__data.stack.base = envbase;
814    lisp__data.env.length = envlen;
815    lisp__data.env.lex = envlex;
816}
817
818static char *
819format_integer(int integer)
820{
821    static char buffer[16];
822
823    sprintf(buffer, "%d", integer);
824
825    return (buffer);
826}
827
828#endif /* DEBUGGER */
829