This is Dbg.c in view mode; [Download] [Up]
/* Dbg.c - Tcl Debugger - See cmdHelp() for commands
Written by: Don Libes, NIST, 3/23/93
Design and implementation of this program was paid for by U.S. tax
dollars. Therefore it is public domain. However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/
#include "tclInt.h"
#include "Dbg.h"
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
static int simple_interactor();
static int zero();
/* most of the static variables in this file may be */
/* moved into Tcl_Interp */
static Dbg_InterProc *interactor = simple_interactor;
static Dbg_IgnoreFuncsProc *ignoreproc = zero;
static int debugger_active = FALSE;
char *debug_varname = "dbg";
#define DEFAULT_COMPRESS 0
static int compress = DEFAULT_COMPRESS;
#define DEFAULT_WIDTH 75 /* leave a little space for printing */
/* stack level */
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; /* count next/step */
#define FRAMENAMELEN 10 /* enough to hold strings like "#4" */
static char viewFrameName[FRAMENAMELEN];/* destination frame name for up/down */
static CallFrame *goalFramePtr; /* destination for next/return */
static enum debug_cmd {
step, next, ret, cont, up, down, where
} debug_cmd;
/* this acts as a strobe (while testing breakpoints). It is set to true */
/* every time a new debugger command is issued that is an action */
static debug_new_action;
#define NO_LINE -1 /* if break point is not set by line number */
struct breakpoint {
int id;
char *file; /* file where breakpoint is */
int line; /* line where breakpoint is */
char *pat; /* pattern defining where breakpoint can be */
regexp *re; /* regular expression to trigger breakpoint */
char *expr; /* expr to trigger breakpoint */
char *cmd; /* cmd to eval at breakpoint */
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(b)
struct breakpoint *b;
{
printf("breakpoint %d: ",b->id);
if (b->re) {
printf("-re \"%s\" ",b->pat);
} else if (b->pat) {
printf("-glob \"%s\" ",b->pat);
} else if (b->line != NO_LINE) {
if (b->file) {
printf("%s:",b->file);
}
printf("%d ",b->line);
}
if (b->expr)
printf("if {%s} ",b->expr);
if (b->cmd)
printf("then {%s}",b->cmd);
putchar('\n');
}
void
save_re_matches(interp,re)
Tcl_Interp *interp;
regexp *re;
{
int i;
char name[20];
char match_char;/* place to hold char temporarily */
/* uprooted by a NULL */
for (i=0;i<NSUBEXP;i++) {
if (re->startp[i] == 0) break;
sprintf(name,"%d",i);
/* temporarily null-terminate in middle */
match_char = *re->endp[i];
*re->endp[i] = 0;
Tcl_SetVar2(interp,debug_varname,name,re->startp[i],0);
/* undo temporary null-terminator */
*re->endp[i] = match_char;
}
}
/* return 1 to break, 0 to continue */
static int
breakpoint_test(interp,cmd,bp)
Tcl_Interp *interp;
char *cmd; /* command about to be executed */
struct breakpoint *bp; /* breakpoint to test */
{
if (bp->re) {
if (0 == regexec(bp->re,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) {
/* not yet implemented - awaiting support from Tcl */
return 0;
}
if (bp->expr) {
int value;
/* ignore errors, since they are likely due to */
/* simply being out of scope a lot */
if (TCL_OK != Tcl_ExprBoolean(interp,bp->expr,&value)) return 0;
}
if (bp->cmd) {
#if TCL_MAJOR_VERSION == 6
Tcl_Eval(interp,bp->cmd,0,(char **)0);
#else
Tcl_Eval(interp,bp->cmd);
#endif
} else {
breakpoint_print(bp);
}
return 1;
}
static char *already_at_top_level = "already at top level";
/* similar to TclGetFrame but takes two frame ptrs and a direction.
If direction is up, search up stack from curFrame
If direction is down, simulate searching down stack by
seaching up stack from origFrame
*/
static
int
TclGetFrame2(interp, origFramePtr, string, framePtrPtr, dir)
Tcl_Interp *interp;
CallFrame *origFramePtr; /* frame that is true top-of-stack */
char *string; /* String describing frame. */
CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL
* if global frame indicated). */
enum debug_cmd dir; /* look up or down the stack */
{
Interp *iPtr = (Interp *) interp;
int level, result;
CallFrame *framePtr; /* frame currently being searched */
CallFrame *curFramePtr = iPtr->varFramePtr;
/*
* Parse string to figure out which level number to go to.
*/
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; /* start search here */
} 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; /* start search here */
} else {
if (curFramePtr != 0) {
level = curFramePtr->level + level;
}
framePtr = origFramePtr; /* start search here */
}
} else {
level = curFramePtr->level - 1;
result = 0;
}
/*
* Figure out which frame to use.
*/
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; /* ptr into dest */
unsigned int need;
static char buf_basic[DEFAULT_WIDTH+1];
static char *dest = buf_basic;
if (s == 0) return("<null>");
/* worst case is every character takes 4 to printify */
need = strlen(s)*4;
if (need > destlen) {
if (dest && (dest != buf_basic)) free(dest);
dest = ckalloc(need+1);
destlen = need;
}
for (d = dest;*s;s++) {
/* since we check at worst by every 4 bytes, play */
/* conservative and subtract 4 from the limit */
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) { /* unsigned strips parity */
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]; /* basic buffer */
static char *buf = buf_basic;
int space; /* space remaining in buf */
int len;
char *bufp;
int proc; /* if current command is "proc" */
int arg_index;
if (buf_width > buf_width_max) {
if (buf && (buf != buf_basic)) free(buf);
buf = malloc(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;
/* braces/quotes have been stripped off arguments */
/* so put them back. We wrap everything except lists */
/* with one argument. One exception is to always wrap */
/* proc's 2nd arg (the arg list), since people are */
/* used to always seeing it this way. */
if (proc && (arg_index > 1)) wrap = TRUE;
else {
(void) TclFindElement(interp,*argv,&elementPtr,
&nextPtr,(int *)0,(int *)0);
if (*elementPtr == '\0') wrap = TRUE;
else if (*nextPtr == '\0') wrap = FALSE;
else wrap = TRUE;
}
/* wrap lists (or null) in braces */
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) {
/* this copies from our static buf to printify's static buf */
/* and back to our static buf */
strncpy(buf,printify(buf),buf_width);
}
/* usually but not always right, but assume truncation if buffer is */
/* full. this avoids tiny but odd-looking problem of appending "}" */
/* to truncated lists during {}-wrapping earlier */
if (strlen(buf) == buf_width) {
buf[buf_width-1] = buf[buf_width-2] = buf[buf_width-3] = '.';
}
return(buf);
}
static
void
PrintStackBelow(interp,curf,viewf)
Tcl_Interp *interp;
CallFrame *curf; /* current FramePtr */
CallFrame *viewf; /* view FramePtr */
{
char ptr; /* graphically indicate where we are in the stack */
/* indicate where we are in the stack */
ptr = ((curf == viewf)?'*':' ');
if (curf == 0) {
printf("%c0: %s\n",ptr,print_argv(interp,main_argc,main_argv));
} else {
PrintStackBelow(interp,curf->callerVarPtr,viewf);
printf("%c%d: %s\n",ptr,curf->level,
print_argv(interp,curf->argc,curf->argv));
}
}
static
void
PrintStack(interp,curf,viewf,argc,argv,level)
Tcl_Interp *interp;
CallFrame *curf; /* current FramePtr */
CallFrame *viewf; /* view FramePtr */
int argc;
char *argv[];
{
PrintStackBelow(interp,curf,viewf);
printf(" %d: %s\n",level,print_argv(interp,argc,argv));
}
/* debugger's trace handler */
/*ARGSUSED*/
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[];
{
int break_status;
Interp *iPtr = (Interp *)interp;
CallFrame *trueFramePtr; /* where the pc is */
CallFrame *viewFramePtr; /* where up/down are */
int print_command_first_time = TRUE;
static int debug_suspended = FALSE;
struct breakpoint *b;
/* skip commands that are invoked interactively */
if (debug_suspended) return;
/* skip debugger commands */
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;
/* save so we can restore later */
trueFramePtr = iPtr->varFramePtr;
/* test all breakpoints to see if we should break */
debug_suspended = TRUE;
/* if any successful breakpoints, start interactor */
debug_new_action = FALSE; /* reset strobe */
break_status = FALSE; /* no successful breakpoints yet */
for (b = break_base;b;b=b->next) {
break_status |= breakpoint_test(interp,command,b);
}
if (!debug_new_action && break_status) goto start_interp;
/* if s or n triggered by breakpoint, make "s 1" (and so on) */
/* refer to next command, not this one */
if (debug_new_action) step_count++;
switch (debug_cmd) {
case cont:
goto finish;
case step:
step_count--;
if (step_count > 0) goto finish;
goto start_interp;
case next:
/* check if we are back at the same level where the next */
/* command was issued. Might be wise to also test */
/* against all FramePtrs and if no match, assume that */
/* we've missed a return, and so we should break */
if (goalFramePtr != iPtr->varFramePtr) goto finish;
step_count--;
if (step_count > 0) goto finish;
goto start_interp;
case ret:
/* same comment as in "case next" */
if (goalFramePtr != iPtr->varFramePtr) goto finish;
goto start_interp;
}
start_interp:
if (print_command_first_time) {
printf("%d: %s\n",level,print_argv(interp,1,&command));
print_command_first_time = FALSE;
}
/* since user is typing a command, don't interrupt it immediately */
debug_cmd = cont;
debug_suspended = FALSE;
/* interactor won't return until user gives a debugger cmd */
interactor(interp);
/* save this so it can be restored after "w" command */
viewFramePtr = iPtr->varFramePtr;
if (debug_cmd == up || debug_cmd == down) {
/* calculate new frame */
if (-1 == TclGetFrame2(interp,trueFramePtr,viewFrameName,
&iPtr->varFramePtr,debug_cmd)) {
printf("%s\n",interp->result);
Tcl_ResetResult(interp);
}
goto start_interp;
}
/* reset view back to normal */
iPtr->varFramePtr = trueFramePtr;
/* allow trapping */
debug_suspended = FALSE;
switch (debug_cmd) {
case cont:
case step:
goto finish;
case next:
goalFramePtr = iPtr->varFramePtr;
goto finish;
case ret:
goalFramePtr = iPtr->varFramePtr;
if (goalFramePtr == 0) {
printf("nowhere to return to\n");
break;
}
goalFramePtr = goalFramePtr->callerVarPtr;
goto finish;
case where:
PrintStack(interp,iPtr->varFramePtr,viewFramePtr,argc,argv,level);
break;
}
/* restore view and restart interactor */
iPtr->varFramePtr = viewFramePtr;
goto start_interp;
finish:
debug_suspended = FALSE;
}
/*ARGSUSED*/
static
int
cmdNext(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
debug_cmd = (enum debug_cmd)clientData;
debug_new_action = TRUE;
step_count = (argc == 1)?1:atoi(argv[1]);
return(TCL_RETURN);
}
/*ARGSUSED*/
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;
}
/*ARGSUSED*/
static
int
cmdSimple(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
debug_cmd = (enum debug_cmd)clientData;
debug_new_action = TRUE;
return TCL_RETURN;
}
static
void
breakpoint_destroy(b)
struct breakpoint *b;
{
if (b->file) free(b->file);
if (b->pat) free(b->pat);
if (b->re) free((char *)b->re);
if (b->cmd) free(b->cmd);
/* unlink from chain */
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;
}
free((char *)b);
}
static void
savestr(straddr,str)
char **straddr;
char *str;
{
*straddr = ckalloc(strlen(str)+1);
strcpy(*straddr,str);
}
/* return 1 if a string is substring of a flag */
int flageq(flag,string,minlen)
char *flag;
char *string;
int minlen; /* at least this many chars must match */
{
for (;*flag;flag++,string++,minlen--) {
if (*string == '\0') break;
if (*string != *flag) return 0;
}
if (*string == '\0' && minlen <= 0) return 1;
return 0;
}
/*ARGSUSED*/
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 printf("%d\n",buf_width);
} else if (flageq("-compress",*argv,2)) {
argc--; argv++;
if (*argv) {
compress = atoi(*argv);
argc--; argv++;
} else printf("%d\n",compress);
} else {
printf("usage: w [-width #] [-compress 0|1]\n");
return TCL_ERROR;
}
}
return TCL_OK;
}
#define breakpoint_fail(msg) {error_msg = msg; goto break_fail;}
/*ARGSUSED*/
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(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 = regcomp(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))))) {
/* look for [file:]line */
char *colon;
char *linep; /* pointer to beginning of line number */
colon = strchr(argv[0],':');
if (colon) {
*colon = '\0';
savestr(&b->file,argv[0]);
*colon = ':';
linep = colon + 1;
} else {
linep = argv[0];
/* get file from current scope */
/* savestr(&b->file, ?); */
}
if (TCL_OK == Tcl_GetInt(interp,linep,&b->line)) {
argc--; argv++;
printf("setting breakpoints by line number is currently unimplemented - use patterns or expressions\n");
} else {
/* not an int? - unwind & assume it is an expression */
if (b->file) free(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",
"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};
/*ARGSUSED*/
static
int
cmdHelp(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
char **hp;
for (hp=help;*hp;hp++) {
printf("%s\n",*hp);
}
return(TCL_OK);
}
/* this may seem excessive, but this avoids the explicit test for non-zero */
/* in the caller, and chances are that that test will always be pointless */
/*ARGSUSED*/
static int zero(interp,string)
Tcl_Interp *interp;
char *string;
{
return 0;
}
static int
simple_interactor(interp)
Tcl_Interp *interp;
{
int rc;
char *ccmd; /* pointer to complete command */
char line[BUFSIZ]; /* space for partial command */
int newcmd = TRUE;
Interp *iPtr = (Interp *)interp;
#if TCL_MAJOR_VERSION == 6
Tcl_CmdBuf buffer;
if (!(buffer = Tcl_CreateCmdBuf())) {
Tcl_AppendElement(interp,"no more space for cmd buffer",0);
return(TCL_ERROR);
}
#else
Tcl_DString dstring;
Tcl_DStringInit(&dstring);
#endif
newcmd = TRUE;
while (TRUE) {
if (newcmd) {
printf("dbg%d.%d> ",iPtr->numLevels,iPtr->curEventNum+1);
} else {
printf("dbg+> ");
}
fflush(stdout);
if (0 >= (rc = read(0,line,BUFSIZ))) {
if (!newcmd) line[0] = 0;
else exit(0);
} else line[rc] = '\0';
#if TCL_MAJOR_VERSION == 6
if (NULL == (ccmd = Tcl_AssembleCmd(buffer,line))) {
#else
ccmd = Tcl_DStringAppend(&dstring,line,rc);
if (!Tcl_CommandComplete(ccmd)) {
#endif
newcmd = FALSE;
continue; /* continue collecting command */
}
newcmd = TRUE;
switch (rc = Tcl_RecordAndEval(interp,ccmd,0)) {
case TCL_OK:
if (*interp->result != 0)
printf("%s\n",interp->result);
continue;
case TCL_ERROR:
printf("%s\n",Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY));
/* since user is typing by hand, we expect lots
of errors, and want to give another chance */
continue;
case TCL_BREAK:
case TCL_CONTINUE:
#define finish(x) {rc = x; goto done;}
finish(rc);
case TCL_RETURN:
finish(TCL_OK);
default:
/* note that ccmd has trailing newline */
printf("error %d: %s\n",rc,ccmd);
continue;
}
}
/* cannot fall thru here, must jump to label */
done:
#if TCL_MAJOR_VERSION == 6
/* currently, code guarantees buffer is valid */
Tcl_DeleteCmdBuf(buffer);
#else
Tcl_DStringFree(&dstring);
#endif
return(rc);
}
/*ARGSUSED*/
Dbg_InterProc *
Dbg_Interactor(interp,inter_proc)
Tcl_Interp *interp;
Dbg_InterProc *inter_proc;
{
Dbg_InterProc *tmp = interactor;
interactor = (inter_proc?inter_proc:simple_interactor);
return tmp;
}
/*ARGSUSED*/
Dbg_IgnoreFuncsProc *
Dbg_IgnoreFuncs(interp,proc)
Tcl_Interp *interp;
Dbg_IgnoreFuncsProc *proc;
{
Dbg_IgnoreFuncsProc *tmp = ignoreproc;
ignoreproc = (proc?proc:zero);
return tmp;
}
/*ARGSUSED*/
int
Dbg_Active(interp)
Tcl_Interp *interp;
{
return debugger_active;
}
char **
Dbg_ArgcArgv(argc,argv,copy)
int argc;
char *argv[];
int copy;
{
char **alloc;
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;
}
struct cmd_list {
char *cmdname;
Tcl_CmdProc *cmdproc;
enum debug_cmd cmdtype;
} cmd_list[] = {{"n", cmdNext, next},
{"s", cmdNext, step},
{"c", cmdSimple, cont},
{"r", cmdSimple, ret},
{"w", cmdWhere, 0},
{"b", cmdBreak, 0},
{"u", cmdDir, up},
{"d", cmdDir, down},
{"h", cmdHelp, 0},
{0}
};
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,debug_varname,"active","1",0);
}
/* allows any other part of the application to jump to the debugger */
/*ARGSUSED*/
void
Dbg_On(interp,immediate)
Tcl_Interp *interp;
int immediate; /* if true, stop immediately */
/* should only be used in safe places */
/* i.e., when Tcl_Eval can be called */
{
if (!debugger_active) init_debugger(interp);
debug_cmd = step;
step_count = 1;
if (immediate) {
interactor(interp);
}
}
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,debug_varname,TCL_GLOBAL_ONLY);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.