summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCompCmds.c976
-rw-r--r--generic/tclDictObj.c378
-rw-r--r--generic/tclInt.h28
4 files changed, 777 insertions, 609 deletions
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,
generated by cgit v0.12 at 2024-11-18 23:03:38 (GMT)