summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c64
-rw-r--r--generic/tclCmdIL.c25
-rw-r--r--generic/tclExecute.c19
-rw-r--r--generic/tclInt.h5
4 files changed, 65 insertions, 48 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7110025..1cd2eae 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3357,16 +3357,7 @@ CancelEvalProc(
*
* This function returns a Tcl_Obj with the full source string for the
* command. This insures that traces get a correct NUL-terminated command
- * string. The Tcl_Obj has refCount==1.
- *
- * *** MAINTAINER WARNING ***
- * The returned Tcl_Obj is all wrong for any purpose but getting the
- * source string for an objc/objv command line in the stringRep (no
- * stringRep if no source is available) and the corresponding substituted
- * version in the List intrep.
- * This means that the intRep and stringRep DO NOT COINCIDE! Using these
- * Tcl_Objs normally is likely to break things.
- *
+ * string.
*----------------------------------------------------------------------
*/
@@ -3376,34 +3367,12 @@ GetCommandSource(
int objc,
Tcl_Obj *const objv[])
{
- Tcl_Obj *objPtr, *obj2Ptr;
CmdFrame *cfPtr = iPtr->cmdFramePtr;
- const char *command = NULL;
- int numChars;
-
- objPtr = Tcl_NewListObj(objc, objv);
- if (cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) {
- 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) {
- obj2Ptr = Tcl_NewStringObj(command, numChars);
- objPtr->bytes = obj2Ptr->bytes;
- objPtr->length = numChars;
- obj2Ptr->bytes = NULL;
- Tcl_DecrRefCount(obj2Ptr);
- }
+
+ if (cfPtr && (cfPtr->numLevels != iPtr->numLevels-1)) {
+ cfPtr = NULL;
}
- Tcl_IncrRefCount(objPtr);
- return objPtr;
+ return TclGetSourceFromFrame(cfPtr, objc, objv);
}
/*
@@ -4689,6 +4658,7 @@ TEOV_RunEnterTraces(
Tcl_Obj *commandPtr;
commandPtr = GetCommandSource(iPtr, objc, objv);
+ Tcl_IncrRefCount(commandPtr);
command = Tcl_GetStringFromObj(commandPtr, &length);
/*
@@ -4727,7 +4697,7 @@ TEOV_RunEnterTraces(
*/
TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
- commandPtr, cmdPtr, NULL);
+ commandPtr, cmdPtr, Tcl_NewListObj(objc, objv));
cmdPtr->refCount++;
} else {
Tcl_DecrRefCount(commandPtr);
@@ -4748,11 +4718,10 @@ TEOV_RunLeaveTraces(
int traceCode = PTR2INT(data[0]);
Tcl_Obj *commandPtr = data[1];
Command *cmdPtr = data[2];
+ Tcl_Obj *wordsPtr = data[3];
command = Tcl_GetStringFromObj(commandPtr, &length);
- if (TCL_OK != Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv)) {
- Tcl_Panic("Who messed with commandPtr?");
- }
+ Tcl_ListObjGetElements(NULL, wordsPtr, &objc, &objv);
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
@@ -4765,6 +4734,7 @@ TEOV_RunLeaveTraces(
}
}
Tcl_DecrRefCount(commandPtr);
+ Tcl_DecrRefCount(wordsPtr);
/*
* As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
@@ -5024,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) {
@@ -5254,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;
@@ -5994,7 +5969,6 @@ TclNREvalObjEx(
Tcl_IncrRefCount(objPtr);
listPtr = TclListObjCopy(interp, objPtr);
Tcl_IncrRefCount(listPtr);
- TclDecrRefCount(objPtr);
if (word != INT_MIN) {
/*
@@ -6024,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;
@@ -6032,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);
@@ -6167,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
@@ -6176,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);
generated by cgit v0.12 at 2024-10-02 18:37:27 (GMT)