#include <stdio.h>
#include "Dbg_cf.h"
#if 0
#define NO_STDLIB_H
#endif
#include "tclInt.h"
#include "Dbg.h"
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
static int simple_interactor();
static int zero();
static Dbg_InterProc *interactor = simple_interactor;
static ClientData interdata = 0;
static Dbg_IgnoreFuncsProc *ignoreproc = zero;
static Dbg_OutputProc *printproc = 0;
static ClientData printdata = 0;
static void print _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
static int debugger_active = FALSE;
char *Dbg_VarName = "dbg";
#define DEFAULT_COMPRESS 0
static int compress = DEFAULT_COMPRESS;
#define DEFAULT_WIDTH 75
static int buf_width = DEFAULT_WIDTH;
static int main_argc = 1;
static char *default_argv = "application";
static char **main_argv = &default_argv;
static Tcl_Trace debug_handle;
static int step_count = 1;
#define FRAMENAMELEN 10
static char viewFrameName[FRAMENAMELEN];
static CallFrame *goalFramePtr;
static int goalNumLevel;
static enum debug_cmd {
none, step, next, ret, cont, up, down, where, Next
} debug_cmd;
static enum debug_cmd last_action_cmd = next;
static int last_step_count = 1;
static debug_new_action;
#define NO_LINE -1
struct breakpoint {
int id;
char *file;
int line;
char *pat;
regexp *re;
char *expr;
char *cmd;
struct breakpoint *next, *previous;
};
static struct breakpoint *break_base = 0;
static int breakpoint_max_id = 0;
static struct breakpoint *
breakpoint_new()
{
struct breakpoint *b = (struct breakpoint *)ckalloc(sizeof(struct breakpoint));
if (break_base) break_base->previous = b;
b->next = break_base;
b->previous = 0;
b->id = breakpoint_max_id++;
b->file = 0;
b->line = NO_LINE;
b->pat = 0;
b->re = 0;
b->expr = 0;
b->cmd = 0;
break_base = b;
return(b);
}
static
void
breakpoint_print(interp,b)
Tcl_Interp *interp;
struct breakpoint *b;
{
print(interp,"breakpoint %d: ",b->id);
if (b->re) {
print(interp,"-re \"%s\" ",b->pat);
} else if (b->pat) {
print(interp,"-glob \"%s\" ",b->pat);
} else if (b->line != NO_LINE) {
if (b->file) {
print(interp,"%s:",b->file);
}
print(interp,"%d ",b->line);
}
if (b->expr)
print(interp,"if {%s} ",b->expr);
if (b->cmd)
print(interp,"then {%s}",b->cmd);
print(interp,"\n");
}
static void
save_re_matches(interp,re)
Tcl_Interp *interp;
regexp *re;
{
int i;
char name[20];
char match_char;
for (i=0;i<NSUBEXP;i++) {
if (re->startp[i] == 0) break;
sprintf(name,"%d",i);
match_char = *re->endp[i];
*re->endp[i] = 0;
Tcl_SetVar2(interp,Dbg_VarName,name,re->startp[i],0);
*re->endp[i] = match_char;
}
}
static int
breakpoint_test(interp,cmd,bp)
Tcl_Interp *interp;
char *cmd;
struct breakpoint *bp;
{
if (bp->re) {
if (0 == TclRegExec(bp->re,cmd,cmd)) return 0;
save_re_matches(interp,bp->re);
} else if (bp->pat) {
if (0 == Tcl_StringMatch(cmd,bp->pat)) return 0;
} else if (bp->line != NO_LINE) {
return 0;
}
if (bp->expr) {
int value;
if (TCL_OK != Tcl_ExprBoolean(interp,bp->expr,&value)
|| (value == 0)) return 0;
}
if (bp->cmd) {
Tcl_Eval(interp,bp->cmd);
} else {
breakpoint_print(interp,bp);
}
return 1;
}
static char *already_at_top_level = "already at top level";
static
int
TclGetFrame2(interp, origFramePtr, string, framePtrPtr, dir)
Tcl_Interp *interp;
CallFrame *origFramePtr;
char *string;
CallFrame **framePtrPtr;
enum debug_cmd dir;
{
Interp *iPtr = (Interp *) interp;
int level, result;
CallFrame *framePtr;
CallFrame *curFramePtr = iPtr->varFramePtr;
result = 1;
if (*string == '#') {
if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
return TCL_ERROR;
}
if (level < 0) {
levelError:
Tcl_AppendResult(interp, "bad level \"", string, "\"",
(char *) NULL);
return TCL_ERROR;
}
framePtr = origFramePtr;
} else if (isdigit(*string)) {
if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
return TCL_ERROR;
}
if (dir == up) {
if (curFramePtr == 0) {
Tcl_SetResult(interp,already_at_top_level,TCL_STATIC);
return TCL_ERROR;
}
level = curFramePtr->level - level;
framePtr = curFramePtr;
} else {
if (curFramePtr != 0) {
level = curFramePtr->level + level;
}
framePtr = origFramePtr;
}
} else {
level = curFramePtr->level - 1;
result = 0;
}
if (level == 0) {
framePtr = NULL;
} else {
for (;framePtr != NULL; framePtr = framePtr->callerVarPtr) {
if (framePtr->level == level) {
break;
}
}
if (framePtr == NULL) {
goto levelError;
}
}
*framePtrPtr = framePtr;
return result;
}
static char *printify(s)
char *s;
{
static int destlen = 0;
char *d;
unsigned int need;
static char buf_basic[DEFAULT_WIDTH+1];
static char *dest = buf_basic;
if (s == 0) return("<null>");
need = strlen(s)*4;
if (need > destlen) {
if (dest && (dest != buf_basic)) ckfree(dest);
dest = (char *)ckalloc(need+1);
destlen = need;
}
for (d = dest;*s;s++) {
if (d-dest > destlen-4) break;
if (*s == '\b') {
strcpy(d,"\\b"); d += 2;
} else if (*s == '\f') {
strcpy(d,"\\f"); d += 2;
} else if (*s == '\v') {
strcpy(d,"\\v"); d += 2;
} else if (*s == '\r') {
strcpy(d,"\\r"); d += 2;
} else if (*s == '\n') {
strcpy(d,"\\n"); d += 2;
} else if (*s == '\t') {
strcpy(d,"\\t"); d += 2;
} else if ((unsigned)*s < 0x20) {
sprintf(d,"\\%03o",*s); d += 4;
} else if (*s == 0177) {
strcpy(d,"\\177"); d += 4;
} else {
*d = *s; d += 1;
}
}
*d = '\0';
return(dest);
}
static
char *
print_argv(interp,argc,argv)
Tcl_Interp *interp;
int argc;
char *argv[];
{
static int buf_width_max = DEFAULT_WIDTH;
static char buf_basic[DEFAULT_WIDTH+1];
static char *buf = buf_basic;
int space;
int len;
char *bufp;
int proc;
int arg_index;
if (buf_width > buf_width_max) {
if (buf && (buf != buf_basic)) ckfree(buf);
buf = (char *)ckalloc(buf_width + 1);
buf_width_max = buf_width;
}
proc = (0 == strcmp("proc",argv[0]));
sprintf(buf,"%.*s",buf_width,argv[0]);
len = strlen(buf);
space = buf_width - len;
bufp = buf + len;
argc--; argv++;
arg_index = 1;
while (argc && (space > 0)) {
char *elementPtr;
char *nextPtr;
int wrap;
if (proc && (arg_index > 1)) wrap = TRUE;
else {
(void) TclFindElement(interp,*argv,
#if TCL_MAJOR_VERSION >= 8
-1,
#endif
&elementPtr,&nextPtr,(int *)0,(int *)0);
if (*elementPtr == '\0') wrap = TRUE;
else if (*nextPtr == '\0') wrap = FALSE;
else wrap = TRUE;
}
if (wrap) {
sprintf(bufp," {%.*s}",space-3,*argv);
} else {
sprintf(bufp," %.*s",space-1,*argv);
}
len = strlen(buf);
space = buf_width - len;
bufp = buf + len;
argc--; argv++;
arg_index++;
}
if (compress) {
strncpy(buf,printify(buf),buf_width);
}
if (strlen(buf) == buf_width) {
buf[buf_width-1] = buf[buf_width-2] = buf[buf_width-3] = '.';
}
return(buf);
}
#if TCL_MAJOR_VERSION >= 8
static
char *
print_objv(interp,objc,objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *objv[];
{
char **argv;
int argc;
int len;
argv = (char **)ckalloc(objc+1 * sizeof(char *));
for (argc=0 ; argc<objc ; argc++) {
argv[argc] = Tcl_GetStringFromObj(objv[argc],&len);
}
argv[argc] = NULL;
print_argv(interp,argc,argv);
}
#endif
static
void
PrintStackBelow(interp,curf,viewf)
Tcl_Interp *interp;
CallFrame *curf;
CallFrame *viewf;
{
char ptr;
ptr = ((curf == viewf)?'*':' ');
if (curf == 0) {
print(interp,"%c0: %s\n",
ptr,print_argv(interp,main_argc,main_argv));
} else {
PrintStackBelow(interp,curf->callerVarPtr,viewf);
print(interp,"%c%d: %s\n",ptr,curf->level,
#if TCL_MAJOR_VERSION >= 8
print_objv(interp,curf->objc,curf->objv));
#else
print_argv(interp,curf->argc,curf->argv));
#endif
}
}
static
void
PrintStack(interp,curf,viewf,argc,argv,level)
Tcl_Interp *interp;
CallFrame *curf;
CallFrame *viewf;
int argc;
char *argv[];
char *level;
{
PrintStackBelow(interp,curf,viewf);
print(interp," %s: %s\n",level,print_argv(interp,argc,argv));
}
static int
GoalFrame(goal,iptr)
CallFrame *goal;
Interp *iptr;
{
CallFrame *cf = iptr->varFramePtr;
if (goal == cf) return 0;
while (cf) {
cf = cf->callerVarPtr;
if (goal == cf) {
return 1;
}
}
return 0;
}
static void
debugger_trap(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int level;
char *command;
int (*cmdProc)();
ClientData cmdClientData;
int argc;
char *argv[];
{
char level_text[6];
int break_status;
Interp *iPtr = (Interp *)interp;
CallFrame *trueFramePtr;
CallFrame *viewFramePtr;
int print_command_first_time = TRUE;
static int debug_suspended = FALSE;
struct breakpoint *b;
if (debug_suspended) return;
if (argv[0][1] == '\0') {
switch (argv[0][0]) {
case 'n':
case 's':
case 'c':
case 'r':
case 'w':
case 'b':
case 'u':
case 'd': return;
}
}
if ((*ignoreproc)(interp,argv[0])) return;
sprintf(level_text,(level == -1)?"?":"%d",level);
trueFramePtr = iPtr->varFramePtr;
debug_suspended = TRUE;
debug_new_action = FALSE;
break_status = FALSE;
for (b = break_base;b;b=b->next) {
break_status |= breakpoint_test(interp,command,b);
}
if (break_status) {
if (!debug_new_action) goto start_interact;
goto end_interact;
}
switch (debug_cmd) {
case cont:
goto finish;
case step:
step_count--;
if (step_count > 0) goto finish;
goto start_interact;
case next:
if (GoalFrame(goalFramePtr,iPtr)) goto finish;
step_count--;
if (step_count > 0) goto finish;
goto start_interact;
case Next:
if (goalNumLevel < iPtr->numLevels) goto finish;
step_count--;
if (step_count > 0) goto finish;
goto start_interact;
case ret:
if (goalFramePtr != iPtr->varFramePtr) goto finish;
goto start_interact;
}
start_interact:
if (print_command_first_time) {
print(interp,"%s: %s\n",
level_text,print_argv(interp,1,&command));
print_command_first_time = FALSE;
}
debug_cmd = cont;
debug_suspended = TRUE;
(*interactor)(interp,interdata);
end_interact:
viewFramePtr = iPtr->varFramePtr;
if (debug_cmd == up || debug_cmd == down) {
if (-1 == TclGetFrame2(interp,trueFramePtr,viewFrameName,
&iPtr->varFramePtr,debug_cmd)) {
print(interp,"%s\n",interp->result);
Tcl_ResetResult(interp);
}
goto start_interact;
}
iPtr->varFramePtr = trueFramePtr;
#if 0
debug_suspended = FALSE;
#endif
switch (debug_cmd) {
case cont:
case step:
goto finish;
case next:
goalFramePtr = iPtr->varFramePtr;
goto finish;
case Next:
goalNumLevel = iPtr->numLevels;
goto finish;
case ret:
goalFramePtr = iPtr->varFramePtr;
if (goalFramePtr == 0) {
print(interp,"nowhere to return to\n");
break;
}
goalFramePtr = goalFramePtr->callerVarPtr;
goto finish;
case where:
PrintStack(interp,iPtr->varFramePtr,viewFramePtr,argc,argv,level_text);
break;
}
iPtr->varFramePtr = viewFramePtr;
goto start_interact;
finish:
debug_suspended = FALSE;
}
static
int
cmdNext(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
debug_new_action = TRUE;
debug_cmd = *(enum debug_cmd *)clientData;
last_action_cmd = debug_cmd;
step_count = (argc == 1)?1:atoi(argv[1]);
last_step_count = step_count;
return(TCL_RETURN);
}
static
int
cmdDir(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
debug_cmd = *(enum debug_cmd *)clientData;
if (argc == 1) argv[1] = "1";
strncpy(viewFrameName,argv[1],FRAMENAMELEN);
return TCL_RETURN;
}
static
int
cmdSimple(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
debug_new_action = TRUE;
debug_cmd = *(enum debug_cmd *)clientData;
last_action_cmd = debug_cmd;
return TCL_RETURN;
}
static
void
breakpoint_destroy(b)
struct breakpoint *b;
{
if (b->file) ckfree(b->file);
if (b->pat) ckfree(b->pat);
if (b->re) ckfree((char *)b->re);
if (b->cmd) ckfree(b->cmd);
if ((b->previous == 0) && (b->next == 0)) {
break_base = 0;
} else if (b->previous == 0) {
break_base = b->next;
b->next->previous = 0;
} else if (b->next == 0) {
b->previous->next = 0;
} else {
b->previous->next = b->next;
b->next->previous = b->previous;
}
ckfree((char *)b);
}
static void
savestr(straddr,str)
char **straddr;
char *str;
{
*straddr = ckalloc(strlen(str)+1);
strcpy(*straddr,str);
}
static int
flageq(flag,string,minlen)
char *flag;
char *string;
int minlen;
{
for (;*flag;flag++,string++,minlen--) {
if (*string == '\0') break;
if (*string != *flag) return 0;
}
if (*string == '\0' && minlen <= 0) return 1;
return 0;
}
static
int
cmdWhere(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
if (argc == 1) {
debug_cmd = where;
return TCL_RETURN;
}
argc--; argv++;
while (argc) {
if (flageq("-width",*argv,2)) {
argc--; argv++;
if (*argv) {
buf_width = atoi(*argv);
argc--; argv++;
} else print(interp,"%d\n",buf_width);
} else if (flageq("-compress",*argv,2)) {
argc--; argv++;
if (*argv) {
compress = atoi(*argv);
argc--; argv++;
} else print(interp,"%d\n",compress);
} else {
print(interp,"usage: w [-width #] [-compress 0|1]\n");
return TCL_ERROR;
}
}
return TCL_OK;
}
#define breakpoint_fail(msg) {error_msg = msg; goto break_fail;}
static
int
cmdBreak(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
struct breakpoint *b;
char *error_msg;
argc--; argv++;
if (argc < 1) {
for (b = break_base;b;b=b->next) breakpoint_print(interp,b);
return(TCL_OK);
}
if (argv[0][0] == '-') {
if (argv[0][1] == '\0') {
while (break_base) {
breakpoint_destroy(break_base);
}
breakpoint_max_id = 0;
return(TCL_OK);
} else if (isdigit(argv[0][1])) {
int id = atoi(argv[0]+1);
for (b = break_base;b;b=b->next) {
if (b->id == id) {
breakpoint_destroy(b);
if (!break_base) breakpoint_max_id = 0;
return(TCL_OK);
}
}
Tcl_SetResult(interp,"no such breakpoint",TCL_STATIC);
return(TCL_ERROR);
}
}
b = breakpoint_new();
if (flageq("-regexp",argv[0],2)) {
argc--; argv++;
if ((argc > 0) && (b->re = TclRegComp(argv[0]))) {
savestr(&b->pat,argv[0]);
argc--; argv++;
} else {
breakpoint_fail("bad regular expression")
}
} else if (flageq("-glob",argv[0],2)) {
argc--; argv++;
if (argc > 0) {
savestr(&b->pat,argv[0]);
argc--; argv++;
} else {
breakpoint_fail("no pattern?");
}
} else if ((!(flageq("if",*argv,1)) && (!(flageq("then",*argv,1))))) {
char *colon;
char *linep;
colon = strchr(argv[0],':');
if (colon) {
*colon = '\0';
savestr(&b->file,argv[0]);
*colon = ':';
linep = colon + 1;
} else {
linep = argv[0];
}
if (TCL_OK == Tcl_GetInt(interp,linep,&b->line)) {
argc--; argv++;
print(interp,"setting breakpoints by line number is currently unimplemented - use patterns or expressions\n");
} else {
if (b->file) ckfree(b->file);
}
}
if (argc > 0) {
int do_if = FALSE;
if (flageq("if",argv[0],1)) {
argc--; argv++;
do_if = TRUE;
} else if (!flageq("then",argv[0],1)) {
do_if = TRUE;
}
if (do_if) {
if (argc < 1) {
breakpoint_fail("if what");
}
savestr(&b->expr,argv[0]);
argc--; argv++;
}
}
if (argc > 0) {
if (flageq("then",argv[0],1)) {
argc--; argv++;
}
if (argc < 1) {
breakpoint_fail("then what?");
}
savestr(&b->cmd,argv[0]);
}
sprintf(interp->result,"%d",b->id);
return(TCL_OK);
break_fail:
breakpoint_destroy(b);
Tcl_SetResult(interp,error_msg,TCL_STATIC);
return(TCL_ERROR);
}
static char *help[] = {
"s [#] step into procedure",
"n [#] step over procedure",
"N [#] step over procedures, commands, and arguments",
"c continue",
"r continue until return to caller",
"u [#] move scope up level",
"d [#] move scope down level",
" go to absolute frame if # is prefaced by \"#\"",
"w show stack (\"where\")",
"w -w [#] show/set width",
"w -c [0|1] show/set compress",
"b show breakpoints",
"b [-r regexp-pattern] [if expr] [then command]",
"b [-g glob-pattern] [if expr] [then command]",
"b [[file:]#] [if expr] [then command]",
" if pattern given, break if command resembles pattern",
" if # given, break on line #",
" if expr given, break if expr true",
" if command given, execute command at breakpoint",
"b -# delete breakpoint",
"b - delete all breakpoints",
0};
static
int
cmdHelp(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
char **hp;
for (hp=help;*hp;hp++) {
print(interp,"%s\n",*hp);
}
return(TCL_OK);
}
#define PAD 80
static void
print TCL_VARARGS_DEF(Tcl_Interp *,arg1)
{
Tcl_Interp *interp;
char *fmt;
va_list args;
interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
fmt = va_arg(args,char *);
if (!printproc) vprintf(fmt,args);
else {
static int buf_width_max = DEFAULT_WIDTH+PAD;
static char buf_basic[DEFAULT_WIDTH+PAD+1];
static char *buf = buf_basic;
if (buf_width+PAD > buf_width_max) {
if (buf && (buf != buf_basic)) ckfree(buf);
buf = (char *)ckalloc(buf_width+PAD+1);
buf_width_max = buf_width+PAD;
}
vsprintf(buf,fmt,args);
(*printproc)(interp,buf,printdata);
}
va_end(args);
}
Dbg_InterStruct
Dbg_Interactor(interp,inter_proc,data)
Tcl_Interp *interp;
Dbg_InterProc *inter_proc;
ClientData data;
{
Dbg_InterStruct tmp;
tmp.func = interactor;
tmp.data = interdata;
interactor = (inter_proc?inter_proc:simple_interactor);
interdata = data;
return tmp;
}
Dbg_IgnoreFuncsProc *
Dbg_IgnoreFuncs(interp,proc)
Tcl_Interp *interp;
Dbg_IgnoreFuncsProc *proc;
{
Dbg_IgnoreFuncsProc *tmp = ignoreproc;
ignoreproc = (proc?proc:zero);
return tmp;
}
Dbg_OutputStruct
Dbg_Output(interp,proc,data)
Tcl_Interp *interp;
Dbg_OutputProc *proc;
ClientData data;
{
Dbg_OutputStruct tmp;
tmp.func = printproc;
tmp.data = printdata;
printproc = proc;
printdata = data;
return tmp;
}
int
Dbg_Active(interp)
Tcl_Interp *interp;
{
return debugger_active;
}
char **
Dbg_ArgcArgv(argc,argv,copy)
int argc;
char *argv[];
int copy;
{
char **alloc;
main_argc = argc;
if (!copy) {
main_argv = argv;
alloc = 0;
} else {
main_argv = alloc = (char **)ckalloc((argc+1)*sizeof(char *));
while (argc-- >= 0) {
*main_argv++ = *argv++;
}
main_argv = alloc;
}
return alloc;
}
static struct cmd_list {
char *cmdname;
Tcl_CmdProc *cmdproc;
enum debug_cmd cmdtype;
} cmd_list[] = {
{"n", cmdNext, next},
{"s", cmdNext, step},
{"N", cmdNext, Next},
{"c", cmdSimple, cont},
{"r", cmdSimple, ret},
{"w", cmdWhere, none},
{"b", cmdBreak, none},
{"u", cmdDir, up},
{"d", cmdDir, down},
{"h", cmdHelp, none},
{0}
};
static int zero(interp,string)
Tcl_Interp *interp;
char *string;
{
return 0;
}
static int
simple_interactor(interp)
Tcl_Interp *interp;
{
int rc;
char *ccmd;
char line[BUFSIZ+1];
int newcmd = TRUE;
Interp *iPtr = (Interp *)interp;
Tcl_DString dstring;
Tcl_DStringInit(&dstring);
newcmd = TRUE;
while (TRUE) {
struct cmd_list *c;
if (newcmd) {
#if TCL_MAJOR_VERSION < 8
print(interp,"dbg%d.%d> ",iPtr->numLevels,iPtr->curEventNum+1);
#else
static int nextid = 0;
char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0);
if (nextidstr) {
sscanf(nextidstr,"%d",&nextid);
}
print(interp,"dbg%d.%d> ",iPtr->numLevels,nextid++);
#endif
} else {
print(interp,"dbg+> ");
}
fflush(stdout);
if (0 >= (rc = read(0,line,BUFSIZ))) {
if (!newcmd) line[0] = 0;
else exit(0);
} else line[rc] = '\0';
ccmd = Tcl_DStringAppend(&dstring,line,rc);
if (!Tcl_CommandComplete(ccmd)) {
newcmd = FALSE;
continue;
}
newcmd = TRUE;
if ((ccmd[0] == '\n' || ccmd[0] == '\r') && ccmd[1] == '\0') {
for (c = cmd_list;c->cmdname;c++) {
if (c->cmdtype == last_action_cmd) break;
}
Tcl_DStringAppend(&dstring,c->cmdname,-1);
if (c->cmdtype == step ||
c->cmdtype == next ||
c->cmdtype == Next) {
char num[10];
sprintf(num," %d",last_step_count);
Tcl_DStringAppend(&dstring,num,-1);
}
}
#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION < 4
rc = Tcl_RecordAndEval(interp,ccmd,0);
#else
rc = Tcl_RecordAndEval(interp,ccmd,TCL_NO_EVAL);
rc = Tcl_Eval(interp,ccmd);
#endif
Tcl_DStringFree(&dstring);
switch (rc) {
case TCL_OK:
if (*interp->result != 0)
print(interp,"%s\n",interp->result);
continue;
case TCL_ERROR:
print(interp,"%s\n",Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY));
continue;
case TCL_BREAK:
case TCL_CONTINUE:
#define finish(x) {rc = x; goto done;}
finish(rc);
case TCL_RETURN:
finish(TCL_OK);
default:
print(interp,"error %d: %s\n",rc,ccmd);
continue;
}
}
done:
Tcl_DStringFree(&dstring);
return(rc);
}
static char init_auto_path[] = "lappend auto_path $dbg_library";
static void
init_debugger(interp)
Tcl_Interp *interp;
{
struct cmd_list *c;
for (c = cmd_list;c->cmdname;c++) {
Tcl_CreateCommand(interp,c->cmdname,c->cmdproc,
(ClientData)&c->cmdtype,(Tcl_CmdDeleteProc *)0);
}
debug_handle = Tcl_CreateTrace(interp,
10000,debugger_trap,(ClientData)0);
debugger_active = TRUE;
Tcl_SetVar2(interp,Dbg_VarName,"active","1",0);
#ifdef DBG_SCRIPTDIR
Tcl_SetVar(interp,"dbg_library",DBG_SCRIPTDIR,0);
#endif
Tcl_Eval(interp,init_auto_path);
}
void
Dbg_On(interp,immediate)
Tcl_Interp *interp;
int immediate;
{
if (!debugger_active) init_debugger(interp);
debug_cmd = step;
step_count = 1;
if (immediate) {
static char *fake_cmd = "--interrupted-- (command_unknown)";
debugger_trap((ClientData)0,interp,-1,fake_cmd,(int (*)())0,
(ClientData)0,1,&fake_cmd);
}
}
void
Dbg_Off(interp)
Tcl_Interp *interp;
{
struct cmd_list *c;
if (!debugger_active) return;
for (c = cmd_list;c->cmdname;c++) {
Tcl_DeleteCommand(interp,c->cmdname);
}
Tcl_DeleteTrace(interp,debug_handle);
debugger_active = FALSE;
Tcl_UnsetVar(interp,Dbg_VarName,TCL_GLOBAL_ONLY);
}