summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclBasic.c41
-rw-r--r--generic/tclCmdIL.c25
-rw-r--r--generic/tclExecute.c19
-rw-r--r--generic/tclInt.h5
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);