diff options
Diffstat (limited to 'generic/tclCompCmds.c')
| -rw-r--r-- | generic/tclCompCmds.c | 642 |
1 files changed, 588 insertions, 54 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 8e1b195..4f962ca 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -7,12 +7,12 @@ * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2002 ActiveState Corporation. - * Copyright (c) 2004 Donal K. Fellows. + * Copyright (c) 2004-2005 by Donal K. Fellows. * * 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.76 2005/07/13 20:33:11 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.77 2005/07/21 21:49:00 dkf Exp $ */ #include "tclInt.h" @@ -79,6 +79,26 @@ ((envPtr)->codeNext - (envPtr)->codeStart) /* + * static int DeclareExceptionRange(CompileEnv *envPtr, int type); + * static int ExceptionRangeStarts(CompileEnv *envPtr, int index); + * static void ExceptionRangeEnds(CompileEnv *envPtr, int index); + * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL); + */ + +#define DeclareExceptionRange(envPtr, type) \ + (((envPtr)->exceptDepth++), \ + ((envPtr)->maxExceptDepth = \ + TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \ + (TclCreateExceptRange((type), (envPtr)))) +#define ExceptionRangeStarts(envPtr, index) \ + ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)) +#define ExceptionRangeEnds(envPtr, index) \ + ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \ + CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset) +#define ExceptionRangeTarget(envPtr, index, targetType) \ + ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr)) + +/* * Prototypes for procedures defined later in this file: */ @@ -266,7 +286,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; CONST char *name; - int resultIndex, optsIndex, nameChars, range, startOffset; + int resultIndex, optsIndex, nameChars, range; int savedStackDepth = envPtr->currStackDepth; /* @@ -330,10 +350,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) * start of the catch body: the subcommand it controls. */ - envPtr->exceptDepth++; - envPtr->maxExceptDepth = - TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); - range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); + range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr); /* @@ -346,17 +363,16 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) */ if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - startOffset = CurrentOffset(envPtr); + ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, cmdTokenPtr, interp); + ExceptionRangeEnds(envPtr, range); } else { TclCompileTokens(interp, cmdTokenPtr+1, cmdTokenPtr->numComponents, envPtr); - startOffset = CurrentOffset(envPtr); + ExceptionRangeStarts(envPtr, range); TclEmitOpcode(INST_EVAL_STK, envPtr); + ExceptionRangeEnds(envPtr, range); } - envPtr->exceptArrayPtr[range].codeOffset = startOffset; - envPtr->exceptArrayPtr[range].numCodeBytes = - CurrentOffset(envPtr) - startOffset; /* * The "no errors" epilogue code: store the body's result into the @@ -401,7 +417,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) */ envPtr->currStackDepth = savedStackDepth; - envPtr->exceptArrayPtr[range].catchOffset = CurrentOffset(envPtr); + ExceptionRangeTarget(envPtr, range, catchOffset); if (resultIndex != -1) { if (optsIndex != -1) { TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr); @@ -484,6 +500,515 @@ TclCompileContinueCmd(interp, parsePtr, envPtr) /* *---------------------------------------------------------------------- * + * TclCompileDictCmd -- + * + * Procedure called to compile the "dict" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "dict" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileDictCmd(interp, parsePtr, envPtr) + Tcl_Interp *interp; /* Used for error reporting. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the + * command created by Tcl_ParseCommand. */ + CompileEnv *envPtr; /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + int numWords, size, i; + const char *cmd; + Proc *procPtr = envPtr->procPtr; + + /* + * There must be at least one argument after the command. + */ + + if (parsePtr->numWords < 2) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + numWords = parsePtr->numWords-2; + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + + /* + * 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, VAR_SCALAR, + procPtr); + for (i=1 ; i<numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp); + 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; + + 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; + + /* + * Note there is a danger that modifying the string could have + * undesirable side effects. In this case, TclLooksLikeInt has no + * dependencies on shared strings so we should be safe. + */ + + if (!TclLooksLikeInt(word, numBytes)) { + return TCL_ERROR; + } + + /* + * Now try to really parse the number. + */ + + intObj = Tcl_NewStringObj(word, numBytes); + Tcl_IncrRefCount(intObj); + code = Tcl_GetIntFromObj(NULL, intObj, &incrAmount); + Tcl_DecrRefCount(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, VAR_SCALAR, + procPtr); + CompileWord(envPtr, keyTokenPtr, interp); + 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. + */ + if (numWords < 2) { + return TCL_ERROR; + } + for (i=0 ; i<numWords ; i++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp); + } + 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, doneTargetOffset; + int endTargetOffset; + const char **argv; + Tcl_DString buffer; + int savedStackDepth = envPtr->currStackDepth; + + if (numWords != 3 || procPtr == NULL) { + return TCL_ERROR; + } + + varsTokenPtr = TokenAfter(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), &numWords, + &argv) != TCL_OK) { + Tcl_DStringFree(&buffer); + return TCL_ERROR; + } + 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, VAR_SCALAR, + procPtr); + nameChars = strlen(argv[1]); + if (!TclIsLocalScalar(argv[1], nameChars)) { + ckfree((char *) argv); + return TCL_ERROR; + } + valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, VAR_SCALAR, + procPtr); + ckfree((char *) argv); + + /* + * 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). + */ + + infoIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr); + + /* + * 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. + */ + + CompileWord(envPtr, dictTokenPtr, interp); + TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); + doneTargetOffset = CurrentOffset(envPtr); + TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); + + /* + * Now we catch errors from here on so that we can finalize the search + * started by Tcl_DictObjFirst above. + */ + + catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr); + ExceptionRangeStarts(envPtr, catchRange); + + /* + * Inside the iteration, write the loop variables. + */ + + bodyTargetOffset = CurrentOffset(envPtr); + TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + + /* + * Set up the loop exception targets. + */ + + loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); + ExceptionRangeStarts(envPtr, loopRange); + + /* + * Compile the loop body itself. It should be stack-neutral. + */ + + CompileBody(envPtr, bodyTokenPtr, interp); + envPtr->currStackDepth = savedStackDepth + 1; + TclEmitOpcode( INST_POP, envPtr); + envPtr->currStackDepth = savedStackDepth; + + /* + * Both exception target ranges (error and loop) end here. + */ + + ExceptionRangeEnds(envPtr, loopRange); + ExceptionRangeEnds(envPtr, catchRange); + + /* + * 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, continueOffset); + TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); + jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr); + TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, 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!) + */ + + jumpDisplacement = CurrentOffset(envPtr) - doneTargetOffset; + TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement, + envPtr->codeStart + doneTargetOffset); + TclEmitOpcode( INST_POP, envPtr); + TclEmitOpcode( INST_POP, envPtr); + + /* + * 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, loopRange, breakOffset); + TclEmitInstInt4( INST_DICT_DONE, infoIndex, envPtr); + TclEmitOpcode( INST_END_CATCH, envPtr); + endTargetOffset = CurrentOffset(envPtr); + TclEmitInstInt4( INST_JUMP4, 0, envPtr); + + /* + * 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); + + /* + * 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); + envPtr->exceptDepth -= 2; + return TCL_OK; + } else if (size==6 && strncmp(cmd, "update", 6)==0) { + const char *name; + int nameChars, dictIndex, keyTmpIndex, numVars, range; + Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr; + Tcl_DString localVarsLiteral; + + /* + * Parse the command. Expect the following: + * dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit> + */ + + if (numWords < 4 || numWords & 1 || procPtr == NULL) { + return TCL_ERROR; + } + numVars = numWords/2 - 1; + dictVarTokenPtr = TokenAfter(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, VAR_SCALAR, + procPtr); + + Tcl_DStringInit(&localVarsLiteral); + keyTokenPtrs = (Tcl_Token **) ckalloc(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) { + Tcl_DStringFree(&localVarsLiteral); + ckfree((char *) keyTokenPtrs); + return TCL_ERROR; + } + name = tokenPtr[1].start; + nameChars = tokenPtr[1].size; + if (!TclIsLocalScalar(name, nameChars)) { + Tcl_DStringFree(&localVarsLiteral); + ckfree((char *) keyTokenPtrs); + return TCL_ERROR; + } else { + int localVar = TclFindCompiledLocal(name, nameChars, 1, + VAR_SCALAR, procPtr); + char buf[12]; + + sprintf(buf, "%d", localVar); + Tcl_DStringAppendElement(&localVarsLiteral, buf); + } + tokenPtr = TokenAfter(tokenPtr); + } + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + Tcl_DStringFree(&localVarsLiteral); + ckfree((char *) keyTokenPtrs); + return TCL_ERROR; + } + bodyTokenPtr = tokenPtr; + + keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, VAR_SCALAR, procPtr); + + for (i=0 ; i<numVars ; i++) { + CompileWord(envPtr, keyTokenPtrs[i], interp); + } + TclEmitInstInt4( INST_LIST, numVars, envPtr); + TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr); + PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral), + Tcl_DStringLength(&localVarsLiteral)); + TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr); + + range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); + TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); + + ExceptionRangeStarts(envPtr, range); + CompileBody(envPtr, bodyTokenPtr, interp); + ExceptionRangeEnds(envPtr, range); + + ExceptionRangeTarget(envPtr, range, catchOffset); + TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); + TclEmitOpcode( INST_PUSH_RESULT, envPtr); + TclEmitOpcode( INST_END_CATCH, envPtr); + envPtr->exceptDepth--; + + TclEmitInstInt4( INST_LOAD_SCALAR4, keyTmpIndex, envPtr); + PushLiteral(envPtr, Tcl_DStringValue(&localVarsLiteral), + Tcl_DStringLength(&localVarsLiteral)); + /* + * Any literal would do, but this one is handy... + */ + TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr); + TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); + + TclEmitOpcode( INST_RETURN_STK, envPtr); + + Tcl_DStringFree(&localVarsLiteral); + ckfree((char *) keyTokenPtrs); + return TCL_OK; + } else if (size==6 && strncmp(cmd, "append", 6) == 0) { + Tcl_Token *varTokenPtr; + int dictVarIndex, nameChars; + const char *name; + + /* + * Arbirary safe limit; anyone exceeding it should stop worrying about + * speed quite so much. ;-) + */ + 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, VAR_SCALAR, + procPtr); + for (i=1 ; i<numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp); + 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 (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, VAR_SCALAR, + procPtr); + CompileWord(envPtr, keyTokenPtr, interp); + CompileWord(envPtr, valueTokenPtr, interp); + TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); + return TCL_OK; + } + + /* + * Something we do not know how to compile. + */ + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileExprCmd -- * * Procedure called to compile the "expr" command. @@ -581,10 +1106,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) * has a -1 continueOffset). */ - envPtr->exceptDepth++; - envPtr->maxExceptDepth = - TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); - bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); /* @@ -612,12 +1134,10 @@ TclCompileForCmd(interp, parsePtr, envPtr) * Compile the loop body. */ - bodyCodeOffset = CurrentOffset(envPtr); - + bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); CompileBody(envPtr, bodyTokenPtr, interp); + ExceptionRangeEnds(envPtr, bodyRange); envPtr->currStackDepth = savedStackDepth + 1; - envPtr->exceptArrayPtr[bodyRange].numCodeBytes = - CurrentOffset(envPtr) - bodyCodeOffset; TclEmitOpcode(INST_POP, envPtr); @@ -625,13 +1145,11 @@ TclCompileForCmd(interp, parsePtr, envPtr) * Compile the "next" subcommand. */ - nextCodeOffset = CurrentOffset(envPtr); - envPtr->currStackDepth = savedStackDepth; + nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); CompileBody(envPtr, nextTokenPtr, interp); + ExceptionRangeEnds(envPtr, nextRange); envPtr->currStackDepth = savedStackDepth + 1; - envPtr->exceptArrayPtr[nextRange].numCodeBytes = - CurrentOffset(envPtr) - nextCodeOffset; TclEmitOpcode(INST_POP, envPtr); envPtr->currStackDepth = savedStackDepth; @@ -661,7 +1179,8 @@ TclCompileForCmd(interp, parsePtr, envPtr) } /* - * Set the loop's offsets and break target. + * Fix the starting points of the exception ranges (may have moved due to + * jump type modification) and set where the exceptions target. */ envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset; @@ -669,9 +1188,8 @@ TclCompileForCmd(interp, parsePtr, envPtr) envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset; - envPtr->exceptArrayPtr[bodyRange].breakOffset = - envPtr->exceptArrayPtr[nextRange].breakOffset = - CurrentOffset(envPtr); + ExceptionRangeTarget(envPtr, bodyRange, breakOffset); + ExceptionRangeTarget(envPtr, nextRange, breakOffset); /* * The for command's result is an empty string. @@ -777,14 +1295,6 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) } /* - * Set the exception stack depth. - */ - - envPtr->exceptDepth++; - envPtr->maxExceptDepth = - TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); - - /* * Break up each var list and set the varcList and varvList arrays. Don't * compile the foreach inline if any var name needs substitutions or isn't * a scalar, or if any var list needs substitutions. @@ -879,10 +1389,14 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr); /* - * Evaluate then store each value list in the associated temporary. + * Create an exception record to handle [break] and [continue]. */ - range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); + + /* + * Evaluate then store each value list in the associated temporary. + */ loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; @@ -914,7 +1428,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * to terminate the loop. */ - envPtr->exceptArrayPtr[range].continueOffset = CurrentOffset(envPtr); + ExceptionRangeTarget(envPtr, range, continueOffset); TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); @@ -922,11 +1436,10 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * Inline compile the loop body. */ - envPtr->exceptArrayPtr[range].codeOffset = CurrentOffset(envPtr); + ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); + ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; - envPtr->exceptArrayPtr[range].numCodeBytes = - CurrentOffset(envPtr) - envPtr->exceptArrayPtr[range].codeOffset; TclEmitOpcode(INST_POP, envPtr); /* @@ -974,7 +1487,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * Set the loop's break target. */ - envPtr->exceptArrayPtr[range].breakOffset = CurrentOffset(envPtr); + ExceptionRangeTarget(envPtr, range, breakOffset); /* * The foreach command's result is an empty string. @@ -2309,6 +2822,31 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) int objc; Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; + /* + * Check for special case which can always be compiled: + * return -options <opts> <msg> + * Unlike the normal [return] compilation, this version does everything at + * runtime so it can handle arbitrary words and not just literals. Note + * that if INST_RETURN_STK wasn't already needed for something else + * ('finally' clause processing) this piece of code would not be present. + */ + + if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) + && (wordTokenPtr[1].size == 8) + && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) { + Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); + Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); + + CompileWord(envPtr, optsTokenPtr, interp); + CompileWord(envPtr, msgTokenPtr, interp); + TclEmitOpcode(INST_RETURN_STK, envPtr); + return TCL_OK; + } + + /* + * Allocate some working space if needed + */ + if (numOptionWords > NUM_STATIC_OBJS) { objv = (Tcl_Obj **) ckalloc(numOptionWords * sizeof(Tcl_Obj *)); } else { @@ -2398,11 +2936,11 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) /* * Could not use the optimization, so we push the return options dict, and - * emit the INST_RETURN instruction with code and level as operands. + * emit the INST_RETURN_IMM instruction with code and level as operands. */ TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr); - TclEmitInstInt4(INST_RETURN, code, envPtr); + TclEmitInstInt4(INST_RETURN_IMM, code, envPtr); TclEmitInt4(level, envPtr); return TCL_OK; } @@ -3318,10 +3856,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * implement break and continue. */ - envPtr->exceptDepth++; - envPtr->maxExceptDepth = - TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); - range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE); /* * Jump to the evaluation of the condition. This code uses the "loop @@ -3348,11 +3883,10 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * Compile the loop body. */ - bodyCodeOffset = CurrentOffset(envPtr); + bodyCodeOffset = ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); + ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; - envPtr->exceptArrayPtr[range].numCodeBytes = - CurrentOffset(envPtr) - bodyCodeOffset; TclEmitOpcode(INST_POP, envPtr); /* @@ -3393,7 +3927,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset; envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset; - envPtr->exceptArrayPtr[range].breakOffset = CurrentOffset(envPtr); + ExceptionRangeTarget(envPtr, range, breakOffset); /* * The while command's result is an empty string. |