Tcl Source Code

    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1;
    Tcl_Token *dictVarTokenPtr, *tokenPtr;
    int savedStackDepth = envPtr->currStackDepth;
    JumpFixup jumpFixup;

    /*
     * There must be at least one argument after the command and we must be in
     * a procedure so we can have local temporaries.

    }

    /*
     * Allocate local (unnamed, untraced) working variables.
     */

    gotPath = (parsePtr->numWords > 3);
    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 {
	pathTmp = -1;
    }
    keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);

    /*
     * Issue instructions. First, the part to expand the dictionary.
     */

    tokenPtr = dictVarTokenPtr;
    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) {
	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
	    CompileWord(envPtr, tokenPtr, interp, i-1);
	    tokenPtr = TokenAfter(tokenPtr);
	}
	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);
	if (pathTmp <= 255) {
	    TclEmitInstInt1(	INST_STORE_SCALAR1, pathTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_STORE_SCALAR4, pathTmp,	envPtr);
	}
	TclEmitOpcode(		INST_POP,			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);
	} else {
	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
	}
    } else {

    ExceptionRangeEnds(envPtr, range);

    /*
     * Now fold the results back into the dictionary in the OK case.
     */

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1 && varNameTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, varNameTmp,	envPtr);
    } else if (varNameTmp > -1) {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, varNameTmp,	envPtr);
    }
    if (gotPath) {
	if (pathTmp <= 255) {
	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
	}
    } else {
	PushLiteral(envPtr, "", 0);
    }
    if (keysTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, keysTmp,	envPtr);
    } else {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, keysTmp,	envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Now fold the results back into the dictionary in the exception case.
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1 && varNameTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, varNameTmp,	envPtr);
    } else if (varNameTmp > -1) {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, varNameTmp,	envPtr);
    }
    if (parsePtr->numWords > 3) {
	if (pathTmp <= 255) {
	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
	}
    } else {
	PushLiteral(envPtr, "", 0);
    }
    if (keysTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, keysTmp,	envPtr);
    } else {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, keysTmp,	envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitOpcode(		INST_RETURN_STK,		envPtr);

    /*
     * Prepare for the start of the next command.
     */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {

	 * stktop; op1 is 1 for errors on problems, 0 otherwise */

    {"dictExpand",       1,    -1,        0,    {OPERAND_NONE}},
        /* Probe into a dict and extract it (or a subdict of it) into
         * variables with matched names. Produces list of keys bound as
         * result. Part of [dict with].
	 * Stack:  ... dict path => ... keyList */
    {"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}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

/* For [unset] compilation */
#define INST_UNSET_SCALAR		134
#define INST_UNSET_ARRAY		135
#define INST_UNSET_ARRAY_STK		136
#define INST_UNSET_STK			137

#define INST_DICT_EXPAND		138
#define INST_DICT_RECOMBINE_STK		139
#define INST_DICT_RECOMBINE_IMM		140

/* The last opcode */
#define LAST_INST_OPCODE		140

/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"

{
    Tcl_Obj **pathv;
    int pathc;
    Tcl_InterpState state;
    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\")");
    }

    /*
     * Save the result state; TDWF doesn't guarantee to not modify that on

	pathv = NULL;
    }

    /*
     * Pack from local variables back into the dictionary.
     */

    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).
     */

    TclDecrRefCount(varName);
    TclDecrRefCount(keysPtr);

 *	the dictionary in the named variable.
 *
 *----------------------------------------------------------------------
 */

int
TclDictWithFinish(
    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;
    Tcl_Obj **keyv;

    /*
     * If the dictionary variable doesn't exist, drop everything silently.
     */

    dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    TCL_LEAVE_ERR_MSG, index);
    if (dictPtr == NULL) {
	return TCL_OK;
    }

    /*
     * Double-check that it is still a dictionary.
     */

	InvalidateDictChain(leafPtr);
    }

    /*
     * Write back the outermost dictionary to the variable.
     */

    if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
	    TCL_LEAVE_ERR_MSG, index) == NULL) {
	if (allocdict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    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_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    TclDecrRefCount(keysPtr);
	    goto gotError;
	}
	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);
	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);
    }

    /*
     *	   End of dictionary-related instructions.
     * -----------------------------------------------------------------
     */

MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    ClientData clientData);
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, 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[]);
MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);