diff -Nu tcl845/tcl8.4.5/generic/atkdebugger.h tcldebug/tcl8.4.5/generic/atkdebugger.h --- tcl845/tcl8.4.5/generic/atkdebugger.h 1970-01-01 01:00:00.000000000 +0100 +++ tcldebug/tcl8.4.5/generic/atkdebugger.h 2004-01-03 11:46:04.000000000 +0100 @@ -0,0 +1,45 @@ +/* the main debugstructure */ + +#define atkdebugger 1 + +typedef int (ATKDebugProcedure) (Tcl_Interp *interp,int wasError); +typedef int (ATKCheckBreakpointsProcedure) (Tcl_Interp *interp,int isEnterProcMode); + +enum DebugMode {none,stepInto,stepOver,returnProc}; + +// struct ExceptionRange; +struct CallFrame; +struct Proc; + +typedef struct DebugData { + Tcl_Obj *debugproc; + int debugLevel; + ATKDebugProcedure *debugEntryProc; + int debugMode; + char *debugpc; /* PC of Frame of debug level */ + struct CallFrame *debugFrame; /* Important for stepOver command. */ + /* Break only in one interseting frame */ + int isActive; /* Central switch for atkdebugger. Let set debugger off */ + ATKCheckBreakpointsProcedure *checkBreakpointsProc; /* Procedure for checking eventual */ + /* breakpoints in procedure. Is called one */ + /* by entering procedure than if breakpoint */ + /* in procedure exists for every pc */ + Tcl_HashTable breakpointsTable; + int breakpointsCounter; + int debugByError; /* switch. If invoke debugger in error case */ + + int wasError; /* switch. If debugger is entered in error case. */ + /* This switch is true It is used by api procedure atk::wasError */ + + /* Following structures are set by global evaluation + and are using to compute execution place in global context */ + + void *codePtr; /* codePtr for byte coded evaluation object in global context */ + + CONST char *script; /* First character in script containing + * command (must be <= command). */ + CONST char *command; /* First character in command that + * generated the error. */ + int length; /* Number of bytes in command (-1 means + * use all bytes up to first null byte). */ +} DebugData; diff -Nu tcl845/tcl8.4.5/generic/tclBasic.c tcldebug/tcl8.4.5/generic/tclBasic.c --- tcl845/tcl8.4.5/generic/tclBasic.c 2003-10-10 04:08:45.000000000 +0200 +++ tcldebug/tcl8.4.5/generic/tclBasic.c 2004-01-03 11:46:04.000000000 +0100 @@ -378,6 +378,10 @@ * variable). */ + /* atkdebugger */ +#ifdef atkdebugger + iPtr->debugStruct = NULL; +#endif iPtr->execEnvPtr = TclCreateExecEnv(interp); /* @@ -3182,6 +3186,7 @@ int i; int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); + for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) { if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) { /* @@ -3218,7 +3223,7 @@ code = TCL_ERROR; } } - + if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) { /* @@ -3612,6 +3617,7 @@ } Tcl_ResetResult(interp); + savedVarFramePtr = iPtr->varFramePtr; if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = NULL; @@ -3637,6 +3643,32 @@ code = TCL_ERROR; goto error; } +#ifdef atkdebugger + if (iPtr->debugStruct && iPtr->debugStruct->debugLevel==-1) { + /* see computing data for Tcl_LogCommandInfo below */ + commandLength = parse.commandSize; + if (parse.term == parse.commandStart + commandLength - 1) { + commandLength -= 1; + } + if (iPtr->varFramePtr==NULL) { + iPtr->debugStruct->script = script; + iPtr->debugStruct->command = parse.commandStart; + iPtr->debugStruct->length = commandLength; + } else { + iPtr->varFramePtr->script = script; + iPtr->varFramePtr->command = parse.commandStart; + iPtr->varFramePtr->length = commandLength; + } + } + if (iPtr->debugStruct && iPtr->debugStruct->debugLevel==-1 && + iPtr->debugStruct->isActive && + (enum DebugMode)iPtr->debugStruct->debugMode!=none) { + if ((enum DebugMode)iPtr->debugStruct->debugMode!=stepOver || + iPtr->debugStruct->debugFrame==iPtr->varFramePtr) + (iPtr->debugStruct->debugEntryProc)(interp,0); + } +#endif + gotParse = 1; if (nested && parse.term == (script + numBytes)) { @@ -3883,7 +3915,6 @@ * object system in Tcl 8.0, we have to mirror the object result * back into the string result (some callers may expect it there). */ - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), TCL_VOLATILE); return code; diff -Nu tcl845/tcl8.4.5/generic/tclExecute.c tcldebug/tcl8.4.5/generic/tclExecute.c --- tcl845/tcl8.4.5/generic/tclExecute.c 2003-09-24 17:45:49.000000000 +0200 +++ tcldebug/tcl8.4.5/generic/tclExecute.c 2004-01-03 11:46:04.000000000 +0100 @@ -361,7 +361,7 @@ #endif /* TCL_COMPILE_DEBUG */ static ExceptionRange * GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc, int catchOnly, ByteCode* codePtr)); -static char * GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc, +char * GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc, ByteCode* codePtr, int *lengthPtr)); static void GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr)); static void IllegalExprOperandType _ANSI_ARGS_(( @@ -1132,6 +1132,22 @@ * Loop executing instructions until a "done" instruction, a * TCL_RETURN, or some error. */ + +#ifdef atkdebugger + /* atkdebugger */ + if (varFramePtr) { + varFramePtr->catchTop=&catchTop; + varFramePtr->breakpointHandle=NULL; + } + /* search breakpoints for this proc */ + if (varFramePtr!=NULL && iPtr->debugStruct + && iPtr->debugStruct->isActive + && iPtr->debugStruct->debugLevel==-1 + && varFramePtr->isProcCallFrame) { + iPtr->debugStruct->wasError=0; + (iPtr->debugStruct->checkBreakpointsProc)(interp,1); + } +#endif goto cleanup0; @@ -1193,7 +1209,48 @@ } cleanup0: - + +#ifdef atkdebugger + /* atkdebugger - hier wird es immer wieder nach jedem ByteComp geloopt */ + if (iPtr->debugStruct && iPtr->debugStruct->debugLevel==-1) { + if (varFramePtr!=NULL) { + varFramePtr->pc = pc; + varFramePtr->script = NULL; + varFramePtr->codePtr = codePtr; + } else { + iPtr->debugStruct->codePtr = codePtr; + iPtr->debugStruct->debugpc = pc; + iPtr->debugStruct->script = NULL; + } + } + + if (iPtr->debugStruct && iPtr->debugStruct->isActive && iPtr->debugStruct->debugLevel==-1) { + // Check if we are await breakpoint in this procedure + if (varFramePtr!=NULL && varFramePtr->isProcCallFrame + && varFramePtr->breakpointHandle) { + (iPtr->debugStruct->checkBreakpointsProc)(interp,0); + } + if ((enum DebugMode)iPtr->debugStruct->debugMode!=none) { + // fprintf(stdout,"entering debugroc %p %i\n",pc,*pc); + if ((*pc)!=INST_PUSH1 && + (*pc)!=INST_PUSH4 && + (*pc)!=INST_POP && + (*pc)!=INST_DONE && + ((*pc)INST_LOAD_STK) && + ((*pc)INST_TRY_CVT_TO_NUMERIC) + ) { + // if there are stepOver mode we are interested only in own frame + if ((enum DebugMode)iPtr->debugStruct->debugMode!=stepOver || + iPtr->debugStruct->debugFrame==varFramePtr) { + DECACHE_STACK_INFO(); + (iPtr->debugStruct->debugEntryProc)(interp,0); + CACHE_STACK_INFO(); + } + } + } + } +#endif + #ifdef TCL_COMPILE_DEBUG ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop); if (traceInstructions) { @@ -4188,6 +4245,19 @@ */ abnormalReturn: +#ifdef atkdebugger + /* atkdebugger - inoke debugger if not catched error */ + if (result == TCL_ERROR && iPtr->debugStruct && iPtr->debugStruct->debugLevel==-1 && iPtr->debugStruct->debugByError && iPtr->debugStruct->wasError==0) { + /* search if catch in upper frames will be make in the extension procedure */ + DECACHE_STACK_INFO(); + (iPtr->debugStruct->debugEntryProc)(interp,1); + CACHE_STACK_INFO(); + } + /* change stepOver to stepInto if exists */ + if (result != TCL_ERROR && iPtr->debugStruct && iPtr->debugStruct->debugLevel==-1 && iPtr->debugStruct->debugMode==stepOver && iPtr->debugStruct->debugFrame==varFramePtr) { + iPtr->debugStruct->debugMode=stepInto; + } +#endif while (stackTop > initStackTop) { valuePtr = POP_OBJECT(); TclDecrRefCount(valuePtr); @@ -4508,8 +4578,7 @@ *---------------------------------------------------------------------- */ -static char * -GetSrcInfoForPc(pc, codePtr, lengthPtr) +char * GetSrcInfoForPc(pc, codePtr, lengthPtr) unsigned char *pc; /* The program counter value for which to * return the closest command's source info. * This points to a bytecode instruction diff -Nu tcl845/tcl8.4.5/generic/tcl.h tcldebug/tcl8.4.5/generic/tcl.h --- tcl845/tcl8.4.5/generic/tcl.h 2003-10-23 00:42:30.000000000 +0200 +++ tcldebug/tcl8.4.5/generic/tcl.h 2004-01-03 11:46:04.000000000 +0100 @@ -19,6 +19,9 @@ #ifndef _TCL #define _TCL +/* atkdebugger */ +#define atkdebugger 1 + /* * For C++ compilers, use extern "C" */ @@ -912,6 +915,16 @@ char *dummy8; int dummy9; char* dummy10; +#ifdef atkdebugger + /* atkdebugger */ + void *dummy11; + char *dummy12; + char *dummy13; + char *dummy14; + int dummy15; + int *dummy16; + void *dummy17; +#endif } Tcl_CallFrame; diff -Nu tcl845/tcl8.4.5/generic/tclInt.h tcldebug/tcl8.4.5/generic/tclInt.h --- tcl845/tcl8.4.5/generic/tclInt.h 2003-05-11 00:42:22.000000000 +0200 +++ tcldebug/tcl8.4.5/generic/tclInt.h 2004-01-03 11:46:04.000000000 +0100 @@ -32,6 +32,10 @@ #include "tcl.h" #endif +#ifdef atkdebugger +#include "atkdebugger.h" +#endif + #include #include @@ -756,6 +760,21 @@ * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ +#ifdef atkdebugger + /* atkdebugger this information are needed to compute run place of depper + levels (frames). They are stored internal in tcl procuderus on stack */ + void *codePtr; + char *pc; + CONST char *script; /* First character in script containing + * command (must be <= command). */ + CONST char *command; /* First character in command that + * generated the error. */ + int length; /* Number of bytes in command (-1 means + * use all bytes up to first null byte). */ + /* ExceptionRange *rangePtr; */ + int *catchTop; + void *breakpointHandle; +#endif } CallFrame; /* @@ -1315,6 +1334,10 @@ ByteCodeStats stats; /* Holds compilation and execution * statistics for this interpreter. */ #endif /* TCL_COMPILE_STATS */ +#ifdef atkdebugger + /* atkdebugger */ + DebugData *debugStruct; +#endif } Interp; /*