Added support for having the dict var itself referenced by LVT index.

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[]);