diff options
Diffstat (limited to 'generic/tclCompCmds.c')
| -rw-r--r-- | generic/tclCompCmds.c | 976 |
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; } /* |