summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c976
1 files changed, 566 insertions, 410 deletions
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;
}
/*