diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclBasic.c | 4 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 976 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 378 | ||||
| -rw-r--r-- | generic/tclInt.h | 28 | ||||
| -rw-r--r-- | tests/dict.test | 6 |
6 files changed, 785 insertions, 612 deletions
@@ -1,3 +1,8 @@ +2007-11-22 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclDictObj.c (Dict*Cmd,TclInitDictCmd): Rebuilt the [dict] + * generic/tclCompCmds.c (TclCompileDict*Cmd): command as an ensemble. + 2007-11-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> * generic/tclCmdMZ.c (Tcl_StringObjCmd): Rewrote the [string] and diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 09eecc1..531dc42 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.281 2007/11/12 22:12:05 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.282 2007/11/22 22:16:07 dkf Exp $ */ #include "tclInt.h" @@ -140,7 +140,6 @@ static const CmdInfo builtInCmds[] = { {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, 1}, {"concat", Tcl_ConcatObjCmd, NULL, 1}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, 1}, - {"dict", Tcl_DictObjCmd, TclCompileDictCmd, 1}, {"encoding", Tcl_EncodingObjCmd, NULL, 0}, {"error", Tcl_ErrorObjCmd, NULL, 1}, {"eval", Tcl_EvalObjCmd, NULL, 1}, @@ -670,6 +669,7 @@ Tcl_CreateInterp(void) NULL, NULL); } + TclInitDictCmd(interp); TclInitInfoCmd(interp); /* TIP #208 */ diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 2f203e74..2d616c5 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.129 2007/11/21 23:30:39 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.130 2007/11/22 22:16:08 dkf Exp $ */ #include "tclInt.h" @@ -588,24 +588,43 @@ TclCompileContinueCmd( /* *---------------------------------------------------------------------- * - * TclCompileDictCmd -- + * TclCompileDict*Cmd -- * - * Procedure called to compile the "dict" command. + * Functions called to compile "dict" sucommands. * * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * All return TCL_OK for a successful compile, and TCL_ERROR to defer * evaluation to runtime. * * Side effects: - * Instructions are added to envPtr to execute the "dict" command at + * Instructions are added to envPtr to execute the "dict" subcommand at * runtime. * + * Notes: + * The following commands are in fairly common use and are possibly worth + * bytecoding: + * dict append + * dict create [*] + * dict exists [*] + * dict for + * dict get [*] + * dict incr + * dict keys [*] + * dict lappend + * dict set + * dict unset + * + * In practice, those that are pure-value operators (marked with [*]) can + * probably be left alone (except perhaps [dict get] which is very very + * common) and [dict update] should be considered instead (really big + * win!) + * *---------------------------------------------------------------------- */ int -TclCompileDictCmd( - Tcl_Interp *interp, /* Used for error reporting. */ +TclCompileDictSetCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being @@ -613,496 +632,633 @@ TclCompileDictCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; - int numWords, size, i; - const char *cmd; + int numWords, i; Proc *procPtr = envPtr->procPtr; DefineLineInformation; /* TIP #280 */ + Tcl_Token *varTokenPtr; + int dictVarIndex, nameChars; + const char *name; /* * There must be at least one argument after the command. */ - if (parsePtr->numWords < 2) { + if (parsePtr->numWords < 4 || procPtr == NULL) { return TCL_ERROR; } - tokenPtr = TokenAfter(parsePtr->tokenPtr); - numWords = parsePtr->numWords-2; - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + /* + * The dictionary variable must be a local scalar that is knowable at + * compile time; anything else exceeds the complexity of the opcode. So + * discover what the index is. + */ + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + name = varTokenPtr[1].start; + nameChars = varTokenPtr[1].size; + if (!TclIsLocalScalar(name, nameChars)) { return TCL_ERROR; } + dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); /* - * The following commands are in fairly common use and are possibly worth - * bytecoding: - * dict append - * dict create [*] - * dict exists [*] - * dict for - * dict get [*] - * dict incr - * dict keys [*] - * dict lappend - * dict set - * dict unset - * In practice, those that are pure-value operators (marked with [*]) can - * probably be left alone (except perhaps [dict get] which is very very - * common) and [dict update] should be considered instead (really big - * win!) - */ - - size = tokenPtr[1].size; - cmd = tokenPtr[1].start; - if (size==3 && strncmp(cmd, "set", 3)==0) { - Tcl_Token *varTokenPtr; - int dictVarIndex, nameChars; - const char *name; - - if (numWords < 3 || procPtr == NULL) { - return TCL_ERROR; - } - varTokenPtr = TokenAfter(tokenPtr); - tokenPtr = TokenAfter(varTokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); - for (i=1 ; i<numWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); - tokenPtr = TokenAfter(tokenPtr); - } - TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr); - TclEmitInt4( dictVarIndex, envPtr); - return TCL_OK; - } else if (size==4 && strncmp(cmd, "incr", 4)==0) { - Tcl_Token *varTokenPtr, *keyTokenPtr, *incrTokenPtr = NULL; - int dictVarIndex, nameChars, incrAmount = 1; - const char *name; + * Remaining words (key path and value to set) can be handled normally. + */ - if (numWords < 2 || numWords > 3 || procPtr == NULL) { - return TCL_ERROR; - } - varTokenPtr = TokenAfter(tokenPtr); - keyTokenPtr = TokenAfter(varTokenPtr); - if (numWords == 3) { - const char *word; - int numBytes, code; - Tcl_Obj *intObj; - - incrTokenPtr = TokenAfter(keyTokenPtr); - if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - word = incrTokenPtr[1].start; - numBytes = incrTokenPtr[1].size; + tokenPtr = TokenAfter(varTokenPtr); + numWords = parsePtr->numWords-1; + for (i=1 ; i<numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp, i); + tokenPtr = TokenAfter(tokenPtr); + } - intObj = Tcl_NewStringObj(word, numBytes); - Tcl_IncrRefCount(intObj); - code = TclGetIntFromObj(NULL, intObj, &incrAmount); - TclDecrRefCount(intObj); - if (code != TCL_OK) { - return TCL_ERROR; - } - } - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); - CompileWord(envPtr, keyTokenPtr, interp, 3); - TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr); - TclEmitInt4( dictVarIndex, envPtr); - return TCL_OK; - } else if (size==3 && strncmp(cmd, "get", 3)==0) { - /* - * Only compile this because we need INST_DICT_GET anyway. - */ + /* + * Now emit the instruction to do the dict manipulation. + */ - if (numWords < 2) { - return TCL_ERROR; - } - for (i=0 ; i<numWords ; i++) { - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i); - } - TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr); - return TCL_OK; - } else if (size==3 && strncmp(cmd, "for", 3)==0) { - Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; - int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; - int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - int endTargetOffset; - const char **argv; - Tcl_DString buffer; - int savedStackDepth = envPtr->currStackDepth; - DefineLineInformation; /* TIP #280 */ + TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr); + TclEmitInt4( dictVarIndex, envPtr); + return TCL_OK; +} + +int +TclCompileDictIncrCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ + 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. */ +{ + Proc *procPtr = envPtr->procPtr; + DefineLineInformation; /* TIP #280 */ + Tcl_Token *varTokenPtr, *keyTokenPtr; + int dictVarIndex, nameChars, incrAmount; + const char *name; + + /* + * There must be at least two arguments after the command. + */ + + if (parsePtr->numWords < 3 || parsePtr->numWords > 4 || procPtr == NULL) { + return TCL_ERROR; + } + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + keyTokenPtr = TokenAfter(varTokenPtr); - if (numWords != 3 || procPtr == NULL) { + /* + * Parse the increment amount, if present. + */ + + if (parsePtr->numWords == 4) { + const char *word; + int numBytes, code; + Tcl_Token *incrTokenPtr; + Tcl_Obj *intObj; + + incrTokenPtr = TokenAfter(keyTokenPtr); + if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } + word = incrTokenPtr[1].start; + numBytes = incrTokenPtr[1].size; - varsTokenPtr = TokenAfter(tokenPtr); - dictTokenPtr = TokenAfter(varsTokenPtr); - bodyTokenPtr = TokenAfter(dictTokenPtr); - if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD || - bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + intObj = Tcl_NewStringObj(word, numBytes); + Tcl_IncrRefCount(intObj); + code = TclGetIntFromObj(NULL, intObj, &incrAmount); + TclDecrRefCount(intObj); + if (code != TCL_OK) { return TCL_ERROR; } + } else { + incrAmount = 1; + } - /* - * Check we've got a pair of variables and that they are local - * variables. Then extract their indices in the LVT. - */ + /* + * The dictionary variable must be a local scalar that is knowable at + * compile time; anything else exceeds the complexity of the opcode. So + * discover what the index is. + */ - Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, - varsTokenPtr[1].size); - if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numWords, - &argv) != TCL_OK) { - Tcl_DStringFree(&buffer); - return TCL_ERROR; - } + if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + name = varTokenPtr[1].start; + nameChars = varTokenPtr[1].size; + if (!TclIsLocalScalar(name, nameChars)) { + return TCL_ERROR; + } + dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); + + /* + * Emit the key and the code to actually do the increment. + */ + + CompileWord(envPtr, keyTokenPtr, interp, 3); + TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr); + TclEmitInt4( dictVarIndex, envPtr); + return TCL_OK; +} + +int +TclCompileDictGetCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ + 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. */ +{ + Tcl_Token *tokenPtr; + int numWords, i; + DefineLineInformation; /* TIP #280 */ + + /* + * There must be at least two arguments after the command (the single-arg + * case is legal, but too special and magic for us to deal with here). + */ + + if (parsePtr->numWords < 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + numWords = parsePtr->numWords-1; + + /* + * Only compile this because we need INST_DICT_GET anyway. + */ + + for (i=0 ; i<numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp, i); + tokenPtr = TokenAfter(tokenPtr); + } + TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr); + return TCL_OK; +} + +int +TclCompileDictForCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ + 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. */ +{ + Proc *procPtr = envPtr->procPtr; + DefineLineInformation; /* TIP #280 */ + Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; + int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; + int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; + int numVars, endTargetOffset; + int savedStackDepth = envPtr->currStackDepth; /* is this necessary? */ + const char **argv; + Tcl_DString buffer; + + /* + * There must be at least three argument after the command. + */ + + if (parsePtr->numWords != 4 || procPtr == NULL) { + return TCL_ERROR; + } + + varsTokenPtr = TokenAfter(parsePtr->tokenPtr); + dictTokenPtr = TokenAfter(varsTokenPtr); + bodyTokenPtr = TokenAfter(dictTokenPtr); + if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD || + bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + + /* + * Check we've got a pair of variables and that they are local variables. + * Then extract their indices in the LVT. + */ + + Tcl_DStringInit(&buffer); + Tcl_DStringAppend(&buffer, varsTokenPtr[1].start, varsTokenPtr[1].size); + if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars, + &argv) != TCL_OK) { Tcl_DStringFree(&buffer); - if (numWords != 2) { - ckfree((char *) argv); - return TCL_ERROR; - } - nameChars = strlen(argv[0]); - if (!TclIsLocalScalar(argv[0], nameChars)) { - ckfree((char *) argv); - return TCL_ERROR; - } - keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, procPtr); - nameChars = strlen(argv[1]); - if (!TclIsLocalScalar(argv[1], nameChars)) { - ckfree((char *) argv); - return TCL_ERROR; - } - valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, procPtr); + return TCL_ERROR; + } + Tcl_DStringFree(&buffer); + if (numVars != 2) { ckfree((char *) argv); + return TCL_ERROR; + } - /* - * Allocate a temporary variable to store the iterator reference. The - * variable will contain a Tcl_DictSearch reference which will be - * allocated by INST_DICT_FIRST and disposed when the variable is - * unset (at which point it should also have been finished with). - */ + nameChars = strlen(argv[0]); + if (!TclIsLocalScalar(argv[0], nameChars)) { + ckfree((char *) argv); + return TCL_ERROR; + } + keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, procPtr); - infoIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr); + nameChars = strlen(argv[1]); + if (!TclIsLocalScalar(argv[1], nameChars)) { + ckfree((char *) argv); + return TCL_ERROR; + } + valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, procPtr); + ckfree((char *) argv); - /* - * Preparation complete; issue instructions. Note that this code - * issues fixed-sized jumps. That simplifies things a lot! - * - * First up, get the dictionary and start the iteration. No catching - * of errors at this point. - */ + /* + * Allocate a temporary variable to store the iterator reference. The + * variable will contain a Tcl_DictSearch reference which will be + * allocated by INST_DICT_FIRST and disposed when the variable is unset + * (at which point it should also have been finished with). + */ - CompileWord(envPtr, dictTokenPtr, interp, 3); - TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); - emptyTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); + infoIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr); - /* - * Now we catch errors from here on so that we can finalize the search - * started by Tcl_DictObjFirst above. - */ + /* + * Preparation complete; issue instructions. Note that this code issues + * fixed-sized jumps. That simplifies things a lot! + * + * First up, get the dictionary and start the iteration. No catching of + * errors at this point. + */ - catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr); - ExceptionRangeStarts(envPtr, catchRange); + CompileWord(envPtr, dictTokenPtr, interp, 3); + TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); + emptyTargetOffset = CurrentOffset(envPtr); + TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); - /* - * Inside the iteration, write the loop variables. - */ + /* + * Now we catch errors from here on so that we can finalize the search + * started by Tcl_DictObjFirst above. + */ - bodyTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr); + ExceptionRangeStarts(envPtr, catchRange); - /* - * Set up the loop exception targets. - */ + /* + * Inside the iteration, write the loop variables. + */ - loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); - ExceptionRangeStarts(envPtr, loopRange); + bodyTargetOffset = CurrentOffset(envPtr); + TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); - /* - * Compile the loop body itself. It should be stack-neutral. - */ + /* + * Set up the loop exception targets. + */ - envPtr->line = mapPtr->loc[eclIndex].line[4]; - CompileBody(envPtr, bodyTokenPtr, interp); - envPtr->currStackDepth = savedStackDepth + 1; - TclEmitOpcode( INST_POP, envPtr); - envPtr->currStackDepth = savedStackDepth; + loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); + ExceptionRangeStarts(envPtr, loopRange); - /* - * Both exception target ranges (error and loop) end here. - */ + /* + * Compile the loop body itself. It should be stack-neutral. + */ - ExceptionRangeEnds(envPtr, loopRange); - ExceptionRangeEnds(envPtr, catchRange); + envPtr->line = mapPtr->loc[eclIndex].line[4]; + CompileBody(envPtr, bodyTokenPtr, interp); + envPtr->currStackDepth = savedStackDepth + 1; + TclEmitOpcode( INST_POP, envPtr); + envPtr->currStackDepth = savedStackDepth; - /* - * Continue (or just normally process) by getting the next pair of - * items from the dictionary and jumping back to the code to write - * them into variables if there is another pair. - */ + /* + * Both exception target ranges (error and loop) end here. + */ - ExceptionRangeTarget(envPtr, loopRange, continueOffset); - TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); - jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); + ExceptionRangeEnds(envPtr, loopRange); + ExceptionRangeEnds(envPtr, catchRange); - /* - * Now do the final cleanup for the no-error case (this is where we - * break out of the loop to) by force-terminating the iteration (if - * not already terminated), ditching the exception info and jumping to - * the last instruction for this command. In theory, this could be - * done using the "finally" clause (next generated) but this is - * faster. - */ + /* + * Continue (or just normally process) by getting the next pair of items + * from the dictionary and jumping back to the code to write them into + * variables if there is another pair. + */ - ExceptionRangeTarget(envPtr, loopRange, breakOffset); - TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - endTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP4, 0, envPtr); + ExceptionRangeTarget(envPtr, loopRange, continueOffset); + TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); + jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr); + TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr); + TclEmitOpcode( INST_POP, envPtr); + TclEmitOpcode( INST_POP, envPtr); - /* - * Error handler "finally" clause, which force-terminates the - * iteration and rethrows the error. - */ + /* + * Now do the final cleanup for the no-error case (this is where we break + * out of the loop to) by force-terminating the iteration (if not already + * terminated), ditching the exception info and jumping to the last + * instruction for this command. In theory, this could be done using the + * "finally" clause (next generated) but this is faster. + */ - ExceptionRangeTarget(envPtr, catchRange, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + ExceptionRangeTarget(envPtr, loopRange, breakOffset); + TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr); + TclEmitOpcode( INST_END_CATCH, envPtr); + endTargetOffset = CurrentOffset(envPtr); + TclEmitInstInt4( INST_JUMP4, 0, envPtr); - /* - * Otherwise we're done (the jump after the DICT_FIRST points here) - * and we need to pop the bogus key/value pair (pushed to keep stack - * calculations easy!) Note that we skip the END_CATCH. [Bug 1382528] - */ + /* + * Error handler "finally" clause, which force-terminates the iteration + * and rethrows the error. + */ + + ExceptionRangeTarget(envPtr, catchRange, catchOffset); + TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); + TclEmitOpcode( INST_PUSH_RESULT, envPtr); + TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr); + TclEmitOpcode( INST_END_CATCH, envPtr); + TclEmitOpcode( INST_RETURN_STK, envPtr); + + /* + * Otherwise we're done (the jump after the DICT_FIRST points here) and we + * need to pop the bogus key/value pair (pushed to keep stack calculations + * easy!) Note that we skip the END_CATCH. [Bug 1382528] + */ + + jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset; + TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement, + envPtr->codeStart + emptyTargetOffset); + TclEmitOpcode( INST_POP, envPtr); + TclEmitOpcode( INST_POP, envPtr); + TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr); + + /* + * Final stage of the command (normal case) is that we push an empty + * object. This is done last to promote peephole optimization when it's + * dropped immediately. + */ + + jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; + TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement, + envPtr->codeStart + endTargetOffset); + PushLiteral(envPtr, "", 0); + return TCL_OK; +} + +int +TclCompileDictUpdateCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ + 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. */ +{ + Proc *procPtr = envPtr->procPtr; + DefineLineInformation; /* TIP #280 */ + const char *name; + int i, nameChars, dictIndex, numVars, range, infoIndex; + Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr; + DictUpdateInfo *duiPtr; + JumpFixup jumpFixup; + + /* + * There must be at least one argument after the command. + */ + + if (parsePtr->numWords < 5 || procPtr == NULL) { + return TCL_ERROR; + } + + /* + * Parse the command. Expect the following: + * dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit> + */ + + if ((parsePtr->numWords - 1) & 1) { + return TCL_ERROR; + } + numVars = (parsePtr->numWords - 3) / 2; + + /* + * The dictionary variable must be a local scalar that is knowable at + * compile time; anything else exceeds the complexity of the opcode. So + * discover what the index is. + */ + + dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr); + if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + name = dictVarTokenPtr[1].start; + nameChars = dictVarTokenPtr[1].size; + if (!TclIsLocalScalar(name, nameChars)) { + return TCL_ERROR; + } + dictIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); + + /* + * Assemble the instruction metadata. This is complex enough that it is + * represented as auxData; it holds an ordered list of variable indices + * that are to be used. + */ - jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset; - TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement, - envPtr->codeStart + emptyTargetOffset); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr); + duiPtr = (DictUpdateInfo *) + ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); + duiPtr->length = numVars; + keyTokenPtrs = (Tcl_Token **) TclStackAlloc(interp, + sizeof(Tcl_Token *) * numVars); + tokenPtr = TokenAfter(dictVarTokenPtr); + for (i=0 ; i<numVars ; i++) { /* - * Final stage of the command (normal case) is that we push an empty - * object. This is done last to promote peephole optimization when - * it's dropped immediately. + * Put keys to one side for later compilation to bytecode. */ - jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; - TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement, - envPtr->codeStart + endTargetOffset); - PushLiteral(envPtr, "", 0); - return TCL_OK; - } else if (size==6 && strncmp(cmd, "update", 6)==0) { - const char *name; - int nameChars, dictIndex, numVars, range, infoIndex; - Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr; - DictUpdateInfo *duiPtr; - JumpFixup jumpFixup; + keyTokenPtrs[i] = tokenPtr; /* - * Parse the command. Expect the following: - * dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit> + * Variables first need to be checked for sanity. */ - if (numWords < 4 || numWords & 1 || procPtr == NULL) { - return TCL_ERROR; - } - numVars = numWords/2 - 1; - dictVarTokenPtr = TokenAfter(tokenPtr); - if (dictVarTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + tokenPtr = TokenAfter(tokenPtr); + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + ckfree((char *) duiPtr); + TclStackFree(interp, keyTokenPtrs); return TCL_ERROR; } - name = dictVarTokenPtr[1].start; - nameChars = dictVarTokenPtr[1].size; + name = tokenPtr[1].start; + nameChars = tokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); - - duiPtr = (DictUpdateInfo *) - ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); - duiPtr->length = numVars; - keyTokenPtrs = (Tcl_Token **) TclStackAlloc(interp, - sizeof(Tcl_Token *) * numVars); - tokenPtr = TokenAfter(dictVarTokenPtr); - for (i=0 ; i<numVars ; i++) { - keyTokenPtrs[i] = tokenPtr; - tokenPtr = TokenAfter(tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - ckfree((char *) duiPtr); - TclStackFree(interp, keyTokenPtrs); - return TCL_ERROR; - } - name = tokenPtr[1].start; - nameChars = tokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - ckfree((char *) duiPtr); - TclStackFree(interp, keyTokenPtrs); - return TCL_ERROR; - } - duiPtr->varIndices[i] = - TclFindCompiledLocal(name, nameChars, 1, procPtr); - tokenPtr = TokenAfter(tokenPtr); - } - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { ckfree((char *) duiPtr); TclStackFree(interp, keyTokenPtrs); return TCL_ERROR; } - bodyTokenPtr = tokenPtr; /* - * The list of variables to bind is stored in auxiliary data so that - * it can't be snagged by literal sharing and forced to shimmer - * dangerously. + * Stash the index in the auxiliary data. */ - infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr); + duiPtr->varIndices[i] = + TclFindCompiledLocal(name, nameChars, 1, procPtr); + tokenPtr = TokenAfter(tokenPtr); + } + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + ckfree((char *) duiPtr); + TclStackFree(interp, keyTokenPtrs); + return TCL_ERROR; + } + bodyTokenPtr = tokenPtr; - for (i=0 ; i<numVars ; i++) { - CompileWord(envPtr, keyTokenPtrs[i], interp, i); - } - TclEmitInstInt4( INST_LIST, numVars, envPtr); - TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); + /* + * The list of variables to bind is stored in auxiliary data so that it + * can't be snagged by literal sharing and forced to shimmer dangerously. + */ - range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); + infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr); - ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, bodyTokenPtr, interp); - ExceptionRangeEnds(envPtr, range); + for (i=0 ; i<numVars ; i++) { + CompileWord(envPtr, keyTokenPtrs[i], interp, i); + } + TclEmitInstInt4( INST_LIST, numVars, envPtr); + TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr); + TclEmitInt4( infoIndex, envPtr); - /* - * Normal termination code: the stack has the key list below the - * result of the body evaluation: swap them and finish the update - * code. - */ + range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); + ExceptionRangeStarts(envPtr, range); + CompileBody(envPtr, bodyTokenPtr, interp); + ExceptionRangeEnds(envPtr, range); - /* - * Jump around the exceptional termination code - */ + /* + * Normal termination code: the stack has the key list below the result of + * the body evaluation: swap them and finish the update code. + */ - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); + TclEmitOpcode( INST_END_CATCH, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); + TclEmitInt4( infoIndex, envPtr); - /* - * Termination code for non-ok returns: stash the result and return - * options in the stack, bring up the key list, finish the update - * code, and finally return with the catched return data - */ + /* + * Jump around the exceptional termination code. + */ - ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt4( INST_REVERSE, 3, envPtr); + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); - TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + /* + * Termination code for non-ok returns: stash the result and return + * options in the stack, bring up the key list, finish the update code, + * and finally return with the catched return data + */ - if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", - CurrentOffset(envPtr) - jumpFixup.codeOffset); - } - TclStackFree(interp, keyTokenPtrs); - return TCL_OK; - } else if (size==6 && strncmp(cmd, "append", 6) == 0) { - Tcl_Token *varTokenPtr; - int dictVarIndex, nameChars; - const char *name; + ExceptionRangeTarget(envPtr, range, catchOffset); + TclEmitOpcode( INST_PUSH_RESULT, envPtr); + TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); + TclEmitOpcode( INST_END_CATCH, envPtr); + TclEmitInstInt4( INST_REVERSE, 3, envPtr); - /* - * Arbirary safe limit; anyone exceeding it should stop worrying about - * speed quite so much. ;-) - */ + TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); + TclEmitInt4( infoIndex, envPtr); + TclEmitOpcode( INST_RETURN_STK, envPtr); - if (numWords < 3 || numWords > 100 || procPtr == NULL) { - return TCL_ERROR; - } - varTokenPtr = TokenAfter(tokenPtr); - tokenPtr = TokenAfter(varTokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); - for (i=1 ; i<numWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); - tokenPtr = TokenAfter(tokenPtr); - } - if (numWords > 3) { - TclEmitInstInt1( INST_CONCAT1, numWords-2, envPtr); - } - TclEmitInstInt4( INST_DICT_APPEND, dictVarIndex, envPtr); - return TCL_OK; - } else if (size==7 && strncmp(cmd, "lappend", 7) == 0) { - Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; - int dictVarIndex, nameChars; - const char *name; + if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { + Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", + CurrentOffset(envPtr) - jumpFixup.codeOffset); + } + TclStackFree(interp, keyTokenPtrs); + return TCL_OK; +} - if (numWords != 3 || procPtr == NULL) { - return TCL_ERROR; - } - varTokenPtr = TokenAfter(tokenPtr); - keyTokenPtr = TokenAfter(varTokenPtr); - valueTokenPtr = TokenAfter(keyTokenPtr); - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (!TclIsLocalScalar(name, nameChars)) { - return TCL_ERROR; - } - dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); - CompileWord(envPtr, keyTokenPtr, interp, 3); - CompileWord(envPtr, valueTokenPtr, interp, 4); - TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); - return TCL_OK; +int +TclCompileDictAppendCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ + 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. */ +{ + Proc *procPtr = envPtr->procPtr; + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr, *varTokenPtr; + int numWords, i, dictVarIndex, nameChars; + const char *name; + + /* + * There must be at least two argument after the command. + */ + + if (parsePtr->numWords < 3) { + return TCL_ERROR; } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + numWords = parsePtr->numWords-1; /* - * Something we do not know how to compile. + * Arbirary safe limit; anyone exceeding it should stop worrying about + * speed quite so much. ;-) */ - return TCL_ERROR; + if (parsePtr->numWords > 100 || procPtr == NULL) { + return TCL_ERROR; + } + + varTokenPtr = TokenAfter(tokenPtr); + if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + name = varTokenPtr[1].start; + nameChars = varTokenPtr[1].size; + if (!TclIsLocalScalar(name, nameChars)) { + return TCL_ERROR; + } + dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); + + tokenPtr = TokenAfter(varTokenPtr); + for (i=1 ; i<parsePtr->numWords-1 ; i++) { + CompileWord(envPtr, tokenPtr, interp, i); + tokenPtr = TokenAfter(tokenPtr); + } + if (parsePtr->numWords > 3) { + TclEmitInstInt1( INST_CONCAT1, parsePtr->numWords-2, envPtr); + } + TclEmitInstInt4( INST_DICT_APPEND, dictVarIndex, envPtr); + return TCL_OK; +} + +int +TclCompileDictLappendCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ + 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. */ +{ + Proc *procPtr = envPtr->procPtr; + DefineLineInformation; /* TIP #280 */ + Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr; + int dictVarIndex, nameChars; + const char *name; + + /* + * There must be three arguments after the command. + */ + + if (parsePtr->numWords != 4 || procPtr == NULL) { + return TCL_ERROR; + } + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + keyTokenPtr = TokenAfter(varTokenPtr); + valueTokenPtr = TokenAfter(keyTokenPtr); + if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + name = varTokenPtr[1].start; + nameChars = varTokenPtr[1].size; + if (!TclIsLocalScalar(name, nameChars)) { + return TCL_ERROR; + } + dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr); + CompileWord(envPtr, keyTokenPtr, interp, 3); + CompileWord(envPtr, valueTokenPtr, interp, 4); + TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); + return TCL_OK; } /* diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 734b57b..a37d701 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.54 2007/11/22 16:39:58 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.55 2007/11/22 22:16:08 dkf Exp $ */ #include "tclInt.h" @@ -80,25 +80,25 @@ static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr); */ static const EnsembleImplMap implementationMap[] = { - {"append", DictAppendCmd, NULL/*TclCompileDictAppendCmd*/}, - {"create", DictCreateCmd, NULL}, - {"exists", DictExistsCmd, NULL}, - {"filter", DictFilterCmd, NULL}, - {"for", DictForCmd, NULL/*TclCompileDictForCmd*/}, - {"get", DictGetCmd, NULL/*TclCompileDictGetCmd*/}, - {"incr", DictIncrCmd, NULL/*TclCompileDictIncrCmd*/}, - {"info", DictInfoCmd, NULL}, - {"keys", DictKeysCmd, NULL}, - {"lappend", DictLappendCmd, NULL/*TclCompileDictLappendCmd*/}, - {"merge", DictMergeCmd, NULL}, - {"remove", DictRemoveCmd, NULL}, - {"replace", DictReplaceCmd, NULL}, - {"set", DictSetCmd, NULL/*TclCompileDictSetCmd*/}, - {"size", DictSizeCmd, NULL}, - {"unset", DictUnsetCmd, NULL}, - {"update", DictUpdateCmd, NULL/*TclCompileDictUpdateCmd*/}, - {"values", DictValuesCmd, NULL}, - {"with", DictWithCmd, NULL}, + {"append", DictAppendCmd, TclCompileDictAppendCmd }, + {"create", DictCreateCmd, NULL }, + {"exists", DictExistsCmd, NULL }, + {"filter", DictFilterCmd, NULL }, + {"for", DictForCmd, TclCompileDictForCmd }, + {"get", DictGetCmd, TclCompileDictGetCmd }, + {"incr", DictIncrCmd, TclCompileDictIncrCmd }, + {"info", DictInfoCmd, NULL }, + {"keys", DictKeysCmd, NULL }, + {"lappend", DictLappendCmd, TclCompileDictLappendCmd }, + {"merge", DictMergeCmd, NULL }, + {"remove", DictRemoveCmd, NULL }, + {"replace", DictReplaceCmd, NULL }, + {"set", DictSetCmd, TclCompileDictSetCmd }, + {"size", DictSizeCmd, NULL }, + {"unset", DictUnsetCmd, NULL }, + {"update", DictUpdateCmd, TclCompileDictUpdateCmd }, + {"values", DictValuesCmd, NULL }, + {"with", DictWithCmd, NULL }, {NULL} }; @@ -1503,13 +1503,13 @@ DictCreateCmd( * easier.) */ - if (objc & 1) { - Tcl_WrongNumArgs(interp, 2, objv, "?key value ...?"); + if ((objc & 1) == 0) { + Tcl_WrongNumArgs(interp, 1, objv, "?key value ...?"); return TCL_ERROR; } dictObj = Tcl_NewDictObj(); - for (i=2 ; i<objc ; i+=2) { + for (i=1 ; i<objc ; i+=2) { /* * The next command is assumed to never fail... */ @@ -1547,8 +1547,8 @@ DictGetCmd( Tcl_Obj *dictPtr, *valuePtr = NULL; int result; - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key key ...?"); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key key ...?"); return TCL_ERROR; } @@ -1558,12 +1558,12 @@ DictGetCmd( * list handling more efficient. */ - if (objc == 3) { + if (objc == 2) { Tcl_Obj *keyPtr, *listPtr; Tcl_DictSearch search; int done; - result = Tcl_DictObjFirst(interp, objv[2], &search, + result = Tcl_DictObjFirst(interp, objv[1], &search, &keyPtr, &valuePtr, &done); if (result != TCL_OK) { return result; @@ -1592,7 +1592,7 @@ DictGetCmd( * Note that this loop always executes at least once. */ - dictPtr = TclTraceDictPath(interp, objv[2], objc-4,objv+3, DICT_PATH_READ); + dictPtr = TclTraceDictPath(interp, objv[1], objc-3,objv+2, DICT_PATH_READ); if (dictPtr == NULL) { return TCL_ERROR; } @@ -1639,17 +1639,17 @@ DictReplaceCmd( int i, result; int allocatedDict = 0; - if ((objc < 3) || !(objc & 1)) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key value ...?"); + if ((objc < 2) || (objc & 1)) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?"); return TCL_ERROR; } - dictPtr = objv[2]; + dictPtr = objv[1]; if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); allocatedDict = 1; } - for (i=3 ; i<objc ; i+=2) { + for (i=2 ; i<objc ; i+=2) { result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]); if (result != TCL_OK) { if (allocatedDict) { @@ -1691,17 +1691,17 @@ DictRemoveCmd( int i, result; int allocatedDict = 0; - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key ...?"); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?"); return TCL_ERROR; } - dictPtr = objv[2]; + dictPtr = objv[1]; if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); allocatedDict = 1; } - for (i=3 ; i<objc ; i++) { + for (i=2 ; i<objc ; i++) { result = Tcl_DictObjRemove(interp, dictPtr, objv[i]); if (result != TCL_OK) { if (allocatedDict) { @@ -1744,7 +1744,7 @@ DictMergeCmd( int i, done; Tcl_DictSearch search; - if (objc == 2) { + if (objc == 1) { /* * No dictionary arguments; return default (empty value). */ @@ -1752,18 +1752,23 @@ DictMergeCmd( return TCL_OK; } - if (objc == 3) { + /* + * Make sure first argument is a dictionary. + */ + + targetObj = objv[1]; + if (targetObj->typePtr != &tclDictType) { + if (SetDictFromAny(interp, targetObj) != TCL_OK) { + return TCL_ERROR; + } + } + + if (objc == 2) { /* - * Single argument, make sure it is a dictionary, but otherwise return - * it. + * Single argument, return it. */ - if (objv[2]->typePtr != &tclDictType) { - if (SetDictFromAny(interp, objv[2]) != TCL_OK) { - return TCL_ERROR; - } - } - Tcl_SetObjResult(interp, objv[2]); + Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } @@ -1771,12 +1776,11 @@ DictMergeCmd( * Normal behaviour: combining two (or more) dictionaries. */ - targetObj = objv[2]; if (Tcl_IsShared(targetObj)) { targetObj = Tcl_DuplicateObj(targetObj); allocatedDict = 1; } - for (i=3 ; i<objc ; i++) { + for (i=2 ; i<objc ; i++) { if (Tcl_DictObjFirst(interp, objv[i], &search, &keyObj, &valueObj, &done) != TCL_OK) { if (allocatedDict) { @@ -1785,16 +1789,15 @@ DictMergeCmd( return TCL_ERROR; } while (!done) { - if (Tcl_DictObjPut(interp, targetObj, - keyObj, valueObj) != TCL_OK) { - Tcl_DictObjDone(&search); - if (allocatedDict) { - TclDecrRefCount(targetObj); - } - return TCL_ERROR; - } + /* + * Next line can't fail; already know we have a dictionary in + * targetObj. + */ + + Tcl_DictObjPut(NULL, targetObj, keyObj, valueObj); Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } + Tcl_DictObjDone(&search); } Tcl_SetObjResult(interp, targetObj); return TCL_OK; @@ -1828,8 +1831,8 @@ DictKeysCmd( Tcl_Obj *listPtr; char *pattern = NULL; - if (objc!=3 && objc!=4) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?pattern?"); + if (objc!=2 && objc!=3) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?"); return TCL_ERROR; } @@ -1839,24 +1842,24 @@ DictKeysCmd( * need. [Bug 1705778, leak K04] */ - if (objv[2]->typePtr != &tclDictType) { - int result = SetDictFromAny(interp, objv[2]); + if (objv[1]->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, objv[1]); if (result != TCL_OK) { return result; } } - if (objc == 4) { - pattern = TclGetString(objv[3]); + if (objc == 3) { + pattern = TclGetString(objv[2]); } listPtr = Tcl_NewListObj(0, NULL); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { Tcl_Obj *valuePtr = NULL; - Tcl_DictObjGet(interp, objv[2], objv[3], &valuePtr); + Tcl_DictObjGet(interp, objv[1], objv[2], &valuePtr); if (valuePtr != NULL) { - Tcl_ListObjAppendElement(NULL, listPtr, objv[3]); + Tcl_ListObjAppendElement(NULL, listPtr, objv[2]); } } else { Tcl_DictSearch search; @@ -1870,12 +1873,13 @@ DictKeysCmd( * can start the iteration process without checking for failures. */ - Tcl_DictObjFirst(NULL, objv[2], &search, &keyPtr, NULL, &done); + Tcl_DictObjFirst(NULL, objv[1], &search, &keyPtr, NULL, &done); for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) { if (!pattern || Tcl_StringMatch(TclGetString(keyPtr), pattern)) { Tcl_ListObjAppendElement(NULL, listPtr, keyPtr); } } + Tcl_DictObjDone(&search); } Tcl_SetObjResult(interp, listPtr); @@ -1909,20 +1913,22 @@ DictValuesCmd( { Tcl_Obj *valuePtr, *listPtr; Tcl_DictSearch search; - int result, done; - char *pattern = NULL; + int done; + char *pattern; - if (objc!=3 && objc!=4) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?pattern?"); + if (objc!=2 && objc!=3) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?"); return TCL_ERROR; } - result= Tcl_DictObjFirst(interp, objv[2], &search, NULL, &valuePtr, &done); - if (result != TCL_OK) { + if (Tcl_DictObjFirst(interp, objv[1], &search, NULL, &valuePtr, + &done) != TCL_OK) { return TCL_ERROR; } - if (objc == 4) { - pattern = TclGetString(objv[3]); + if (objc == 3) { + pattern = TclGetString(objv[2]); + } else { + pattern = NULL; } listPtr = Tcl_NewListObj(0, NULL); for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) { @@ -1934,6 +1940,7 @@ DictValuesCmd( Tcl_ListObjAppendElement(interp, listPtr, valuePtr); } } + Tcl_DictObjDone(&search); Tcl_SetObjResult(interp, listPtr); return TCL_OK; @@ -1966,11 +1973,11 @@ DictSizeCmd( { int result, size; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary"); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); return TCL_ERROR; } - result = Tcl_DictObjSize(interp, objv[2], &size); + result = Tcl_DictObjSize(interp, objv[1], &size); if (result == TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewIntObj(size)); } @@ -2005,12 +2012,12 @@ DictExistsCmd( Tcl_Obj *dictPtr, *valuePtr; int result; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary key ?key ...?"); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?"); return TCL_ERROR; } - dictPtr = TclTraceDictPath(interp, objv[2], objc-4, objv+3, + dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2, DICT_PATH_EXISTS); if (dictPtr == NULL) { return TCL_ERROR; @@ -2055,12 +2062,12 @@ DictInfoCmd( Tcl_Obj *dictPtr; Dict *dict; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary"); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); return TCL_ERROR; } - dictPtr = objv[2]; + dictPtr = objv[1]; if (dictPtr->typePtr != &tclDictType) { int result = SetDictFromAny(interp, dictPtr); if (result != TCL_OK) { @@ -2105,19 +2112,19 @@ DictIncrCmd( int code = TCL_OK; Tcl_Obj *dictPtr, *valuePtr = NULL; - if (objc < 4 || objc > 5) { - Tcl_WrongNumArgs(interp, 2, objv, "varName key ?increment?"); + if (objc < 3 || objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?"); return TCL_ERROR; } - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { /* * Variable didn't yet exist. Create new dictionary value. */ dictPtr = Tcl_NewDictObj(); - } else if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { + } else if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) { /* * Variable contents are not a dict, report error. */ @@ -2141,21 +2148,21 @@ DictIncrCmd( * Key not in dictionary. Create new key with increment as value. */ - if (objc == 5) { + if (objc == 4) { /* * Verify increment is an integer. */ mp_int increment; - code = Tcl_GetBignumFromObj(interp, objv[4], &increment); + code = Tcl_GetBignumFromObj(interp, objv[3], &increment); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (reading increment)"); } else { - Tcl_DictObjPut(interp, dictPtr, objv[3], objv[4]); + Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]); } } else { - Tcl_DictObjPut(interp, dictPtr, objv[3], Tcl_NewIntObj(1)); + Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1)); } } else { /* @@ -2164,12 +2171,13 @@ DictIncrCmd( if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); - Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); + Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); } - if (objc == 5) { - code = TclIncrObj(interp, valuePtr, objv[4]); + if (objc == 4) { + code = TclIncrObj(interp, valuePtr, objv[3]); } else { Tcl_Obj *incrPtr = Tcl_NewIntObj(1); + Tcl_IncrRefCount(incrPtr); code = TclIncrObj(interp, valuePtr, incrPtr); Tcl_DecrRefCount(incrPtr); @@ -2177,7 +2185,7 @@ DictIncrCmd( } if (code == TCL_OK) { Tcl_InvalidateStringRep(dictPtr); - valuePtr = Tcl_ObjSetVar2(interp, objv[2], NULL, + valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (valuePtr == NULL) { code = TCL_ERROR; @@ -2218,12 +2226,12 @@ DictLappendCmd( Tcl_Obj *dictPtr, *valuePtr, *resultPtr; int i, allocatedDict = 0, allocatedValue = 0; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "varName key ?value ...?"); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?"); return TCL_ERROR; } - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); @@ -2232,7 +2240,7 @@ DictLappendCmd( dictPtr = Tcl_DuplicateObj(dictPtr); } - if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { + if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } @@ -2240,7 +2248,7 @@ DictLappendCmd( } if (valuePtr == NULL) { - valuePtr = Tcl_NewListObj(objc-4, objv+4); + valuePtr = Tcl_NewListObj(objc-3, objv+3); allocatedValue = 1; } else { if (Tcl_IsShared(valuePtr)) { @@ -2248,7 +2256,7 @@ DictLappendCmd( valuePtr = Tcl_DuplicateObj(valuePtr); } - for (i=4 ; i<objc ; i++) { + for (i=3 ; i<objc ; i++) { if (Tcl_ListObjAppendElement(interp, valuePtr, objv[i]) != TCL_OK) { if (allocatedValue) { @@ -2263,12 +2271,12 @@ DictLappendCmd( } if (allocatedValue) { - Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); + Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); } else if (dictPtr->bytes != NULL) { Tcl_InvalidateStringRep(dictPtr); } - resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; @@ -2305,12 +2313,12 @@ DictAppendCmd( Tcl_Obj *dictPtr, *valuePtr, *resultPtr; int i, allocatedDict = 0; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "varName key ?value ...?"); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?"); return TCL_ERROR; } - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); @@ -2319,7 +2327,7 @@ DictAppendCmd( dictPtr = Tcl_DuplicateObj(dictPtr); } - if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { + if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } @@ -2334,13 +2342,13 @@ DictAppendCmd( } } - for (i=4 ; i<objc ; i++) { + for (i=3 ; i<objc ; i++) { Tcl_AppendObjToObj(valuePtr, objv[i]); } - Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); + Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); - resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; @@ -2374,19 +2382,19 @@ DictForCmd( int objc, Tcl_Obj *const *objv) { - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; Tcl_DictSearch search; int varc, done, result; - if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "{keyVar valueVar} dictionary script"); return TCL_ERROR; } - if (TclListObjGetElements(interp, objv[2], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -2394,11 +2402,11 @@ DictForCmd( TCL_STATIC); return TCL_ERROR; } - keyVarObj = varv[0]; - valueVarObj = varv[1]; - scriptObj = objv[4]; + keyVarObj = varv[0]; + valueVarObj = varv[1]; + scriptObj = objv[3]; - if (Tcl_DictObjFirst(interp, objv[3], &search, &keyObj, &valueObj, + if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } @@ -2442,7 +2450,7 @@ DictForCmd( * TIP #280. Make invoking context available to loop body. */ - result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4); + result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3); if (result == TCL_CONTINUE) { result = TCL_OK; } else if (result != TCL_OK) { @@ -2502,12 +2510,12 @@ DictSetCmd( Tcl_Obj *dictPtr, *resultPtr; int result, allocatedDict = 0; - if (objc < 5) { - Tcl_WrongNumArgs(interp, 2, objv, "varName key ?key ...? value"); + if (objc < 4) { + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value"); return TCL_ERROR; } - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); @@ -2516,7 +2524,7 @@ DictSetCmd( dictPtr = Tcl_DuplicateObj(dictPtr); } - result = Tcl_DictObjPutKeyList(interp, dictPtr, objc-4, objv+3, + result = Tcl_DictObjPutKeyList(interp, dictPtr, objc-3, objv+2, objv[objc-1]); if (result != TCL_OK) { if (allocatedDict) { @@ -2525,7 +2533,7 @@ DictSetCmd( return TCL_ERROR; } - resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; @@ -2562,12 +2570,12 @@ DictUnsetCmd( Tcl_Obj *dictPtr, *resultPtr; int result, allocatedDict = 0; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "varName key ?key ...?"); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?"); return TCL_ERROR; } - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { allocatedDict = 1; dictPtr = Tcl_NewDictObj(); @@ -2576,7 +2584,7 @@ DictUnsetCmd( dictPtr = Tcl_DuplicateObj(dictPtr); } - result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-3, objv+3); + result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-2, objv+2); if (result != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); @@ -2584,7 +2592,7 @@ DictUnsetCmd( return TCL_ERROR; } - resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; @@ -2618,7 +2626,7 @@ DictFilterCmd( int objc, Tcl_Obj *const *objv) { - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; static const char *filters[] = { "key", "script", "value", NULL }; @@ -2631,19 +2639,19 @@ DictFilterCmd( int index, varc, done, result, satisfied; char *pattern; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary filterType ..."); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ..."); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], filters, "filterType", + if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum FilterTypes) index) { case FILTER_KEYS: - if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary key globPattern"); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary key globPattern"); return TCL_ERROR; } @@ -2651,11 +2659,11 @@ DictFilterCmd( * Create a dictionary whose keys all match a certain pattern. */ - if (Tcl_DictObjFirst(interp, objv[2], &search, + if (Tcl_DictObjFirst(interp, objv[1], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } - pattern = TclGetString(objv[4]); + pattern = TclGetString(objv[3]); resultObj = Tcl_NewDictObj(); if (TclMatchIsTrivial(pattern)) { /* @@ -2664,9 +2672,9 @@ DictFilterCmd( */ Tcl_DictObjDone(&search); - Tcl_DictObjGet(interp, objv[2], objv[4], &valueObj); + Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj); if (valueObj != NULL) { - Tcl_DictObjPut(interp, resultObj, objv[4], valueObj); + Tcl_DictObjPut(interp, resultObj, objv[3], valueObj); } } else { while (!done) { @@ -2680,8 +2688,8 @@ DictFilterCmd( return TCL_OK; case FILTER_VALUES: - if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "dictionary value globPattern"); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary value globPattern"); return TCL_ERROR; } @@ -2689,11 +2697,11 @@ DictFilterCmd( * Create a dictionary whose values all match a certain pattern. */ - if (Tcl_DictObjFirst(interp, objv[2], &search, + if (Tcl_DictObjFirst(interp, objv[1], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } - pattern = TclGetString(objv[4]); + pattern = TclGetString(objv[3]); resultObj = Tcl_NewDictObj(); while (!done) { if (Tcl_StringMatch(TclGetString(valueObj), pattern)) { @@ -2705,8 +2713,8 @@ DictFilterCmd( return TCL_OK; case FILTER_SCRIPT: - if (objc != 6) { - Tcl_WrongNumArgs(interp, 2, objv, + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary script {keyVar valueVar} filterScript"); return TCL_ERROR; } @@ -2717,7 +2725,7 @@ DictFilterCmd( * copying from the "dict for" implementation has occurred! */ - if (TclListObjGetElements(interp, objv[4], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -2727,7 +2735,7 @@ DictFilterCmd( } keyVarObj = varv[0]; valueVarObj = varv[1]; - scriptObj = objv[5]; + scriptObj = objv[4]; /* * Make sure that these objects (which we need throughout the body of @@ -2740,7 +2748,7 @@ DictFilterCmd( Tcl_IncrRefCount(valueVarObj); Tcl_IncrRefCount(scriptObj); - result = Tcl_DictObjFirst(interp, objv[2], + result = Tcl_DictObjFirst(interp, objv[1], &search, &keyObj, &valueObj, &done); if (result != TCL_OK) { TclDecrRefCount(keyVarObj); @@ -2779,7 +2787,7 @@ DictFilterCmd( * TIP #280. Make invoking context available to loop body. */ - result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 5); + result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4); switch (result) { case TCL_OK: boolObj = Tcl_GetObjResult(interp); @@ -2878,17 +2886,18 @@ DictUpdateCmd( int objc, Tcl_Obj *const *objv) { + Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *objPtr; int i, result, dummy; Tcl_InterpState state; - if (objc < 6 || objc & 1) { - Tcl_WrongNumArgs(interp, 2, objv, + if (objc < 5 || !(objc & 1)) { + Tcl_WrongNumArgs(interp, 1, objv, "varName key varName ?key varName ...? script"); return TCL_ERROR; } - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (dictPtr == NULL) { return TCL_ERROR; } @@ -2896,7 +2905,7 @@ DictUpdateCmd( return TCL_ERROR; } Tcl_IncrRefCount(dictPtr); - for (i=3 ; i+2<objc ; i+=2) { + for (i=2 ; i+2<objc ; i+=2) { if (Tcl_DictObjGet(interp, dictPtr, objv[i], &objPtr) != TCL_OK) { TclDecrRefCount(dictPtr); return TCL_ERROR; @@ -2916,7 +2925,7 @@ DictUpdateCmd( * Execute the body. */ - result = Tcl_EvalObj(interp, objv[objc-1]); + result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (body of \"dict update\")"); } @@ -2925,7 +2934,7 @@ DictUpdateCmd( * If the dictionary variable doesn't exist, drop everything silently. */ - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { return result; } @@ -2949,7 +2958,7 @@ DictUpdateCmd( * an instruction to remove the key. */ - for (i=3 ; i+2<objc ; i+=2) { + for (i=2 ; i+2<objc ; i+=2) { objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0); if (objPtr == NULL) { Tcl_DictObjRemove(interp, dictPtr, objv[i]); @@ -2971,7 +2980,7 @@ DictUpdateCmd( * Write the dictionary back to its variable. */ - if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DiscardInterpState(state); return TCL_ERROR; @@ -3005,14 +3014,14 @@ DictWithCmd( int objc, Tcl_Obj *const *objv) { - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr; Tcl_DictSearch s; Tcl_InterpState state; - int done, result, keyc, i, allocdict=0; + int done, result, keyc, i, allocdict = 0; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "dictVar ?key ...? script"); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script"); return TCL_ERROR; } @@ -3020,12 +3029,12 @@ DictWithCmd( * Get the dictionary to open out. */ - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (dictPtr == NULL) { return TCL_ERROR; } - if (objc > 4) { - dictPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3, + if (objc > 3) { + dictPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2, DICT_PATH_READ); if (dictPtr == NULL) { return TCL_ERROR; @@ -3071,7 +3080,7 @@ DictWithCmd( * If the dictionary variable doesn't exist, drop everything silently. */ - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (dictPtr == NULL) { TclDecrRefCount(keysPtr); return result; @@ -3093,7 +3102,7 @@ DictWithCmd( allocdict = 1; } - if (objc > 4) { + if (objc > 3) { /* * Want to get to the dictionary which we will update; need to do * prepare-for-update de-sharing along the path *but* avoid generating @@ -3103,7 +3112,7 @@ DictWithCmd( * perfectly efficient (but no memory should be leaked). */ - leafPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3, + leafPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2, DICT_PATH_EXISTS | DICT_PATH_UPDATE); if (leafPtr == NULL) { TclDecrRefCount(keysPtr); @@ -3151,7 +3160,7 @@ DictWithCmd( * rep. */ - if (objc > 4) { + if (objc > 3) { InvalidateDictChain(leafPtr); } @@ -3159,7 +3168,7 @@ DictWithCmd( * Write back the outermost dictionary to the variable. */ - if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DiscardInterpState(state); return TCL_ERROR; @@ -3170,39 +3179,26 @@ DictWithCmd( /* *---------------------------------------------------------------------- * - * Tcl_DictObjCmd -- + * TclInitDictCmd -- * - * This function is invoked to process the "dict" Tcl command. See the - * user documentation for details on what it does, and TIP#111 for the - * formal specification. + * This function is create the "dict" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: - * A standard Tcl result. + * A Tcl command handle. * * Side effects: - * See the user documentation. + * May advance compilation epoch. * *---------------------------------------------------------------------- */ -int -Tcl_DictObjCmd( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const *objv) +Tcl_Command +TclInitDictCmd( + Tcl_Interp *interp) { - int index; - - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], &implementationMap[0].name, - sizeof(EnsembleImplMap), "subcommand", 0, &index) != TCL_OK) { - return TCL_ERROR; - } - return implementationMap[index].proc(clientData, interp, objc, objv); + return TclMakeEnsemble(interp, "dict", implementationMap); } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index f726571..66197fb 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.350 2007/11/21 14:30:34 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.351 2007/11/22 22:16:08 dkf Exp $ */ #ifndef _TCLINT @@ -2704,7 +2704,7 @@ MODULE_SCOPE int TclChanPendingObjCmd( MODULE_SCOPE int TclChanTruncateObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE void TclClockInit(Tcl_Interp*); +MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE int TclClockOldscanObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -2723,9 +2723,7 @@ MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_DictObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -2953,7 +2951,25 @@ MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclCompileDictCmd(Tcl_Interp *interp, +MODULE_SCOPE int TclCompileDictAppendCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictForCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictGetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictIncrCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictLappendCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictSetCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileDictUpdateCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileEnsemble(Tcl_Interp *interp, diff --git a/tests/dict.test b/tests/dict.test index 4d3485b..a296fce 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.21 2007/09/08 22:36:59 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.22 2007/11/22 22:16:08 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -35,10 +35,10 @@ proc getOrder {dictVal args} { test dict-1.1 {dict command basic syntax} { list [catch {dict} msg] $msg -} {1 {wrong # args: should be "dict subcommand ?arg ...?"}} +} {1 {wrong # args: should be "dict subcommand ?argument ...?"}} test dict-1.2 {dict command basic syntax} { list [catch {dict ?} msg] $msg -} {1 {bad subcommand "?": must be append, create, exists, filter, for, get, incr, info, keys, lappend, merge, remove, replace, set, size, unset, update, values, or with}} +} {1 {unknown or ambiguous subcommand "?": must be append, create, exists, filter, for, get, incr, info, keys, lappend, merge, remove, replace, set, size, unset, update, values, or with}} test dict-2.1 {dict create command} { dict create |