summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCompCmds.c69
-rw-r--r--generic/tclCompile.c6
-rw-r--r--generic/tclCompile.h5
-rw-r--r--generic/tclDictObj.c43
-rw-r--r--generic/tclExecute.c60
-rw-r--r--generic/tclInt.h5
6 files changed, 147 insertions, 41 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 172a58d..0b6b76b 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1245,7 +1245,7 @@ TclCompileDictWithCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
- int i, range, varNameTmp, pathTmp, keysTmp, gotPath;
+ int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1;
Tcl_Token *dictVarTokenPtr, *tokenPtr;
int savedStackDepth = envPtr->currStackDepth;
JumpFixup jumpFixup;
@@ -1281,7 +1281,32 @@ TclCompileDictWithCmd(
*/
gotPath = (parsePtr->numWords > 3);
- varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ if (dictVarTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ const char *ptr = dictVarTokenPtr[1].start;
+ const char *end = ptr + dictVarTokenPtr[1].size;
+ int notArray = 1;
+
+ /*
+ * A conservative check for if we're working with an array since we
+ * have a reasonable fallback if things are tricky.
+ */
+
+ for (; ptr<end ; ptr++) {
+ if (*ptr == '(' || *ptr == ')') {
+ notArray = 0;
+ break;
+ }
+ }
+ if (notArray) {
+ dictVar = TclFindCompiledLocal(dictVarTokenPtr[1].start,
+ dictVarTokenPtr[1].size, 1, envPtr);
+ }
+ }
+ if (dictVar == -1) {
+ varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ } else {
+ varNameTmp = -1;
+ }
if (gotPath) {
pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
} else {
@@ -1294,11 +1319,13 @@ TclCompileDictWithCmd(
*/
tokenPtr = dictVarTokenPtr;
- CompileWord(envPtr, tokenPtr, interp, 0);
- if (varNameTmp <= 255) {
- TclEmitInstInt1( INST_STORE_SCALAR1, varNameTmp, envPtr);
- } else {
- TclEmitInstInt4( INST_STORE_SCALAR4, varNameTmp, envPtr);
+ if (varNameTmp > -1) {
+ CompileWord(envPtr, tokenPtr, interp, 0);
+ if (varNameTmp <= 255) {
+ TclEmitInstInt1( INST_STORE_SCALAR1, varNameTmp, envPtr);
+ } else {
+ TclEmitInstInt4( INST_STORE_SCALAR4, varNameTmp, envPtr);
+ }
}
tokenPtr = TokenAfter(tokenPtr);
if (gotPath) {
@@ -1314,7 +1341,13 @@ TclCompileDictWithCmd(
}
TclEmitOpcode( INST_POP, envPtr);
}
- TclEmitOpcode( INST_LOAD_STK, envPtr);
+ if (dictVar == -1) {
+ TclEmitOpcode( INST_LOAD_STK, envPtr);
+ } else if (dictVar <= 255) {
+ TclEmitInstInt1( INST_LOAD_SCALAR1, dictVar, envPtr);
+ } else {
+ TclEmitInstInt4( INST_LOAD_SCALAR4, dictVar, envPtr);
+ }
if (gotPath) {
if (pathTmp <= 255) {
TclEmitInstInt1( INST_LOAD_SCALAR1, pathTmp, envPtr);
@@ -1351,9 +1384,9 @@ TclCompileDictWithCmd(
*/
TclEmitOpcode( INST_END_CATCH, envPtr);
- if (varNameTmp <= 255) {
+ if (varNameTmp > -1 && varNameTmp <= 255) {
TclEmitInstInt1( INST_LOAD_SCALAR1, varNameTmp, envPtr);
- } else {
+ } else if (varNameTmp > -1) {
TclEmitInstInt4( INST_LOAD_SCALAR4, varNameTmp, envPtr);
}
if (gotPath) {
@@ -1370,7 +1403,11 @@ TclCompileDictWithCmd(
} else {
TclEmitInstInt4( INST_LOAD_SCALAR4, keysTmp, envPtr);
}
- TclEmitOpcode( INST_DICT_RECOMBINE, envPtr);
+ if (dictVar == -1) {
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ } else {
+ TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ }
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
/*
@@ -1381,9 +1418,9 @@ TclCompileDictWithCmd(
TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
TclEmitOpcode( INST_END_CATCH, envPtr);
- if (varNameTmp <= 255) {
+ if (varNameTmp > -1 && varNameTmp <= 255) {
TclEmitInstInt1( INST_LOAD_SCALAR1, varNameTmp, envPtr);
- } else {
+ } else if (varNameTmp > -1) {
TclEmitInstInt4( INST_LOAD_SCALAR4, varNameTmp, envPtr);
}
if (parsePtr->numWords > 3) {
@@ -1400,7 +1437,11 @@ TclCompileDictWithCmd(
} else {
TclEmitInstInt4( INST_LOAD_SCALAR4, keysTmp, envPtr);
}
- TclEmitOpcode( INST_DICT_RECOMBINE, envPtr);
+ if (dictVar == -1) {
+ TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr);
+ } else {
+ TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
+ }
TclEmitOpcode( INST_RETURN_STK, envPtr);
/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 4b5d2bb..97e2a8a 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -426,10 +426,14 @@ InstructionDesc const tclInstructionTable[] = {
* variables with matched names. Produces list of keys bound as
* result. Part of [dict with].
* Stack: ... dict path => ... keyList */
- {"dictRecombine", 1, -3, 0, {OPERAND_NONE}},
+ {"dictRecombineStk", 1, -3, 0, {OPERAND_NONE}},
/* Map variable contents back into a dictionary in a variable. Part of
* [dict with].
* Stack: ... dictVarName path keyList => ... */
+ {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}},
+ /* Map variable contents back into a dictionary in the local variable
+ * indicated by the LVT index. Part of [dict with].
+ * Stack: ... path keyList => ... */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 0cd667c..8e7f0d0 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -677,10 +677,11 @@ typedef struct ByteCode {
#define INST_UNSET_STK 137
#define INST_DICT_EXPAND 138
-#define INST_DICT_RECOMBINE 139
+#define INST_DICT_RECOMBINE_STK 139
+#define INST_DICT_RECOMBINE_IMM 140
/* The last opcode */
-#define LAST_INST_OPCODE 139
+#define LAST_INST_OPCODE 140
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 5b7ca9b..d50c0a2 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -3161,6 +3161,7 @@ FinalizeDictWith(
Tcl_Obj *varName = data[0];
Tcl_Obj *keysPtr = data[1];
Tcl_Obj *pathPtr = data[2];
+ Var *varPtr, *arrayPtr;
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")");
@@ -3183,7 +3184,14 @@ FinalizeDictWith(
* Pack from local variables back into the dictionary.
*/
- result = TclDictWithFinish(interp, varName, pathc, pathv, keysPtr);
+ varPtr = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG, "set",
+ /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ result = TclDictWithFinish(interp, varPtr, arrayPtr, varName, NULL, -1,
+ pathc, pathv, keysPtr);
+ }
/*
* Tidy up and return the real result (unless we had an error).
@@ -3289,11 +3297,27 @@ TclDictWithInit(
int
TclDictWithFinish(
- Tcl_Interp *interp,
- Tcl_Obj *varName,
- int pathc,
- Tcl_Obj *const pathv[],
- Tcl_Obj *keysPtr)
+ Tcl_Interp *interp, /* Command interpreter in which variable
+ * exists. Used for state management, traces
+ * and error reporting. */
+ Var *varPtr, /* Reference to the variable holding the
+ * dictionary. */
+ Var *arrayPtr, /* Reference to the array containing the
+ * variable, or NULL if the variable is a
+ * scalar. */
+ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
+ * the name of a variable. NULL if the 'index'
+ * parameter is >= 0 */
+ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
+ * in the array part1. */
+ int index, /* Index into the local variable table of the
+ * variable, or -1. Only used when part1Ptr is
+ * NULL. */
+ int pathc, /* The number of elements in the path into the
+ * dictionary. */
+ Tcl_Obj *const pathv[], /* The elements of the path to the subdict. */
+ Tcl_Obj *keysPtr) /* List of keys to be synchronized. This is
+ * the result value from TclDictWithInit. */
{
Tcl_Obj *dictPtr, *leafPtr, *valPtr;
int i, allocdict, keyc;
@@ -3303,7 +3327,8 @@ TclDictWithFinish(
* If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
+ dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ TCL_LEAVE_ERR_MSG, index);
if (dictPtr == NULL) {
return TCL_OK;
}
@@ -3385,8 +3410,8 @@ TclDictWithFinish(
* Write back the outermost dictionary to the variable.
*/
- if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
+ TCL_LEAVE_ERR_MSG, index) == NULL) {
if (allocdict) {
TclDecrRefCount(dictPtr);
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index e3db83e..953c63e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6122,26 +6122,60 @@ TEBCresume(
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
- case INST_DICT_RECOMBINE:
- varNamePtr = OBJ_AT_DEPTH(2);
- listPtr = OBJ_UNDER_TOS;
- keysPtr = OBJ_AT_TOS;
+ case INST_DICT_RECOMBINE_STK:
+ keysPtr = POP_OBJECT();
+ varNamePtr = OBJ_UNDER_TOS;
+ listPtr = OBJ_AT_TOS;
+ TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
+ O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s %.30s %.30s => ERROR: ",
- O2S(varNamePtr), O2S(listPtr), O2S(keysPtr)),
- Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TclDecrRefCount(keysPtr);
goto gotError;
}
- if (TclDictWithFinish(interp, varNamePtr, objc, objv,
- keysPtr) != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s %.30s %.30s => ERROR: ",
- O2S(varNamePtr), O2S(listPtr), O2S(keysPtr)),
- Tcl_GetObjResult(interp));
+ varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ TclDecrRefCount(keysPtr);
goto gotError;
}
+ DECACHE_STACK_INFO();
+ result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1,
+ objc, objv, keysPtr);
+ CACHE_STACK_INFO();
TclDecrRefCount(keysPtr);
- POP_OBJECT();
+ if (result != TCL_OK) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ TRACE_APPEND(("OK\n"));
NEXT_INST_F(1, 2, 0);
+
+ case INST_DICT_RECOMBINE_IMM:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ listPtr = OBJ_UNDER_TOS;
+ keysPtr = OBJ_AT_TOS;
+ varPtr = LOCAL(opnd);
+ TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
+ O2S(keysPtr)));
+ if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ DECACHE_STACK_INFO();
+ result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd,
+ objc, objv, keysPtr);
+ CACHE_STACK_INFO();
+ if (result != TCL_OK) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ goto gotError;
+ }
+ TRACE_APPEND(("OK\n"));
+ NEXT_INST_F(5, 2, 0);
}
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e7a84ce..b375bb9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3231,8 +3231,9 @@ MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
-MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp,
- Tcl_Obj *varName, int pathc,
+MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
+ Var *arrayPtr, Tcl_Obj *part1Ptr,
+ Tcl_Obj *part2Ptr, int index, int pathc,
Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
int pathc, Tcl_Obj *const pathv[]);
generated by cgit v0.12 at 2024-07-15 16:34:58 (GMT)