From de857ca207e4dceea586bf2dbfe497df4d9d02c8 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 10 Aug 2013 05:16:38 +0000 Subject: Arrange for both execution traces and [info frame] to get their pre-subst source strings from a common routine, with care taken to reduce copying by that routine. --- generic/tclBasic.c | 41 +++++++++++++++-------------------------- generic/tclCmdIL.c | 25 ++++++++++++++++++++++--- generic/tclExecute.c | 19 +++++++++++++++++-- generic/tclInt.h | 5 +++++ 4 files changed, 59 insertions(+), 31 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9755a21..1cd2eae 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3367,32 +3367,12 @@ GetCommandSource( int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr = NULL; CmdFrame *cfPtr = iPtr->cmdFramePtr; - if (cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) { - const char *command = NULL; - int numChars; - - switch (cfPtr->type) { - case TCL_LOCATION_EVAL: - case TCL_LOCATION_SOURCE: - command = cfPtr->cmd; - numChars = cfPtr->len; - break; - case TCL_LOCATION_BC: - case TCL_LOCATION_PREBC: - command = TclGetSrcInfoForCmd(iPtr, &numChars); - break; - } - if (command) { - objPtr = Tcl_NewStringObj(command, numChars); - } + if (cfPtr && (cfPtr->numLevels != iPtr->numLevels-1)) { + cfPtr = NULL; } - if (objPtr == NULL) { - objPtr = Tcl_NewListObj(objc, objv); - } - return objPtr; + return TclGetSourceFromFrame(cfPtr, objc, objv); } /* @@ -4678,6 +4658,7 @@ TEOV_RunEnterTraces( Tcl_Obj *commandPtr; commandPtr = GetCommandSource(iPtr, objc, objv); + Tcl_IncrRefCount(commandPtr); command = Tcl_GetStringFromObj(commandPtr, &length); /* @@ -5013,6 +4994,7 @@ TclEvalEx( eeFramePtr->nextPtr = iPtr->cmdFramePtr; eeFramePtr->nline = 0; eeFramePtr->line = NULL; + eeFramePtr->cmdObj = NULL; iPtr->cmdFramePtr = eeFramePtr; if (iPtr->evalFlags & TCL_EVAL_FILE) { @@ -5243,6 +5225,10 @@ TclEvalEx( eeFramePtr->line = NULL; eeFramePtr->nline = 0; + if (eeFramePtr->cmdObj) { + Tcl_DecrRefCount(eeFramePtr->cmdObj); + eeFramePtr->cmdObj = NULL; + } if (code != TCL_OK) { goto error; @@ -5983,7 +5969,6 @@ TclNREvalObjEx( Tcl_IncrRefCount(objPtr); listPtr = TclListObjCopy(interp, objPtr); Tcl_IncrRefCount(listPtr); - TclDecrRefCount(objPtr); if (word != INT_MIN) { /* @@ -6013,7 +5998,9 @@ TclNREvalObjEx( eoFramePtr->framePtr = iPtr->framePtr; eoFramePtr->nextPtr = iPtr->cmdFramePtr; - eoFramePtr->cmd = Tcl_GetStringFromObj(listPtr, &(eoFramePtr->len)); + eoFramePtr->cmdObj = objPtr; + eoFramePtr->cmd = NULL; + eoFramePtr->len = 0; eoFramePtr->data.eval.path = NULL; iPtr->cmdFramePtr = eoFramePtr; @@ -6021,7 +6008,7 @@ TclNREvalObjEx( TclMarkTailcall(interp); TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, - NULL, NULL); + objPtr, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); @@ -6156,6 +6143,7 @@ TEOEx_ListCallback( Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = data[0]; CmdFrame *eoFramePtr = data[1]; + Tcl_Obj *objPtr = data[2]; /* * Remove the cmdFrame @@ -6165,6 +6153,7 @@ TEOEx_ListCallback( iPtr->cmdFramePtr = eoFramePtr->nextPtr; TclStackFree(interp, eoFramePtr); } + TclDecrRefCount(objPtr); TclDecrRefCount(listPtr); return result; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 180d814..da9edd6 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1266,6 +1266,25 @@ InfoFrameCmd( */ Tcl_Obj * +TclGetSourceFromFrame( + CmdFrame *cfPtr, + int objc, + Tcl_Obj *const objv[]) +{ + if (cfPtr == NULL) { + return Tcl_NewListObj(objc, objv); + } + if (cfPtr->cmdObj == NULL) { + if (cfPtr->cmd == NULL) { + cfPtr->cmd = TclGetSrcInfoForCmdFrame(cfPtr, &cfPtr->len); + } + cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); + Tcl_IncrRefCount(cfPtr->cmdObj); + } + return cfPtr->cmdObj; +} + +Tcl_Obj * TclInfoFrame( Tcl_Interp *interp, /* Current interpreter. */ CmdFrame *framePtr) /* Frame to get info for. */ @@ -1307,7 +1326,7 @@ TclInfoFrame( } else { ADD_PAIR("line", Tcl_NewIntObj(1)); } - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd, framePtr->len)); + ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PREBC: @@ -1355,7 +1374,7 @@ TclInfoFrame( Tcl_DecrRefCount(fPtr->data.eval.path); } - ADD_PAIR("cmd", Tcl_NewStringObj(fPtr->cmd, fPtr->len)); + ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL)); TclStackFree(interp, fPtr); break; } @@ -1374,7 +1393,7 @@ TclInfoFrame( * the result list object. */ - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd, framePtr->len)); + ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PROC: diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f6072a1..d8ccf40 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2006,6 +2006,7 @@ TclNRExecuteByteCode( bcFramePtr->litarg = NULL; bcFramePtr->data.tebc.codePtr = codePtr; bcFramePtr->data.tebc.pc = NULL; + bcFramePtr->cmdObj = NULL; bcFramePtr->cmd = NULL; bcFramePtr->len = 0; @@ -2130,6 +2131,11 @@ TEBCresume( result = TCL_ERROR; } NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); + if (bcFramePtr->cmdObj) { + Tcl_DecrRefCount(bcFramePtr->cmdObj); + bcFramePtr->cmdObj = NULL; + bcFramePtr->cmd = NULL; + } iPtr->cmdFramePtr = bcFramePtr->nextPtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr); @@ -8761,7 +8767,14 @@ TclGetSrcInfoForCmd( Interp *iPtr, int *lenPtr) { - CmdFrame *cfPtr = iPtr->cmdFramePtr; + return TclGetSrcInfoForCmdFrame(iPtr->cmdFramePtr, lenPtr); +} + +const char * +TclGetSrcInfoForCmdFrame( + CmdFrame *cfPtr, + int *lenPtr) +{ ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, @@ -8775,11 +8788,13 @@ TclGetSrcInfoForPc( ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; assert(cfPtr->type == TCL_LOCATION_BC); - assert(cfPtr->cmd == NULL); + + if (cfPtr->cmd == NULL) { cfPtr->cmd = GetSrcInfoForPc( (unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); + } assert(cfPtr->cmd != NULL); { diff --git a/generic/tclInt.h b/generic/tclInt.h index 99f1305..161d166 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1208,6 +1208,7 @@ typedef struct CmdFrame { const char *pc; /* ... and instruction pointer. */ } tebc; } data; + Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ int len; /* ... and its length. */ int numLevels; /* Value of interp's numLevels when the frame @@ -2907,7 +2908,11 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); +MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr); +MODULE_SCOPE const char *TclGetSrcInfoForCmdFrame(CmdFrame *cfPtr, + int *lenPtr); MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData *types); -- cgit v0.12