dbg.c

Linux下的tcl语言调试器

    argv[argc] = NULL;
    return(print_argv(interp,argc,argv));
}
#endif

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) {
		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;	/* current FramePtr */
CallFrame *viewf;	/* view FramePtr */
int argc;
char *argv[];
char *level;
{
	PrintStackBelow(interp,curf,viewf);
	
	print(interp," %s: %s\n",level,print_argv(interp,argc,argv));
}

/* return 0 if goal matches current frame or goal can't be found */
/*	anywere in frame stack */
/* else return 1 */
/* This catches things like a proc called from a Tcl_Eval which in */
/* turn was not called from a proc but some builtin such as source */
/* or Tcl_Eval.  These builtin calls to Tcl_Eval lose any knowledge */
/* the FramePtr from the proc, so we have to search the entire */
/* stack frame to see if it's still there. */
static int
GoalFrame(goal,iptr)
CallFrame *goal;
Interp *iptr;
{
	CallFrame *cf = iptr->varFramePtr;

	/* if at current level, return success immediately */
	if (goal == cf) return 0;

	while (cf) {
		cf = cf->callerVarPtr;
		if (goal == cf) {
			/* found, but since it's above us, fail */
			return 1;
		}
	}
	return 0;
}

static char *cmd_print(cmdtype)
enum debug_cmd cmdtype;
{
	switch (cmdtype) {
	case none:  return "cmd: none";
	case step:  return "cmd: step";
	case next:  return "cmd: next";
	case ret:   return "cmd: ret";
	case cont:  return "cmd: cont";
	case up:    return "cmd: up";
	case down:  return "cmd: down";
	case where: return "cmd: where";
	case Next:  return "cmd: Next";
	}
	return "cmd: Unknown";
}

/* debugger's trace handler */
/*ARGSUSED*/
static void
debugger_trap(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;		/* not used */
Tcl_Interp *interp;
int level;			/* positive number if called by Tcl, -1 if */
				/* called by Dbg_On in which case we don't */
				/* know the level */
char *command;
int (*cmdProc)();		/* not used */
ClientData cmdClientData;
int argc;
char *argv[];
{
	char level_text[6];	/* textual representation of level */

	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;

	/* if level is unknown, use "?" */
	sprintf(level_text,(level == -1)?"?":"%d",level);

	/* save so we can restore later */
	trueFramePtr = iPtr->varFramePtr;

	/* do not allow breaking while testing breakpoints */
	debug_suspended = TRUE;

	/* test all breakpoints to see if we should break */
	/* 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 (break_status) {
		if (!debug_new_action) {
			goto start_interact;
		}

		/* if s or n triggered by breakpoint, make "s 1" */
		/* (and so on) refer to next command, not this one */
		/* step_count++;*/
		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:
		/* check if we are back at the same level where the next */
		/* command was issued.  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;*/
		if (GoalFrame(goalFramePtr,iPtr)) goto finish;
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case Next:
		/* check if we are back at the same level where the next */
		/* command was issued.  */
		if (goalNumLevel < iPtr->numLevels) goto finish;
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case ret:
		/* same comment as in "case next" */
		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;
	}
	/* since user is typing a command, don't interrupt it immediately */
	debug_cmd = cont;
	debug_suspended = TRUE;

	/* interactor won't return until user gives a debugger cmd */
	(*interactor)(interp,interdata);
end_interact:

	/* 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)) {
			print(interp,"%s\n",interp->result);
			Tcl_ResetResult(interp);
		}
		goto start_interact;
	}

	/* reset view back to normal */
	iPtr->varFramePtr = trueFramePtr;

#if 0
	/* allow trapping */
	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;
	}

	/* restore view and restart interactor */
	iPtr->varFramePtr = viewFramePtr;
	goto start_interact;

 finish:
	debug_suspended = FALSE;
}

/*ARGSUSED*/
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);
}

/*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_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) Tcl_DecrRefCount(b->file);
	if (b->pat) Tcl_DecrRefCount(b->pat);
	if (b->cmd) Tcl_DecrRefCount(b->cmd);
	if (b->expr) Tcl_DecrRefCount(b->expr);

	/* 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;
	}

	ckfree((char *)b);
}

static void
savestr(objPtr,str)
Tcl_Obj **objPtr;
char *str;
{
    *objPtr = Tcl_NewStringObj(str, -1);
    Tcl_IncrRefCount(*objPtr);
}

/* return 1 if a string is substring of a flag */
static 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 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;}

/*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(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)) {