diff options
Diffstat (limited to 'generic/tclCompCmds.c')
| -rw-r--r-- | generic/tclCompCmds.c | 1750 |
1 files changed, 887 insertions, 863 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 9598d84..a00106a 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1,33 +1,33 @@ -/* +/* * tclCompCmds.c -- * * This file contains compilation procedures that compile various - * Tcl commands into a sequence of instructions ("bytecodes"). + * Tcl commands into a sequence of instructions ("bytecodes"). * * 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. * * 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.70 2005/06/01 11:00:35 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.71 2005/06/12 22:13:27 dkf Exp $ */ #include "tclInt.h" #include "tclCompile.h" /* - * Macro that encapsulates an efficiency trick that avoids a function - * call for the simplest of compiles. The ANSI C "prototype" for this - * macro is: + * Macro that encapsulates an efficiency trick that avoids a function call for + * the simplest of compiles. The ANSI C "prototype" for this macro is: * - * static void CompileWord _ANSI_ARGS((CompileEnv *envPtr, - * Tcl_Token *tokenPtr, Tcl_Inter *interp)); + * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, + * Tcl_Interp *interp); */ #define CompileWord(envPtr, tokenPtr, interp) \ - if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ + if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ (tokenPtr)[1].size), (envPtr)); \ } else { \ @@ -36,6 +36,49 @@ } /* + * Convenience macro for use when compiling bodies of commands. The ANSI C + * "prototype" for this macro is: + * + * static void CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr, + * Tcl_Interp *interp); + */ + +#define CompileBody(envPtr, tokenPtr, interp) \ + TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ + (envPtr)) + +/* + * Convenience macro for use when pushing literals. The ANSI C "prototype" for + * this macro is: + * + * static void PushLiteral(CompileEnv *envPtr, + * const char *string, int length); + */ + +#define PushLiteral(envPtr, string, length) \ + TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr)) + +/* + * Macro to advance to the next token; it is more mnemonic than the address + * arithmetic that it replaces. The ANSI C "prototype" for this macro is: + * + * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr); + */ + +#define TokenAfter(tokenPtr) \ + ((tokenPtr) + ((tokenPtr)->numComponents + 1)) + +/* + * Macro to get the offset to the next instruction to be issued. The ANSI C + * "prototype" for this macro is: + * + * static int TokenAfter(CompileEnv *envPtr); + */ + +#define CurrentOffset(envPtr) \ + ((envPtr)->codeNext - (envPtr)->codeStart) + +/* * Prototypes for procedures defined later in this file: */ @@ -57,9 +100,9 @@ static int PushVarName _ANSI_ARGS_((Tcl_Interp *interp, */ AuxDataType tclForeachInfoType = { - "ForeachInfo", /* name */ - DupForeachInfo, /* dupProc */ - FreeForeachInfo /* freeProc */ + "ForeachInfo", /* name */ + DupForeachInfo, /* dupProc */ + FreeForeachInfo /* freeProc */ }; /* @@ -70,12 +113,12 @@ AuxDataType tclForeachInfoType = { * Procedure called to compile the "append" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "append" command - * at runtime. + * Instructions are added to envPtr to execute the "append" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -83,8 +126,8 @@ AuxDataType tclForeachInfoType = { int TclCompileAppendCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; @@ -92,41 +135,40 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; if (numWords == 1) { - return TCL_ERROR; + return TCL_ERROR; } else if (numWords == 2) { /* * append varName == set varName */ - return TclCompileSetCmd(interp, parsePtr, envPtr); + return TclCompileSetCmd(interp, parsePtr, envPtr); } else if (numWords > 3) { /* * APPEND instructions currently only handle one value */ - return TCL_ERROR; + return TCL_ERROR; } /* - * Decide if we can use a frame slot for the var/array name or if we - * need to emit code to compute and push the name at runtime. We use a - * frame slot (entry in the array of local vars) if we are compiling a - * procedure body and if the name is simple text that does not include - * namespace qualifiers. + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. */ - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar); /* - * We are doing an assignment, otherwise TclCompileSetCmd was called, - * so push the new value. This will need to be extended to push a - * value for each argument. + * We are doing an assignment, otherwise TclCompileSetCmd was called, so + * push the new value. This will need to be extended to push a value for + * each argument. */ if (numWords > 2) { - valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + valueTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, valueTokenPtr, interp); } @@ -136,24 +178,20 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) if (simpleVarName) { if (isScalar) { - if (localIndex >= 0) { - if (localIndex <= 255) { - TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr); - } else { - TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr); - } - } else { + if (localIndex < 0) { TclEmitOpcode(INST_APPEND_STK, envPtr); + } else if (localIndex <= 255) { + TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr); + } else { + TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr); } } else { - if (localIndex >= 0) { - if (localIndex <= 255) { - TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr); - } else { - TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr); - } - } else { + if (localIndex < 0) { TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr); + } else if (localIndex <= 255) { + TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr); + } else { + TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr); } } } else { @@ -171,12 +209,12 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) * Procedure called to compile the "break" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "break" command - * at runtime. + * Instructions are added to envPtr to execute the "break" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -184,8 +222,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) int TclCompileBreakCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { if (parsePtr->numWords != 1) { @@ -208,12 +246,12 @@ TclCompileBreakCmd(interp, parsePtr, envPtr) * Procedure called to compile the "catch" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "catch" command - * at runtime. + * Instructions are added to envPtr to execute the "catch" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -232,8 +270,8 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) int savedStackDepth = envPtr->currStackDepth; /* - * If syntax does not match what we expect for [catch], do not - * compile. Let runtime checks determine if syntax has changed. + * If syntax does not match what we expect for [catch], do not compile. + * Let runtime checks determine if syntax has changed. */ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { return TCL_ERROR; @@ -241,8 +279,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) /* * If a variable was specified and the catch command is at global level - * (not in a procedure), don't compile it inline: the payoff is - * too small. + * (not in a procedure), don't compile it inline: the payoff is too small. */ if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) { @@ -255,10 +292,9 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) */ localIndex = -1; - cmdTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); if (parsePtr->numWords == 3) { - nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1); + nameTokenPtr = TokenAfter(cmdTokenPtr); /* DGP */ if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { name = nameTokenPtr[1].start; @@ -267,51 +303,50 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) return TCL_ERROR; } localIndex = TclFindCompiledLocal(nameTokenPtr[1].start, - nameTokenPtr[1].size, /*create*/ 1, - /*flags*/ VAR_SCALAR, envPtr->procPtr); + nameTokenPtr[1].size, /*create*/ 1, VAR_SCALAR, + envPtr->procPtr); } else { return TCL_ERROR; } } /* - * We will compile the catch command. Emit a beginCatch instruction at - * the start of the catch body: the subcommand it controls. + * We will compile the catch command. Emit a beginCatch instruction at the + * start of the catch body: the subcommand it controls. */ envPtr->exceptDepth++; envPtr->maxExceptDepth = - TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); + TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr); /* - * If the body is a simple word, compile the instructions to - * eval it. Otherwise, compile instructions to substitute its - * text without catching, a catch instruction that resets the - * stack to what it was before substituting the body, and then - * an instruction to eval the body. Care has to be taken to - * register the correct startOffset for the catch range so that - * errors in the substitution are not catched [Bug 219184] + * If the body is a simple word, compile the instructions to eval it. + * Otherwise, compile instructions to substitute its text without + * catching, a catch instruction that resets the stack to what it was + * before substituting the body, and then an instruction to eval the body. + * Care has to be taken to register the correct startOffset for the catch + * range so that errors in the substitution are not catched [Bug 219184] */ if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - startOffset = (envPtr->codeNext - envPtr->codeStart); - TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr); + startOffset = CurrentOffset(envPtr); + CompileBody(envPtr, cmdTokenPtr, envPtr); } else { TclCompileTokens(interp, cmdTokenPtr+1, - cmdTokenPtr->numComponents, envPtr); - startOffset = (envPtr->codeNext - envPtr->codeStart); + cmdTokenPtr->numComponents, envPtr); + startOffset = CurrentOffset(envPtr); TclEmitOpcode(INST_EVAL_STK, envPtr); } envPtr->exceptArrayPtr[range].codeOffset = startOffset; envPtr->exceptArrayPtr[range].numCodeBytes = - (envPtr->codeNext - envPtr->codeStart) - startOffset; + CurrentOffset(envPtr) - startOffset; /* * The "no errors" epilogue code: store the body's result into the - * variable (if any), push "0" (TCL_OK) as the catch's "no error" - * result, and jump around the "error case" code. + * variable (if any), push "0" (TCL_OK) as the catch's "no error" result, + * and jump around the "error case" code. */ if (localIndex != -1) { @@ -322,7 +357,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) } } TclEmitOpcode(INST_POP, envPtr); - TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); + PushLiteral(envPtr, "0", 1); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* @@ -332,8 +367,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) */ envPtr->currStackDepth = savedStackDepth; - envPtr->exceptArrayPtr[range].catchOffset = - (envPtr->codeNext - envPtr->codeStart); + envPtr->exceptArrayPtr[range].catchOffset = CurrentOffset(envPtr); if (localIndex != -1) { TclEmitOpcode(INST_PUSH_RESULT, envPtr); if (localIndex <= 255) { @@ -347,13 +381,13 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) /* - * Update the target of the jump after the "no errors" code, then emit - * an endCatch instruction at the end of the catch command. + * Update the target of the jump after the "no errors" code, then emit an + * endCatch instruction at the end of the catch command. */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileCatchCmd: bad jump distance %d\n", - (envPtr->codeNext - envPtr->codeStart) - jumpFixup.codeOffset); + CurrentOffset(envPtr) - jumpFixup.codeOffset); } TclEmitOpcode(INST_END_CATCH, envPtr); @@ -370,12 +404,12 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) * Procedure called to compile the "continue" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "continue" command - * at runtime. + * Instructions are added to envPtr to execute the "continue" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -411,12 +445,12 @@ TclCompileContinueCmd(interp, parsePtr, envPtr) * Procedure called to compile the "expr" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "expr" command - * at runtime. + * Instructions are added to envPtr to execute the "expr" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -434,9 +468,8 @@ TclCompileExprCmd(interp, parsePtr, envPtr) return TCL_ERROR; } - firstWordPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); - TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1), envPtr); + firstWordPtr = TokenAfter(parsePtr->tokenPtr); + TclCompileExprWords(interp, firstWordPtr, parsePtr->numWords-1, envPtr); return TCL_OK; } @@ -448,12 +481,12 @@ TclCompileExprCmd(interp, parsePtr, envPtr) * Procedure called to compile the "for" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "for" command - * at runtime. + * Instructions are added to envPtr to execute the "for" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -480,9 +513,8 @@ TclCompileForCmd(interp, parsePtr, envPtr) * execute or execute forever, as in "for {} "$x > 5" {incr x} {}". */ - startTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); - testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1); + startTokenPtr = TokenAfter(parsePtr->tokenPtr); + testTokenPtr = TokenAfter(startTokenPtr); if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } @@ -492,17 +524,17 @@ TclCompileForCmd(interp, parsePtr, envPtr) * in order to insure correct behaviour [Bug 219166] */ - nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); - bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1); - if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) + nextTokenPtr = TokenAfter(testTokenPtr); + bodyTokenPtr = TokenAfter(nextTokenPtr); + if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { return TCL_ERROR; } /* - * Create ExceptionRange records for the body and the "next" command. - * The "next" command's ExceptionRange supports break but not continue - * (and has a -1 continueOffset). + * Create ExceptionRange records for the body and the "next" command. The + * "next" command's ExceptionRange supports break but not continue (and + * has a -1 continueOffset). */ envPtr->exceptDepth++; @@ -515,8 +547,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) * Inline compile the initial command. */ - TclCompileCmdWord(interp, startTokenPtr+1, - startTokenPtr->numComponents, envPtr); + CompileBody(envPtr, startTokenPtr, interp); TclEmitOpcode(INST_POP, envPtr); /* @@ -537,13 +568,12 @@ TclCompileForCmd(interp, parsePtr, envPtr) * Compile the loop body. */ - bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart); + bodyCodeOffset = CurrentOffset(envPtr); - TclCompileCmdWord(interp, bodyTokenPtr+1, - bodyTokenPtr->numComponents, envPtr); + CompileBody(envPtr, bodyTokenPtr, interp); envPtr->currStackDepth = savedStackDepth + 1; envPtr->exceptArrayPtr[bodyRange].numCodeBytes = - (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset; + CurrentOffset(envPtr) - bodyCodeOffset; TclEmitOpcode(INST_POP, envPtr); @@ -551,15 +581,13 @@ TclCompileForCmd(interp, parsePtr, envPtr) * Compile the "next" subcommand. */ - nextCodeOffset = (envPtr->codeNext - envPtr->codeStart); + nextCodeOffset = CurrentOffset(envPtr); envPtr->currStackDepth = savedStackDepth; - TclCompileCmdWord(interp, nextTokenPtr+1, - nextTokenPtr->numComponents, envPtr); + CompileBody(envPtr, nextTokenPtr, interp); envPtr->currStackDepth = savedStackDepth + 1; envPtr->exceptArrayPtr[nextRange].numCodeBytes = - (envPtr->codeNext - envPtr->codeStart) - - nextCodeOffset; + CurrentOffset(envPtr) - nextCodeOffset; TclEmitOpcode(INST_POP, envPtr); envPtr->currStackDepth = savedStackDepth; @@ -568,7 +596,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) * terminates the for. */ - testCodeOffset = (envPtr->codeNext - envPtr->codeStart); + testCodeOffset = CurrentOffset(envPtr); jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { @@ -581,7 +609,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) TclCompileExprWords(interp, testTokenPtr, 1, envPtr); envPtr->currStackDepth = savedStackDepth + 1; - jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset; + jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr); } else { @@ -598,15 +626,15 @@ TclCompileForCmd(interp, parsePtr, envPtr) envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset; envPtr->exceptArrayPtr[bodyRange].breakOffset = - envPtr->exceptArrayPtr[nextRange].breakOffset = - (envPtr->codeNext - envPtr->codeStart); + envPtr->exceptArrayPtr[nextRange].breakOffset = + CurrentOffset(envPtr); /* * The for command's result is an empty string. */ envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushLiteral(envPtr, "", 0); envPtr->exceptDepth--; return TCL_OK; @@ -620,12 +648,12 @@ TclCompileForCmd(interp, parsePtr, envPtr) * Procedure called to compile the "foreach" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "foreach" command - * at runtime. + * Instructions are added to envPtr to execute the "foreach" command at + * runtime. * n*---------------------------------------------------------------------- */ @@ -679,12 +707,11 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) } /* - * Bail out if the body requires substitutions - * in order to insure correct behaviour [Bug 219166] + * Bail out if the body requires substitutions in order to insure correct + * behaviour [Bug 219166] */ - for (i = 0, tokenPtr = parsePtr->tokenPtr; - i < numWords-1; - i++, tokenPtr += (tokenPtr->numComponents + 1)) { + for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++) { + tokenPtr = TokenAfter(tokenPtr); } bodyTokenPtr = tokenPtr; if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -697,70 +724,73 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) numLists = (numWords - 2)/2; if (numLists > STATIC_VAR_LIST_SIZE) { - varcList = (int *) ckalloc(numLists * sizeof(int)); - varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **)); + varcList = (int *) ckalloc(numLists * sizeof(int)); + varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **)); } for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - varcList[loopIndex] = 0; - varvList[loopIndex] = NULL; + varcList[loopIndex] = 0; + varvList[loopIndex] = NULL; } /* * 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. + * 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. */ loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; - i++, tokenPtr += (tokenPtr->numComponents + 1)) { - if (i%2 == 1) { - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + i++, tokenPtr = TokenAfter(tokenPtr)) { + Tcl_DString varList; + + if (i%2 != 1) { + continue; + } + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + code = TCL_ERROR; + goto done; + } + + /* + * Lots of copying going on here. Need a ListObj wizard to show a + * better way. + */ + + Tcl_DStringInit(&varList); + Tcl_DStringAppend(&varList, tokenPtr[1].start, tokenPtr[1].size); + code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), + &varcList[loopIndex], &varvList[loopIndex]); + Tcl_DStringFree(&varList); + if (code != TCL_OK) { + code = TCL_ERROR; + goto done; + } + numVars = varcList[loopIndex]; + for (j = 0; j < numVars; j++) { + CONST char *varName = varvList[loopIndex][j]; + if (!TclIsLocalScalar(varName, (int) strlen(varName))) { code = TCL_ERROR; goto done; - } else { - /* Lots of copying going on here. Need a ListObj wizard - * to show a better way. */ - - Tcl_DString varList; - - Tcl_DStringInit(&varList); - Tcl_DStringAppend(&varList, tokenPtr[1].start, - tokenPtr[1].size); - code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), - &varcList[loopIndex], &varvList[loopIndex]); - Tcl_DStringFree(&varList); - if (code != TCL_OK) { - code = TCL_ERROR; - goto done; - } - numVars = varcList[loopIndex]; - for (j = 0; j < numVars; j++) { - CONST char *varName = varvList[loopIndex][j]; - if (!TclIsLocalScalar(varName, (int) strlen(varName))) { - code = TCL_ERROR; - goto done; - } - } } - loopIndex++; } + loopIndex++; } /* - * We will compile the foreach command. - * Reserve (numLists + 1) temporary variables: + * We will compile the foreach command. Reserve (numLists + 1) temporary + * variables: * - numLists temps to hold each value list * - 1 temp for the loop counter (index of next element in each list) + * * At this time we don't try to reuse temporaries; if there are two * nonoverlapping foreach loops, they don't share any temps. */ @@ -769,13 +799,13 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) firstValueTemp = -1; for (loopIndex = 0; loopIndex < numLists; loopIndex++) { tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr); + /*create*/ 1, VAR_SCALAR, procPtr); if (loopIndex == 0) { firstValueTemp = tempVar; } } loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr); + /*create*/ 1, VAR_SCALAR, procPtr); /* * Create and initialize the ForeachInfo and ForeachVarList data @@ -784,7 +814,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) */ infoPtr = (ForeachInfo *) ckalloc((unsigned) - (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *)))); + sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *)); infoPtr->numLists = numLists; infoPtr->firstValueTemp = firstValueTemp; infoPtr->loopCtTemp = loopCtTemp; @@ -792,13 +822,13 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) ForeachVarList *varListPtr; numVars = varcList[loopIndex]; varListPtr = (ForeachVarList *) ckalloc((unsigned) - sizeof(ForeachVarList) + (numVars * sizeof(int))); + sizeof(ForeachVarList) + numVars*sizeof(int)); varListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { CONST char *varName = varvList[loopIndex][j]; int nameChars = strlen(varName); varListPtr->varIndexes[j] = TclFindCompiledLocal(varName, - nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr); + nameChars, /*create*/ 1, VAR_SCALAR, procPtr); } infoPtr->varLists[loopIndex] = varListPtr; } @@ -813,7 +843,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; - i++, tokenPtr += (tokenPtr->numComponents + 1)) { + i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); @@ -840,8 +870,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * to terminate the loop. */ - envPtr->exceptArrayPtr[range].continueOffset = - (envPtr->codeNext - envPtr->codeStart); + envPtr->exceptArrayPtr[range].continueOffset = CurrentOffset(envPtr); TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); @@ -849,26 +878,22 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * Inline compile the loop body. */ - envPtr->exceptArrayPtr[range].codeOffset = - (envPtr->codeNext - envPtr->codeStart); - TclCompileCmdWord(interp, bodyTokenPtr+1, - bodyTokenPtr->numComponents, envPtr); + envPtr->exceptArrayPtr[range].codeOffset = CurrentOffset(envPtr); + CompileBody(envPtr, bodyTokenPtr, interp); envPtr->currStackDepth = savedStackDepth + 1; envPtr->exceptArrayPtr[range].numCodeBytes = - (envPtr->codeNext - envPtr->codeStart) - - envPtr->exceptArrayPtr[range].codeOffset; + CurrentOffset(envPtr) - envPtr->exceptArrayPtr[range].codeOffset; TclEmitOpcode(INST_POP, envPtr); /* - * Jump back to the test at the top of the loop. Generate a 4 byte jump - * if the distance to the test is > 120 bytes. This is conservative and + * Jump back to the test at the top of the loop. Generate a 4 byte jump if + * the distance to the test is > 120 bytes. This is conservative and * ensures that we won't have to replace this jump if we later need to * replace the ifFalse jump with a 4 byte jump. */ - jumpBackOffset = (envPtr->codeNext - envPtr->codeStart); - jumpBackDist = - (jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset); + jumpBackOffset = CurrentOffset(envPtr); + jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset; if (jumpBackDist > 120) { TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr); } else { @@ -905,18 +930,17 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * Set the loop's break target. */ - envPtr->exceptArrayPtr[range].breakOffset = - (envPtr->codeNext - envPtr->codeStart); + envPtr->exceptArrayPtr[range].breakOffset = CurrentOffset(envPtr); /* * The foreach command's result is an empty string. */ envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushLiteral(envPtr, "", 0); envPtr->currStackDepth = savedStackDepth + 1; - done: + done: for (loopIndex = 0; loopIndex < numLists; loopIndex++) { if (varvList[loopIndex] != (CONST char **) NULL) { ckfree((char *) varvList[loopIndex]); @@ -924,7 +948,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) } if (varcList != varcListStaticSpace) { ckfree((char *) varcList); - ckfree((char *) varvList); + ckfree((char *) varvList); } envPtr->exceptDepth--; return code; @@ -935,8 +959,8 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * * DupForeachInfo -- * - * This procedure duplicates a ForeachInfo structure created as - * auxiliary data during the compilation of a foreach command. + * This procedure duplicates a ForeachInfo structure created as auxiliary + * data during the compilation of a foreach command. * * Results: * A pointer to a newly allocated copy of the existing ForeachInfo @@ -944,9 +968,9 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) * * Side effects: * Storage for the copied ForeachInfo record is allocated. If the - * original ForeachInfo structure pointed to any ForeachVarList - * records, these structures are also copied and pointers to them - * are stored in the new ForeachInfo record. + * original ForeachInfo structure pointed to any ForeachVarList records, + * these structures are also copied and pointers to them are stored in + * the new ForeachInfo record. * *---------------------------------------------------------------------- */ @@ -963,7 +987,7 @@ DupForeachInfo(clientData) int numVars, i, j; dupPtr = (ForeachInfo *) ckalloc((unsigned) - (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *)))); + sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; dupPtr->loopCtTemp = srcPtr->loopCtTemp; @@ -972,7 +996,7 @@ DupForeachInfo(clientData) srcListPtr = srcPtr->varLists[i]; numVars = srcListPtr->numVars; dupListPtr = (ForeachVarList *) ckalloc((unsigned) - sizeof(ForeachVarList) + numVars*sizeof(int)); + sizeof(ForeachVarList) + numVars*sizeof(int)); dupListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j]; @@ -1026,45 +1050,45 @@ FreeForeachInfo(clientData) * Procedure called to compile the "if" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "if" command - * at runtime. + * Instructions are added to envPtr to execute the "if" command at + * runtime. * *---------------------------------------------------------------------- */ int TclCompileIfCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { JumpFixupArray jumpFalseFixupArray; /* Used to fix the ifFalse jump after each * test when its target PC is determined. */ JumpFixupArray jumpEndFixupArray; - /* Used to fix the jump after each "then" - * body to the end of the "if" when that PC - * is determined. */ + /* Used to fix the jump after each "then" body + * to the end of the "if" when that PC is + * determined. */ Tcl_Token *tokenPtr, *testTokenPtr; int jumpFalseDist; - int jumpIndex = 0; /* avoid compiler warning. */ + int jumpIndex = 0; /* avoid compiler warning. */ int numWords, wordIdx, numBytes, j, code; CONST char *word; int savedStackDepth = envPtr->currStackDepth; - /* Saved stack depth at the start of the first + /* Saved stack depth at the start of the first * test; the envPtr current depth is restored * to this value at the start of each test. */ - int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */ - int boolVal; /* value of static condition */ - int compileScripts = 1; + int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */ + int boolVal; /* value of static condition */ + int compileScripts = 1; /* - * Only compile the "if" command if all arguments are simple - * words, in order to insure correct substitution [Bug 219166] + * Only compile the "if" command if all arguments are simple words, in + * order to insure correct substitution [Bug 219166] */ tokenPtr = parsePtr->tokenPtr; @@ -1084,8 +1108,8 @@ TclCompileIfCmd(interp, parsePtr, envPtr) code = TCL_OK; /* - * Each iteration of this loop compiles one "if expr ?then? body" - * or "elseif expr ?then? body" clause. + * Each iteration of this loop compiles one "if expr ?then? body" or + * "elseif expr ?then? body" clause. */ tokenPtr = parsePtr->tokenPtr; @@ -1098,8 +1122,8 @@ TclCompileIfCmd(interp, parsePtr, envPtr) word = tokenPtr[1].start; numBytes = tokenPtr[1].size; if ((tokenPtr == parsePtr->tokenPtr) - || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) { - tokenPtr += (tokenPtr->numComponents + 1); + || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) { + tokenPtr = TokenAfter(tokenPtr); wordIdx++; } else { break; @@ -1110,8 +1134,8 @@ TclCompileIfCmd(interp, parsePtr, envPtr) } /* - * Compile the test expression then emit the conditional jump - * around the "then" part. + * Compile the test expression then emit the conditional jump around + * the "then" part. */ envPtr->currStackDepth = savedStackDepth; @@ -1120,7 +1144,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) if (realCond) { /* - * Find out if the condition is a constant. + * Find out if the condition is a constant. */ Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start, @@ -1145,7 +1169,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) jumpIndex = jumpFalseFixupArray.next; jumpFalseFixupArray.next++; TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, - &(jumpFalseFixupArray.fixup[jumpIndex])); + jumpFalseFixupArray.fixup+jumpIndex); } code = TCL_OK; } @@ -1155,7 +1179,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * Skip over the optional "then" before the then clause. */ - tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); + tokenPtr = TokenAfter(testTokenPtr); wordIdx++; if (wordIdx >= numWords) { code = TCL_ERROR; @@ -1165,7 +1189,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) word = tokenPtr[1].start; numBytes = tokenPtr[1].size; if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) { - tokenPtr += (tokenPtr->numComponents + 1); + tokenPtr = TokenAfter(tokenPtr); wordIdx++; if (wordIdx >= numWords) { code = TCL_ERROR; @@ -1180,14 +1204,13 @@ TclCompileIfCmd(interp, parsePtr, envPtr) if (compileScripts) { envPtr->currStackDepth = savedStackDepth; - TclCompileCmdWord(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); + CompileBody(envPtr, tokenPtr, interp); } if (realCond) { /* - * Jump to the end of the "if" command. Both jumpFalseFixupArray and - * jumpEndFixupArray are indexed by "jumpIndex". + * Jump to the end of the "if" command. Both jumpFalseFixupArray + * and jumpEndFixupArray are indexed by "jumpIndex". */ if (jumpEndFixupArray.next >= jumpEndFixupArray.end) { @@ -1195,18 +1218,18 @@ TclCompileIfCmd(interp, parsePtr, envPtr) } jumpEndFixupArray.next++; TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &(jumpEndFixupArray.fixup[jumpIndex])); + jumpEndFixupArray.fixup+jumpIndex); /* - * Fix the target of the jumpFalse after the test. Generate a 4 byte - * jump if the distance is > 120 bytes. This is conservative, and - * ensures that we won't have to replace this jump if we later also - * need to replace the proceeding jump to the end of the "if" with a - * 4 byte jump. + * Fix the target of the jumpFalse after the test. Generate a 4 + * byte jump if the distance is > 120 bytes. This is conservative, + * and ensures that we won't have to replace this jump if we later + * also need to replace the proceeding jump to the end of the "if" + * with a 4 byte jump. */ if (TclFixupForwardJumpToHere(envPtr, - &(jumpFalseFixupArray.fixup[jumpIndex]), 120)) { + jumpFalseFixupArray.fixup+jumpIndex, 120)) { /* * Adjust the code offset for the proceeding jump to the end * of the "if" command. @@ -1215,40 +1238,38 @@ TclCompileIfCmd(interp, parsePtr, envPtr) jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3; } } else if (boolVal) { - /* - *We were processing an "if 1 {...}"; stop compiling - * scripts + /* + * We were processing an "if 1 {...}"; stop compiling scripts. */ compileScripts = 0; } else { - /* - *We were processing an "if 0 {...}"; reset so that - * the rest (elseif, else) is compiled correctly + /* + * We were processing an "if 0 {...}"; reset so that the rest + * (elseif, else) is compiled correctly. */ realCond = 1; compileScripts = 1; - } + } - tokenPtr += (tokenPtr->numComponents + 1); + tokenPtr = TokenAfter(tokenPtr); wordIdx++; } /* - * Restore the current stack depth in the environment; the - * "else" clause (or its default) will add 1 to this. + * Restore the current stack depth in the environment; the "else" clause + * (or its default) will add 1 to this. */ envPtr->currStackDepth = savedStackDepth; /* - * Check for the optional else clause. Do not compile - * anything if this was an "if 1 {...}" case. + * Check for the optional else clause. Do not compile anything if this was + * an "if 1 {...}" case. */ - if ((wordIdx < numWords) - && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { + if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { /* * There is an else clause. Skip over the optional "else" word. */ @@ -1256,7 +1277,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) word = tokenPtr[1].start; numBytes = tokenPtr[1].size; if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) { - tokenPtr += (tokenPtr->numComponents + 1); + tokenPtr = TokenAfter(tokenPtr); wordIdx++; if (wordIdx >= numWords) { code = TCL_ERROR; @@ -1269,8 +1290,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * Compile the else command body. */ - TclCompileCmdWord(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); + CompileBody(envPtr, tokenPtr, interp); } /* @@ -1288,7 +1308,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) */ if (compileScripts) { - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushLiteral(envPtr, "", 0); } } @@ -1299,14 +1319,14 @@ TclCompileIfCmd(interp, parsePtr, envPtr) for (j = jumpEndFixupArray.next; j > 0; j--) { jumpIndex = (j - 1); /* i.e. process the closest jump first */ if (TclFixupForwardJumpToHere(envPtr, - &(jumpEndFixupArray.fixup[jumpIndex]), 127)) { + jumpEndFixupArray.fixup+jumpIndex, 127)) { /* - * Adjust the immediately preceeding "ifFalse" jump. We moved - * it's target (just after this jump) down three bytes. + * Adjust the immediately preceeding "ifFalse" jump. We moved it's + * target (just after this jump) down three bytes. */ unsigned char *ifFalsePc = envPtr->codeStart - + jumpFalseFixupArray.fixup[jumpIndex].codeOffset; + + jumpFalseFixupArray.fixup[jumpIndex].codeOffset; unsigned char opCode = *ifFalsePc; if (opCode == INST_JUMP_FALSE1) { jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1); @@ -1317,7 +1337,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) jumpFalseDist += 3; TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1)); } else { - Tcl_Panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump"); + Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode); } } } @@ -1326,7 +1346,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * Free the jumpFixupArray array if malloc'ed storage was used. */ - done: + done: envPtr->currStackDepth = savedStackDepth + 1; TclFreeJumpFixupArray(&jumpFalseFixupArray); TclFreeJumpFixupArray(&jumpEndFixupArray); @@ -1341,12 +1361,12 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * Procedure called to compile the "incr" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "incr" command - * at runtime. + * Instructions are added to envPtr to execute the "incr" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -1365,11 +1385,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) return TCL_ERROR; } - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarName(interp, varTokenPtr, envPtr, - (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR), + PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar); /* @@ -1380,7 +1398,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) haveImmValue = 0; immValue = 1; if (parsePtr->numWords == 3) { - incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + incrTokenPtr = TokenAfter(varTokenPtr); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { CONST char *word = incrTokenPtr[1].start; int numBytes = incrTokenPtr[1].size; @@ -1403,12 +1421,11 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) } } if (!haveImmValue) { - TclEmitPush( - TclRegisterNewLiteral(envPtr, word, numBytes), envPtr); + PushLiteral(envPtr, word, numBytes); } } else { - TclCompileTokens(interp, incrTokenPtr+1, - incrTokenPtr->numComponents, envPtr); + TclCompileTokens(interp, incrTokenPtr+1, + incrTokenPtr->numComponents, envPtr); } } else { /* no incr amount given so use 1 */ haveImmValue = 1; @@ -1469,12 +1486,12 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) * Procedure called to compile the "lappend" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "lappend" command - * at runtime. + * Instructions are added to envPtr to execute the "lappend" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -1486,7 +1503,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * command created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { - Tcl_Token *varTokenPtr, *valueTokenPtr; + Tcl_Token *varTokenPtr; int simpleVarName, isScalar, localIndex, numWords; /* @@ -1504,7 +1521,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) /* * LAPPEND instructions currently only handle one value appends */ - return TCL_ERROR; + return TCL_ERROR; } /* @@ -1512,22 +1529,21 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * need to emit code to compute and push the name at runtime. We use a * frame slot (entry in the array of local vars) if we are compiling a * procedure body and if the name is simple text that does not include - * namespace qualifiers. + * namespace qualifiers. */ - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar); /* - * If we are doing an assignment, push the new value. - * In the no values case, create an empty object. + * If we are doing an assignment, push the new value. In the no values + * case, create an empty object. */ if (numWords > 2) { - valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, valueTokenPtr, interp); } @@ -1541,24 +1557,20 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) */ if (simpleVarName) { if (isScalar) { - if (localIndex >= 0) { - if (localIndex <= 255) { - TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr); - } else { - TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr); - } - } else { + if (localIndex < 0) { TclEmitOpcode(INST_LAPPEND_STK, envPtr); + } else if (localIndex <= 255) { + TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr); + } else { + TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr); } } else { - if (localIndex >= 0) { - if (localIndex <= 255) { - TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr); - } else { - TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr); - } - } else { + if (localIndex < 0) { TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr); + } else if (localIndex <= 255) { + TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr); + } else { + TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr); } } } else { @@ -1576,12 +1588,12 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * Procedure called to compile the "lassign" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "lassign" command - * at runtime. + * Instructions are added to envPtr to execute the "lassign" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -1607,14 +1619,14 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) /* * Generate code to push list being taken apart by [lassign]. */ - tokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); + tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp); /* * Generate code to assign values from the list to variables */ for (idx=0 ; idx<numWords-2 ; idx++) { - tokenPtr += tokenPtr->numComponents + 1; + tokenPtr = TokenAfter(tokenPtr); /* * Generate the next variable name @@ -1623,8 +1635,8 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) &localIndex, &simpleVarName, &isScalar); /* - * Emit instructions to get the idx'th item out of the list - * value on the stack and assign it to the variable. + * Emit instructions to get the idx'th item out of the list value on + * the stack and assign it to the variable. */ if (simpleVarName) { if (isScalar) { @@ -1681,12 +1693,12 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) * Procedure called to compile the "lindex" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "lindex" command - * at runtime. + * Instructions are added to envPtr to execute the "lindex" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -1694,13 +1706,12 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) int TclCompileLindexCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; - int i, numWords; - numWords = parsePtr->numWords; + int i, numWords = parsePtr->numWords; /* * Quit if too few args @@ -1710,36 +1721,36 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) return TCL_ERROR; } - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); if ((numWords == 3) && (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) && TclLooksLikeInt(varTokenPtr[1].start, varTokenPtr[1].size)) { Tcl_Obj *tmpObj; - int idx; + int idx, result; tmpObj = Tcl_NewStringObj(varTokenPtr[1].start, varTokenPtr[1].size); - if (Tcl_GetIntFromObj(NULL, tmpObj, &idx) == TCL_OK && idx >= 0) { - TclDecrRefCount(tmpObj); - varTokenPtr += varTokenPtr->numComponents + 1; + result = Tcl_GetIntFromObj(NULL, tmpObj, &idx); + TclDecrRefCount(tmpObj); + + if (result == TCL_OK && idx >= 0) { /* - * All checks have been completed, and we have exactly - * this construct: + * All checks have been completed, and we have exactly this + * construct: * lindex <posInt> <arbitraryValue> - * This is best compiled as a push of the arbitrary value - * followed by an "immediate lindex" which is the most - * efficient variety. + * This is best compiled as a push of the arbitrary value followed + * by an "immediate lindex" which is the most efficient variety. */ + + varTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, varTokenPtr, interp); TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); return TCL_OK; - } else { - /* - * If the conversion failed or the value was negative, we - * just keep on going with the more complex compilation. - */ - TclDecrRefCount(tmpObj); } + + /* + * If the conversion failed or the value was negative, we just keep on + * going with the more complex compilation. + */ } /* @@ -1748,12 +1759,12 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) for (i=1 ; i<numWords ; i++) { CompileWord(envPtr, varTokenPtr, interp); - varTokenPtr += varTokenPtr->numComponents + 1; + varTokenPtr = TokenAfter(varTokenPtr); } /* - * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI - * if there are multiple index args. + * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are + * multiple index args. */ if (numWords == 3) { @@ -1773,12 +1784,12 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) * Procedure called to compile the "list" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "list" command - * at runtime. + * Instructions are added to envPtr to execute the "list" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -1786,8 +1797,8 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) int TclCompileListCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { /* @@ -1799,10 +1810,10 @@ TclCompileListCmd(interp, parsePtr, envPtr) if (parsePtr->numWords == 1) { /* - * Empty args case + * [list] without arguments just pushes an empty object. */ - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushLiteral(envPtr, "", 0); } else { /* * Push the all values onto the stack. @@ -1812,11 +1823,10 @@ TclCompileListCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; - valueTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + valueTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { CompileWord(envPtr, valueTokenPtr, interp); - valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1); + valueTokenPtr = TokenAfter(valueTokenPtr); } TclEmitInstInt4(INST_LIST, numWords - 1, envPtr); } @@ -1832,12 +1842,12 @@ TclCompileListCmd(interp, parsePtr, envPtr) * Procedure called to compile the "llength" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "llength" command - * at runtime. + * Instructions are added to envPtr to execute the "llength" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -1845,8 +1855,8 @@ TclCompileListCmd(interp, parsePtr, envPtr) int TclCompileLlengthCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; @@ -1854,8 +1864,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) if (parsePtr->numWords != 2) { return TCL_ERROR; } - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, varTokenPtr, interp); TclEmitOpcode(INST_LIST_LENGTH, envPtr); @@ -1870,34 +1879,34 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) * Procedure called to compile the "lset" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "lset" command - * at runtime. + * Instructions are added to envPtr to execute the "lset" command at + * runtime. * * The general template for execution of the "lset" command is: - * (1) Instructions to push the variable name, unless the - * variable is local to the stack frame. - * (2) If the variable is an array element, instructions - * to push the array element name. - * (3) Instructions to push each of zero or more "index" arguments - * to the stack, followed with the "newValue" element. - * (4) Instructions to duplicate the variable name and/or array - * element name onto the top of the stack, if either was - * pushed at steps (1) and (2). - * (5) The appropriate INST_LOAD_* instruction to place the - * original value of the list variable at top of stack. + * (1) Instructions to push the variable name, unless the variable is + * local to the stack frame. + * (2) If the variable is an array element, instructions to push the + * array element name. + * (3) Instructions to push each of zero or more "index" arguments to the + * stack, followed with the "newValue" element. + * (4) Instructions to duplicate the variable name and/or array element + * name onto the top of the stack, if either was pushed at steps (1) + * and (2). + * (5) The appropriate INST_LOAD_* instruction to place the original + * value of the list variable at top of stack. * (6) At this point, the stack contains: - * varName? arrayElementName? index1 index2 ... newValue oldList + * varName? arrayElementName? index1 index2 ... newValue oldList * The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST - * according as whether there is exactly one index element (LIST) - * or either zero or else two or more (FLAT). This instruction - * removes everything from the stack except for the two names - * and pushes the new value of the variable. - * (7) Finally, INST_STORE_* stores the new value in the variable - * and cleans up the stack. + * according as whether there is exactly one index element (LIST) or + * either zero or else two or more (FLAT). This instruction removes + * everything from the stack except for the two names and pushes the + * new value of the variable. + * (7) Finally, INST_STORE_* stores the new value in the variable and + * cleans up the stack. * *---------------------------------------------------------------------- */ @@ -1905,14 +1914,14 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) int TclCompileLsetCmd(interp, parsePtr, envPtr) Tcl_Interp* interp; /* Tcl interpreter for error reporting */ - Tcl_Parse* parsePtr; /* Points to a parse structure for - * the command */ + Tcl_Parse* parsePtr; /* Points to a parse structure for the + * command */ CompileEnv* envPtr; /* Holds the resulting instructions */ { - int tempDepth; /* Depth used for emitting one part - * of the code burst. */ - Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing - * the parse of the variable name */ + int tempDepth; /* Depth used for emitting one part of the + * code burst. */ + Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing the + * parse of the variable name */ int localIndex; /* Index of var in local var table */ int simpleVarName; /* Flag == 1 if var name is simple */ int isScalar; /* Flag == 1 if scalar, 0 if array */ @@ -1926,32 +1935,28 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) } /* - * Decide if we can use a frame slot for the var/array name or if we - * need to emit code to compute and push the name at runtime. We use a - * frame slot (entry in the array of local vars) if we are compiling a - * procedure body and if the name is simple text that does not include - * namespace qualifiers. + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. */ - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar); - /* Push the "index" args and the new element value. */ + /* + * Push the "index" args and the new element value. + */ for (i=2 ; i<parsePtr->numWords ; ++i) { - /* Advance to next arg */ - - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - - /* Push an arg */ - + varTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, varTokenPtr, interp); } /* - * Duplicate the variable name if it's been pushed. + * Duplicate the variable name if it's been pushed. */ if (!simpleVarName || localIndex < 0) { @@ -2007,7 +2012,7 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) if (parsePtr->numWords == 4) { TclEmitOpcode(INST_LSET_LIST, envPtr); } else { - TclEmitInstInt4(INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr); + TclEmitInstInt4(INST_LSET_FLAT, parsePtr->numWords-1, envPtr); } /* @@ -2045,12 +2050,12 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) * Procedure called to compile the "regexp" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "regexp" command - * at runtime. + * Instructions are added to envPtr to execute the "regexp" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -2058,18 +2063,18 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) int TclCompileRegexpCmd(interp, parsePtr, envPtr) Tcl_Interp* interp; /* Tcl interpreter for error reporting */ - Tcl_Parse* parsePtr; /* Points to a parse structure for - * the command */ + Tcl_Parse* parsePtr; /* Points to a parse structure for the + * command */ CompileEnv* envPtr; /* Holds the resulting instructions */ { - Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing - * the parse of the RE or string */ + Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the + * parse of the RE or string */ int i, len, nocase, anchorLeft, anchorRight, start; char *str; /* - * We are only interested in compiling simple regexp cases. - * Currently supported compile cases are: + * We are only interested in compiling simple regexp cases. Currently + * supported compile cases are: * regexp ?-nocase? ?--? staticString $var * regexp ?-nocase? ?--? {^staticString$} $var */ @@ -2081,12 +2086,12 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) varTokenPtr = parsePtr->tokenPtr; /* - * We only look for -nocase and -- as options. Everything else - * gets pushed to runtime execution. This is different than regexp's - * runtime option handling, but satisfies our stricter needs. + * We only look for -nocase and -- as options. Everything else gets + * pushed to runtime execution. This is different than regexp's runtime + * option handling, but satisfies our stricter needs. */ for (i = 1; i < parsePtr->numWords - 2; i++) { - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(varTokenPtr); if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* Not a simple string - punt to runtime. */ return TCL_ERROR; @@ -2096,8 +2101,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) if ((len == 2) && (str[0] == '-') && (str[1] == '-')) { i++; break; - } else if ((len > 1) - && (strncmp(str, "-nocase", (unsigned) len) == 0)) { + } else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) { nocase = 1; } else { /* Not an option we recognize. */ @@ -2114,7 +2118,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) * Get the regexp string. If it is not a simple string, punt to runtime. * If it has a '-', it could be an incorrectly formed regexp command. */ - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(varTokenPtr); str = (char *) varTokenPtr[1].start; len = varTokenPtr[1].size; if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) { @@ -2125,7 +2129,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) /* * The semantics of regexp are always match on re == "". */ - TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); + PushLiteral(envPtr, "1", 1); return TCL_OK; } @@ -2159,11 +2163,11 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) * On the first (pattern) arg, check to see if any RE special characters * are in the word. If not, this is the same as 'string equal'. */ - if ((len > (1+start)) && (str[start] == '.') && (str[start+1] == '*')) { + if ((len > 1+start) && (str[start] == '.') && (str[start+1] == '*')) { start += 2; anchorLeft = 0; } - if ((len > (2+start)) && (str[len-3] != '\\') + if ((len > 2+start) && (str[len-3] != '\\') && (str[len-2] == '.') && (str[len-1] == '*')) { len -= 2; str[len] = '\0'; @@ -2171,9 +2175,9 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) } /* - * Don't do anything with REs with other special chars. Also check if - * this is a bad RE (do this at the end because it can be expensive). - * If so, let it complain at runtime. + * Don't do anything with REs with other special chars. Also check if this + * is a bad RE (do this at the end because it can be expensive). If so, + * let it complain at runtime. */ if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL) || (Tcl_RegExpCompile(NULL, str) == NULL)) { @@ -2182,14 +2186,14 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) } if (anchorLeft && anchorRight) { - TclEmitPush(TclRegisterNewLiteral(envPtr, str+start, len-start), - envPtr); + PushLiteral(envPtr, str+start, len-start); } else { /* - * This needs to find the substring anywhere in the string, so - * use string match and *foo*, with appropriate anchoring. + * This needs to find the substring anywhere in the string, so use + * [string match] and *foo*, with appropriate anchoring. */ - char *newStr = ckalloc((unsigned) len + 3); + char *newStr = ckalloc((unsigned) len + 3); + len -= start; if (anchorLeft) { strncpy(newStr, str + start, (size_t) len); @@ -2201,7 +2205,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) newStr[len++] = '*'; } newStr[len] = '\0'; - TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len), envPtr); + PushLiteral(envPtr, newStr, len); ckfree((char *) newStr); } ckfree((char *) str); @@ -2209,7 +2213,8 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) /* * Push the string arg */ - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + + varTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, varTokenPtr, interp); if (anchorLeft && anchorRight && !nocase) { @@ -2229,12 +2234,12 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) * Procedure called to compile the "return" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "return" command - * at runtime. + * Instructions are added to envPtr to execute the "return" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -2255,8 +2260,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; Tcl_Obj *returnOpts; - Tcl_Token *wordTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); #define NUM_STATIC_OBJS 20 int objc; Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; @@ -2267,10 +2271,10 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) objv = staticObjArray; } - /* - * Scan through the return options. If any are unknown at compile - * time, there is no value in bytecompiling. Save the option values - * known in an objv array for merging into a return options dictionary. + /* + * Scan through the return options. If any are unknown at compile time, + * there is no value in bytecompiling. Save the option values known in an + * objv array for merging into a return options dictionary. */ for (objc = 0; objc < numOptionWords; objc++) { @@ -2281,11 +2285,11 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) status = TCL_ERROR; goto cleanup; } - wordTokenPtr += wordTokenPtr->numComponents + 1; + wordTokenPtr = TokenAfter(wordTokenPtr); } status = TclMergeReturnOptions(interp, objc, objv, &returnOpts, &code, &level); -cleanup: + cleanup: while (--objc >= 0) { Tcl_DecrRefCount(objv[objc]); } @@ -2294,9 +2298,9 @@ cleanup: } if (TCL_ERROR == status) { /* - * Something was bogus in the return options. Clear the - * error message, and report back to the compiler that this - * must be interpreted at runtime. + * Something was bogus in the return options. Clear the error message, + * and report back to the compiler that this must be interpreted at + * runtime. */ Tcl_ResetResult(interp); return TCL_ERROR; @@ -2310,43 +2314,47 @@ cleanup: if (explicitResult) { CompileWord(envPtr, wordTokenPtr, interp); } else { - /* No explict result argument, so default result is empty string */ - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); - } - - /* - * Check for optimization: When [return] is in a proc, and there's - * no enclosing [catch], and there are no return options, then the - * INST_DONE instruction is equivalent, and may be more efficient. - */ - if (numOptionWords == 0) { - /* We have default return options... */ - if (envPtr->procPtr != NULL) { - /* ... and we're in a proc ... */ - int index = envPtr->exceptArrayNext - 1; - int enclosingCatch = 0; - while (index >= 0) { - ExceptionRange range = envPtr->exceptArrayPtr[index]; - if ((range.type == CATCH_EXCEPTION_RANGE) - && (range.catchOffset == -1)) { - enclosingCatch = 1; - break; - } - index--; - } - if (!enclosingCatch) { - /* ... and there is no enclosing catch. */ - Tcl_DecrRefCount(returnOpts); - TclEmitOpcode(INST_DONE, envPtr); - return TCL_OK; + /* + * No explict result argument, so default result is empty string. + */ + PushLiteral(envPtr, "", 0); + } + + /* + * Check for optimization: When [return] is in a proc, and there's no + * enclosing [catch], and there are no return options, then the INST_DONE + * instruction is equivalent, and may be more efficient. + */ + + if (numOptionWords == 0 && envPtr->procPtr != NULL) { + /* + * We have default return options and we're in a proc ... + */ + int index = envPtr->exceptArrayNext - 1; + int enclosingCatch = 0; + while (index >= 0) { + ExceptionRange range = envPtr->exceptArrayPtr[index]; + if ((range.type == CATCH_EXCEPTION_RANGE) + && (range.catchOffset == -1)) { + enclosingCatch = 1; + break; } + index--; + } + if (!enclosingCatch) { + /* + * ... and there is no enclosing catch. Issue the maximally + * efficient exit instruction. + */ + Tcl_DecrRefCount(returnOpts); + TclEmitOpcode(INST_DONE, envPtr); + return TCL_OK; } } /* - * Could not use the optimization, so we push the return options - * dictionary, and emit the INST_RETURN instruction with code - * and level as operands. + * Could not use the optimization, so we push the return options dict, and + * emit the INST_RETURN instruction with code and level as operands. */ TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr); @@ -2363,12 +2371,12 @@ cleanup: * Procedure called to compile the "set" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "set" command - * at runtime. + * Instructions are added to envPtr to execute the "set" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -2376,8 +2384,8 @@ cleanup: int TclCompileSetCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr, *valueTokenPtr; @@ -2390,16 +2398,14 @@ TclCompileSetCmd(interp, parsePtr, envPtr) isAssignment = (numWords == 3); /* - * Decide if we can use a frame slot for the var/array name or if we - * need to emit code to compute and push the name at runtime. We use a - * frame slot (entry in the array of local vars) if we are compiling a - * procedure body and if the name is simple text that does not include - * namespace qualifiers. + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. */ - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); - + varTokenPtr = TokenAfter(parsePtr->tokenPtr); PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar); @@ -2408,7 +2414,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr) */ if (isAssignment) { - valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + valueTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, valueTokenPtr, interp); } @@ -2418,34 +2424,30 @@ TclCompileSetCmd(interp, parsePtr, envPtr) if (simpleVarName) { if (isScalar) { - if (localIndex >= 0) { - if (localIndex <= 255) { - TclEmitInstInt1((isAssignment? - INST_STORE_SCALAR1 : INST_LOAD_SCALAR1), - localIndex, envPtr); - } else { - TclEmitInstInt4((isAssignment? - INST_STORE_SCALAR4 : INST_LOAD_SCALAR4), - localIndex, envPtr); - } - } else { + if (localIndex < 0) { TclEmitOpcode((isAssignment? INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr); + } else if (localIndex <= 255) { + TclEmitInstInt1((isAssignment? + INST_STORE_SCALAR1 : INST_LOAD_SCALAR1), + localIndex, envPtr); + } else { + TclEmitInstInt4((isAssignment? + INST_STORE_SCALAR4 : INST_LOAD_SCALAR4), + localIndex, envPtr); } } else { - if (localIndex >= 0) { - if (localIndex <= 255) { - TclEmitInstInt1((isAssignment? - INST_STORE_ARRAY1 : INST_LOAD_ARRAY1), - localIndex, envPtr); - } else { - TclEmitInstInt4((isAssignment? - INST_STORE_ARRAY4 : INST_LOAD_ARRAY4), - localIndex, envPtr); - } - } else { + if (localIndex < 0) { TclEmitOpcode((isAssignment? - INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr); + INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr); + } else if (localIndex <= 255) { + TclEmitInstInt1((isAssignment? + INST_STORE_ARRAY1 : INST_LOAD_ARRAY1), + localIndex, envPtr); + } else { + TclEmitInstInt4((isAssignment? + INST_STORE_ARRAY4 : INST_LOAD_ARRAY4), + localIndex, envPtr); } } } else { @@ -2460,15 +2462,18 @@ TclCompileSetCmd(interp, parsePtr, envPtr) * * TclCompileStringCmd -- * - * Procedure called to compile the "string" command. + * Procedure called to compile the "string" command. Generally speaking, + * these are mostly various kinds of peephole optimizations; most string + * operations are handled by executing the interpreted version of the + * command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "string" command - * at runtime. + * Instructions are added to envPtr to execute the "string" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -2476,13 +2481,13 @@ TclCompileSetCmd(interp, parsePtr, envPtr) int TclCompileStringCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *opTokenPtr, *varTokenPtr; Tcl_Obj *opObj; - int index; + int i, index; static CONST char *options[] = { "bytelength", "compare", "equal", "first", @@ -2499,14 +2504,13 @@ TclCompileStringCmd(interp, parsePtr, envPtr) STR_REPLACE, STR_TOLOWER, STR_TOUPPER, STR_TOTITLE, STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT, STR_WORDEND, STR_WORDSTART - }; + }; if (parsePtr->numWords < 2) { /* Fail at run time, not in compilation */ return TCL_ERROR; } - opTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + opTokenPtr = TokenAfter(parsePtr->tokenPtr); opObj = Tcl_NewStringObj(opTokenPtr->start, opTokenPtr->size); if (Tcl_GetIndexFromObj(interp, opObj, options, "option", 0, @@ -2517,155 +2521,134 @@ TclCompileStringCmd(interp, parsePtr, envPtr) } Tcl_DecrRefCount(opObj); - varTokenPtr = opTokenPtr + (opTokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(opTokenPtr); switch ((enum options) index) { - case STR_BYTELENGTH: - case STR_FIRST: - case STR_IS: - case STR_LAST: - case STR_MAP: - case STR_RANGE: - case STR_REPEAT: - case STR_REPLACE: - case STR_TOLOWER: - case STR_TOUPPER: - case STR_TOTITLE: - case STR_TRIM: - case STR_TRIMLEFT: - case STR_TRIMRIGHT: - case STR_WORDEND: - case STR_WORDSTART: - /* - * All other cases: compile out of line. - */ - return TCL_ERROR; + case STR_COMPARE: + case STR_EQUAL: + /* + * If there are any flags to the command, we can't byte compile it + * because the INST_STR_EQ bytecode doesn't support flags. + */ - case STR_COMPARE: - case STR_EQUAL: { - int i; - /* - * If there are any flags to the command, we can't byte compile it - * because the INST_STR_EQ bytecode doesn't support flags. - */ + if (parsePtr->numWords != 4) { + return TCL_ERROR; + } - if (parsePtr->numWords != 4) { - return TCL_ERROR; - } + /* + * Push the two operands onto the stack. + */ - /* - * Push the two operands onto the stack. - */ + for (i = 0; i < 2; i++) { + CompileWord(envPtr, varTokenPtr, interp); + varTokenPtr = TokenAfter(varTokenPtr); + } - for (i = 0; i < 2; i++) { - CompileWord(envPtr, varTokenPtr, interp); - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - } + TclEmitOpcode(((((enum options) index) == STR_COMPARE) ? + INST_STR_CMP : INST_STR_EQ), envPtr); + return TCL_OK; - TclEmitOpcode(((((enum options) index) == STR_COMPARE) ? - INST_STR_CMP : INST_STR_EQ), envPtr); - return TCL_OK; + case STR_INDEX: + if (parsePtr->numWords != 4) { + /* Fail at run time, not in compilation */ + return TCL_ERROR; } - case STR_INDEX: { - int i; - if (parsePtr->numWords != 4) { - /* Fail at run time, not in compilation */ - return TCL_ERROR; - } + /* + * Push the two operands onto the stack. + */ - /* - * Push the two operands onto the stack. - */ + for (i = 0; i < 2; i++) { + CompileWord(envPtr, varTokenPtr, interp); + varTokenPtr = TokenAfter(varTokenPtr); + } - for (i = 0; i < 2; i++) { - CompileWord(envPtr, varTokenPtr, interp); - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - } + TclEmitOpcode(INST_STR_INDEX, envPtr); + return TCL_OK; + case STR_MATCH: { + int length, exactMatch = 0, nocase = 0; + CONST char *str; - TclEmitOpcode(INST_STR_INDEX, envPtr); - return TCL_OK; + if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { + /* Fail at run time, not in compilation */ + return TCL_ERROR; } - case STR_LENGTH: { - if (parsePtr->numWords != 3) { - /* Fail at run time, not in compilation */ + + if (parsePtr->numWords == 5) { + if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } - - if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - /* - * Here someone is asking for the length of a static string. - * Just push the actual character (not byte) length. - */ - char buf[TCL_INTEGER_SPACE]; - int len = Tcl_NumUtfChars(varTokenPtr[1].start, - varTokenPtr[1].size); - len = sprintf(buf, "%d", len); - TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr); - return TCL_OK; + str = varTokenPtr[1].start; + length = varTokenPtr[1].size; + if ((length > 1) && + strncmp(str, "-nocase", (size_t) length) == 0) { + nocase = 1; } else { - TclCompileTokens(interp, varTokenPtr+1, - varTokenPtr->numComponents, envPtr); - } - TclEmitOpcode(INST_STR_LEN, envPtr); - return TCL_OK; - } - case STR_MATCH: { - int i, length, exactMatch = 0, nocase = 0; - CONST char *str; - - if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { /* Fail at run time, not in compilation */ return TCL_ERROR; } + varTokenPtr = TokenAfter(varTokenPtr); + } - if (parsePtr->numWords == 5) { - if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - str = varTokenPtr[1].start; + for (i = 0; i < 2; i++) { + if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { + str = varTokenPtr[1].start; length = varTokenPtr[1].size; - if ((length > 1) && - strncmp(str, "-nocase", (size_t) length) == 0) { - nocase = 1; - } else { - /* Fail at run time, not in compilation */ - return TCL_ERROR; + if (!nocase && (i == 0)) { + /* + * Trivial matches can be done by 'string equal'. If + * -nocase was specified, we can't do this because + * INST_STR_EQ has no support for nocase. + */ + Tcl_Obj *copy = Tcl_NewStringObj(str, length); + Tcl_IncrRefCount(copy); + exactMatch = TclMatchIsTrivial(Tcl_GetString(copy)); + Tcl_DecrRefCount(copy); } - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + PushLiteral(envPtr, str, length); + } else { + TclCompileTokens(interp, varTokenPtr+1, + varTokenPtr->numComponents, envPtr); } + varTokenPtr = TokenAfter(varTokenPtr); + } - for (i = 0; i < 2; i++) { - if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - str = varTokenPtr[1].start; - length = varTokenPtr[1].size; - if (!nocase && (i == 0)) { - /* - * Trivial matches can be done by 'string equal'. - * If -nocase was specified, we can't do this - * because INST_STR_EQ has no support for nocase. - */ - Tcl_Obj *copy = Tcl_NewStringObj(str, length); - Tcl_IncrRefCount(copy); - exactMatch = TclMatchIsTrivial(Tcl_GetString(copy)); - Tcl_DecrRefCount(copy); - } - TclEmitPush( - TclRegisterNewLiteral(envPtr, str, length), envPtr); - } else { - TclCompileTokens(interp, varTokenPtr+1, - varTokenPtr->numComponents, envPtr); - } - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - } + if (exactMatch) { + TclEmitOpcode(INST_STR_EQ, envPtr); + } else { + TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr); + } + return TCL_OK; + } + case STR_LENGTH: + if (parsePtr->numWords != 3) { + /* Fail at run time, not in compilation */ + return TCL_ERROR; + } - if (exactMatch) { - TclEmitOpcode(INST_STR_EQ, envPtr); - } else { - TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr); - } + if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { + /* + * Here someone is asking for the length of a static string. Just + * push the actual character (not byte) length. + */ + char buf[TCL_INTEGER_SPACE]; + int len = Tcl_NumUtfChars(varTokenPtr[1].start, + varTokenPtr[1].size); + len = sprintf(buf, "%d", len); + PushLiteral(envPtr, buf, len); return TCL_OK; + } else { + TclCompileTokens(interp, varTokenPtr+1, + varTokenPtr->numComponents, envPtr); } + TclEmitOpcode(INST_STR_LEN, envPtr); + return TCL_OK; + + default: + /* + * All other cases: compile out of line. + */ + return TCL_ERROR; } return TCL_OK; @@ -2679,14 +2662,14 @@ TclCompileStringCmd(interp, parsePtr, envPtr) * Procedure called to compile the "switch" command. * * Results: - * Returns TCL_OK for successful compile, or TCL_ERROR - * to defer evaluation to runtime (either when it is too complex - * to get the semantics right, or when we know for sure that it - * is an error but need the error to happen at the right time). + * Returns TCL_OK for successful compile, or TCL_ERROR to defer + * evaluation to runtime (either when it is too complex to get the + * semantics right, or when we know for sure that it is an error but need + * the error to happen at the right time). * * Side effects: - * Instructions are added to envPtr to execute the "switch" command - * at runtime. + * Instructions are added to envPtr to execute the "switch" command at + * runtime. * * FIXME: * Stack depths are probably not calculated correctly. @@ -2697,8 +2680,8 @@ TclCompileStringCmd(interp, parsePtr, envPtr) int TclCompileSwitchCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; /* Pointer to tokens in command */ @@ -2710,17 +2693,17 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */ Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */ - int foundDefault; /* Flag to indicate whether a "default" - * clause is present. */ + int foundDefault; /* Flag to indicate whether a "default" clause + * is present. */ JumpFixup *fixupArray; /* Array of forward-jump fixup records. */ int *fixupTargetArray; /* Array of places for fixups to point at. */ int fixupCount; /* Number of places to fix up. */ - int contFixIndex; /* Where the first of the jumps due to a - * group of continuation bodies starts, - * or -1 if there aren't any. */ - int contFixCount; /* Number of continuation bodies pointing - * to the current (or next) real body. */ + int contFixIndex; /* Where the first of the jumps due to a group + * of continuation bodies starts, or -1 if + * there aren't any. */ + int contFixCount; /* Number of continuation bodies pointing to + * the current (or next) real body. */ int savedStackDepth = envPtr->currStackDepth; int noCase; @@ -2729,31 +2712,31 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) /* * Only handle the following versions: * switch -- word {pattern body ...} - * switch -exact -- word {pattern body ...} + * switch -exact -- word {pattern body ...} * switch -glob -- word {pattern body ...} * switch -- word simpleWordPattern simpleWordBody ... * switch -exact -- word simpleWordPattern simpleWordBody ... * switch -glob -- word simpleWordPattern simpleWordBody ... + * When the mode is -glob, can also handle a -nocase flag. */ tokenPtr = parsePtr->tokenPtr; numWords = parsePtr->numWords; /* - * We don't care how the command's word was generated; we're - * compiling it anyway! + * We don't care how the command's word was generated; we're compiling it + * anyway! */ - tokenPtr += tokenPtr->numComponents + 1; + tokenPtr = TokenAfter(tokenPtr); numWords--; /* - * Check for options. There must be at least one, --, because - * without that there is no way to statically avoid the problems - * you get from strings-to-match that start with a - (the - * interpreted code falls apart if it encounters them, so we punt - * if we *might* encounter them as that is the easiest way of - * emulating the behaviour). + * Check for options. There must be at least one, --, because without that + * there is no way to statically avoid the problems you get from strings- + * -to-be-matched that start with a - (the interpreted code falls apart if + * it encounters them, so we punt if we *might* encounter them as that is + * the easiest way of emulating the behaviour). */ noCase = 0; @@ -2763,9 +2746,9 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) register CONST char *chrs = tokenPtr[1].start; /* - * We only process literal options, and we assume that -e, -g - * and -n are unique prefixes of -exact, -glob and -nocase - * respectively (true at time of writing). + * We only process literal options, and we assume that -e, -g and -n + * are unique prefixes of -exact, -glob and -nocase respectively (true + * at time of writing). */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) { return TCL_ERROR; @@ -2785,11 +2768,12 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) } /* - * The switch command has many flags we cannot compile at all - * (e.g. all the RE-related ones) which we must have - * encountered. Either that or we have run off the end. The - * action here is the same: punt to interpreted version. + * The switch command has many flags we cannot compile at all (e.g. + * all the RE-related ones) which we must have encountered. Either + * that or we have run off the end. The action here is the same: punt + * to interpreted version. */ + return TCL_ERROR; } if (numWords < 3) { @@ -2799,28 +2783,27 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) numWords--; if (noCase && (mode == Switch_Exact)) { /* - * Can't compile this case! + * Can't compile this case; no opcode for case-insensitive equality! */ return TCL_ERROR; } /* - * The value to test against is going to always get pushed on the - * stack. But not yet; we need to verify that the rest of the - * command is compilable too. + * The value to test against is going to always get pushed on the stack. + * But not yet; we need to verify that the rest of the command is + * compilable too. */ valueTokenPtr = tokenPtr; - tokenPtr += tokenPtr->numComponents + 1; + tokenPtr = TokenAfter(tokenPtr); numWords--; /* - * Build an array of tokens for the matcher terms and script - * bodies. Note that in the case of the quoted bodies, this is - * tricky as we cannot use copies of the string from the input - * token for the generated tokens (it causes a crash during - * exception handling). When multiple tokens are available at this - * point, this is pretty easy. + * Build an array of tokens for the matcher terms and script bodies. Note + * that in the case of the quoted bodies, this is tricky as we cannot use + * copies of the string from the input token for the generated tokens (it + * causes a crash during exception handling). When multiple tokens are + * available at this point, this is pretty easy. */ if (numWords == 1) { @@ -2830,9 +2813,9 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) CONST char *tokenStartPtr; /* - * Test that we've got a suitable body list as a simple (i.e. - * braced) word, and that the elements of the body are simple - * words too. This is really rather nasty indeed. + * Test that we've got a suitable body list as a simple (i.e. braced) + * word, and that the elements of the body are simple words too. This + * is really rather nasty indeed. */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -2846,12 +2829,25 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) return TCL_ERROR; } Tcl_DStringFree(&bodyList); + + /* + * Now we know what the switch arms are, we've got to see whether we + * can synthesize tokens for the arms. First check whether we've got a + * valid number of arms since we can do that now. + */ + if (numWords == 0 || numWords % 2) { ckfree((char *) argv); return TCL_ERROR; } + bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords); bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); + + /* + * Locate the start of the arms within the overall word. + */ + tokenStartPtr = tokenPtr[1].start; while (isspace(UCHAR(*tokenStartPtr))) { tokenStartPtr++; @@ -2869,12 +2865,14 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) bodyTokenArray[i].numComponents = 0; bodyToken[i] = bodyTokenArray+i; tokenStartPtr += bodyTokenArray[i].size; + /* - * Test to see if we have guessed the end of the word - * correctly; if not, we can't feed the real string to the - * sub-compilation engine, and we're then stuck and so - * have to punt out to doing everything at runtime. + * Test to see if we have guessed the end of the word correctly; + * if not, we can't feed the real string to the sub-compilation + * engine, and we're then stuck and so have to punt out to doing + * everything at runtime. */ + if ((isTokenBraced && *(tokenStartPtr++) != '}') || (tokenStartPtr < tokenPtr[1].start+tokenPtr[1].size && !isspace(UCHAR(*tokenStartPtr)))) { @@ -2897,35 +2895,40 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) } } ckfree((char *)argv); + /* - * Check that we've parsed everything we thought we were going - * to parse. If not, something odd is going on and we should - * bail out. + * Check that we've parsed everything we thought we were going to + * parse. If not, something odd is going on (I believe it is possible + * to defeat the code above) and we should bail out. */ + if (tokenStartPtr != tokenPtr[1].start+tokenPtr[1].size) { ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); return TCL_ERROR; } + } else if (numWords % 2 || numWords == 0) { /* - * Odd number of words (>1) available, or no words at all - * available. Both are error cases, so punt and let the - * interpreted-version generate the error message. Note that - * the second case probably should get caught earlier, but - * it's easy to check here again anyway because it'd cause a - * nasty crash otherwise. + * Odd number of words (>1) available, or no words at all available. + * Both are error cases, so punt and let the interpreted-version + * generate the error message. Note that the second case probably + * should get caught earlier, but it's easy to check here again anyway + * because it'd cause a nasty crash otherwise. */ + return TCL_ERROR; + } else { bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); bodyTokenArray = NULL; for (i=0 ; i<numWords ; i++) { /* - * We only handle the very simplest case. Anything more - * complex is a good reason to go to the interpreted case - * anyway due to traces, etc. + * We only handle the very simplest case. Anything more complex is + * a good reason to go to the interpreted case anyway due to + * traces, etc. */ + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr->numComponents != 1) { ckfree((char *) bodyToken); @@ -2937,9 +2940,8 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) } /* - * Fall back to interpreted if the last body is a continuation - * (it's illegal, but this makes the error happen at the right - * time). + * Fall back to interpreted if the last body is a continuation (it's + * illegal, but this makes the error happen at the right time). */ if (bodyToken[numWords-1]->size == 1 && @@ -2952,9 +2954,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) } /* - * Now we commit to generating code; the parsing stage per se is - * done. - * + * Now we commit to generating code; the parsing stage per se is done. * First, we push the value we're matching against on the stack. */ @@ -2992,59 +2992,63 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr); break; default: - Tcl_Panic("unknown switch mode: %d",mode); + Tcl_Panic("unknown switch mode: %d", mode); } + /* - * Process fall-through clauses here... + * In a fall-through case, we will jump on _true_ to the place + * where the body starts (generated later, with guarantee of this + * ensured earlier; the final body is never a fall-through). */ + if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') { if (contFixIndex == -1) { contFixIndex = fixupCount; contFixCount = 0; } TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, - &fixupArray[contFixIndex+contFixCount]); + fixupArray+contFixIndex+contFixCount); fixupCount++; contFixCount++; continue; } - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, - &fixupArray[fixupCount]); + + TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, fixupArray+fixupCount); nextArmFixupIndex = fixupCount; fixupCount++; } else { /* - * Got a default clause; set a flag to inhibit the - * generation of the jump after the body and the cleanup - * of the intermediate value that we are switching - * against. + * Got a default clause; set a flag to inhibit the generation of + * the jump after the body and the cleanup of the intermediate + * value that we are switching against. * - * Note that default clauses (which are always last - * clauses) cannot be fall-through clauses as well, since - * the last clause is never a fall-through clause (which - * we have already verified). + * Note that default clauses (which are always terminal clauses) + * cannot be fall-through clauses as well, since the last clause + * is never a fall-through clause (which we have already + * verified). */ foundDefault = 1; } /* - * Generate the body for the arm. This is guaranteed not to - * be a fall-through case, but it might have preceding - * fall-through cases, so we must process those first. + * Generate the body for the arm. This is guaranteed not to be a + * fall-through case, but it might have preceding fall-through cases, + * so we must process those first. */ if (contFixIndex != -1) { int j; for (j=0 ; j<contFixCount ; j++) { - fixupTargetArray[contFixIndex+j] = - envPtr->codeNext-envPtr->codeStart; + fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr); } contFixIndex = -1; } /* - * Now do the actual compilation. + * Now do the actual compilation. Note that we do not use CompileBody + * because we may have synthesized the tokens in a non-standard + * pattern. */ TclEmitOpcode(INST_POP, envPtr); @@ -3053,10 +3057,9 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) if (!foundDefault) { TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &fixupArray[fixupCount]); + fixupArray+fixupCount); fixupCount++; - fixupTargetArray[nextArmFixupIndex] = - envPtr->codeNext-envPtr->codeStart; + fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr); } } ckfree((char *) bodyToken); @@ -3065,20 +3068,22 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) } /* - * Discard the value we are matching against unless we've had a - * default clause (in which case it will already be gone) and make - * the result of the command an empty string. + * Discard the value we are matching against unless we've had a default + * clause (in which case it will already be gone due to the code at the + * start of processing an arm, guaranteed) and make the result of the + * command an empty string. */ if (!foundDefault) { TclEmitOpcode(INST_POP, envPtr); - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushLiteral(envPtr, "", 0); } /* - * Do jump fixups for arms that were executed. First, fill in the - * jumps of all jumps that don't point elsewhere to point to here. + * Do jump fixups for arms that were executed. First, fill in the jumps + * of all jumps that don't point elsewhere to point to here. */ + for (i=0 ; i<fixupCount ; i++) { if (fixupTargetArray[i] == 0) { fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart; @@ -3086,15 +3091,16 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) } /* - * Now scan backwards over all the jumps (all of which are forward - * jumps) doing each one. When we do one and there is a size - * changes, we must scan back over all the previous ones and see - * if they need adjusting before proceeding with further jump - * fixups. + * Now scan backwards over all the jumps (all of which are forward jumps) + * doing each one. When we do one and there is a size changes, we must + * scan back over all the previous ones and see if they need adjusting + * before proceeding with further jump fixups (the interleaved nature of + * all the jumps makes this impossible to do without nested loops). */ + for (i=fixupCount-1 ; i>=0 ; i--) { if (TclFixupForwardJump(envPtr, &fixupArray[i], - fixupTargetArray[i]-fixupArray[i].codeOffset, 127)) { + fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) { int j; for (j=i-1 ; j>=0 ; j--) { if (fixupTargetArray[j] > fixupArray[i].codeOffset) { @@ -3115,8 +3121,8 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) * * TclCompileVariableCmd -- * - * Procedure called to reserve the local variables for the - * "variable" command. The command itself is *not* compiled. + * Procedure called to reserve the local variables for the "variable" + * command. The command itself is *not* compiled. * * Results: * Always returns TCL_ERROR. @@ -3126,11 +3132,12 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) * *---------------------------------------------------------------------- */ + int TclCompileVariableCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *varTokenPtr; @@ -3143,23 +3150,34 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); + varTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i += 2) { - if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - varName = varTokenPtr[1].start; - tail = varName + varTokenPtr[1].size - 1; - if ((*tail == ')') || (tail < varName)) continue; - while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { - tail--; - } - if ((*tail == ':') && (tail > varName)) { - tail++; - } - (void) TclFindCompiledLocal(tail, (tail-varName+1), - /*create*/ 1, /*flags*/ 0, envPtr->procPtr); - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); + /* + * Skip non-literals. + */ + if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + continue; } + + varName = varTokenPtr[1].start; + tail = varName + varTokenPtr[1].size - 1; + + /* + * Skip if it looks like it might be an array or an empty string. + */ + if ((*tail == ')') || (tail < varName)) { + continue; + } + + while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { + tail--; + } + if ((*tail == ':') && (tail > varName)) { + tail++; + } + (void) TclFindCompiledLocal(tail, tail-varName+1, + /*create*/ 1, /*flags*/ 0, envPtr->procPtr); + varTokenPtr = TokenAfter(varTokenPtr); } return TCL_ERROR; } @@ -3172,12 +3190,12 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) * Procedure called to compile the "while" command. * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "while" command - * at runtime. + * Instructions are added to envPtr to execute the "while" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -3185,8 +3203,8 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) int TclCompileWhileCmd(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. */ + Tcl_Parse *parsePtr; /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ CompileEnv *envPtr; /* Holds resulting instructions. */ { Tcl_Token *testTokenPtr, *bodyTokenPtr; @@ -3194,8 +3212,8 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) int testCodeOffset, bodyCodeOffset, jumpDist; int range, code; int savedStackDepth = envPtr->currStackDepth; - int loopMayEnd = 1; /* This is set to 0 if it is recognized as - * an infinite loop. */ + int loopMayEnd = 1; /* This is set to 0 if it is recognized as an + * infinite loop. */ Tcl_Obj *boolObj; int boolVal; @@ -3204,24 +3222,24 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) } /* - * If the test expression requires substitutions, don't compile the - * while command inline. E.g., the expression might cause the loop to - * never execute or execute forever, as in "while "$x < 5" {}". + * If the test expression requires substitutions, don't compile the while + * command inline. E.g., the expression might cause the loop to never + * execute or execute forever, as in "while "$x < 5" {}". * - * Bail out also if the body expression requires substitutions - * in order to insure correct behaviour [Bug 219166] + * Bail out also if the body expression requires substitutions in order to + * insure correct behaviour [Bug 219166] */ - testTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); - bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); + testTokenPtr = TokenAfter(parsePtr->tokenPtr); + bodyTokenPtr = TokenAfter(testTokenPtr); + if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { return TCL_ERROR; } /* - * Find out if the condition is a constant. + * Find out if the condition is a constant. */ boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size); @@ -3231,28 +3249,29 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) if (code == TCL_OK) { if (boolVal) { /* - * it is an infinite loop + * It is an infinite loop; flag it so that we generate a more + * efficient body. */ - loopMayEnd = 0; + loopMayEnd = 0; } else { /* - * This is an empty loop: "while 0 {...}" or such. - * Compile no bytecodes. + * This is an empty loop: "while 0 {...}" or such. Compile no + * bytecodes. */ goto pushResult; } } - /* + /* * Create a ExceptionRange record for the loop body. This is used to * implement break and continue. */ envPtr->exceptDepth++; envPtr->maxExceptDepth = - TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); + TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth); range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); /* @@ -3273,19 +3292,18 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup); testCodeOffset = 0; /* avoid compiler warning */ } else { - testCodeOffset = (envPtr->codeNext - envPtr->codeStart); + testCodeOffset = CurrentOffset(envPtr); } /* * Compile the loop body. */ - bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart); - TclCompileCmdWord(interp, bodyTokenPtr+1, - bodyTokenPtr->numComponents, envPtr); + bodyCodeOffset = CurrentOffset(envPtr); + CompileBody(envPtr, bodyTokenPtr, interp); envPtr->currStackDepth = savedStackDepth + 1; envPtr->exceptArrayPtr[range].numCodeBytes = - (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset; + CurrentOffset(envPtr) - bodyCodeOffset; TclEmitOpcode(INST_POP, envPtr); /* @@ -3294,7 +3312,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) */ if (loopMayEnd) { - testCodeOffset = (envPtr->codeNext - envPtr->codeStart); + testCodeOffset = CurrentOffset(envPtr); jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { bodyCodeOffset += 3; @@ -3304,19 +3322,19 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) TclCompileExprWords(interp, testTokenPtr, 1, envPtr); envPtr->currStackDepth = savedStackDepth + 1; - jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset; + jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr); } else { TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr); } } else { - jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset; + jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr); } else { TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr); - } + } } @@ -3326,16 +3344,15 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset; envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset; - envPtr->exceptArrayPtr[range].breakOffset = - (envPtr->codeNext - envPtr->codeStart); + envPtr->exceptArrayPtr[range].breakOffset = CurrentOffset(envPtr); /* * The while command's result is an empty string. */ - pushResult: + pushResult: envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushLiteral(envPtr, "", 0); envPtr->exceptDepth--; return TCL_OK; } @@ -3345,16 +3362,16 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * * PushVarName -- * - * Procedure used in the compiling where pushing a variable name - * is necessary (append, lappend, set). + * Procedure used in the compiling where pushing a variable name is + * necessary (append, lappend, set). * * Results: - * Returns TCL_OK for a successful compile. - * Returns TCL_ERROR to defer evaluation to runtime. + * 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 "set" command - * at runtime. + * Instructions are added to envPtr to execute the "set" command at + * runtime. * *---------------------------------------------------------------------- */ @@ -3365,8 +3382,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Token *varTokenPtr; /* Points to a variable token. */ CompileEnv *envPtr; /* Holds resulting instructions. */ - int flags; /* takes TCL_CREATE_VAR or - * TCL_NO_LARGE_INDEX */ + int flags; /* TCL_CREATE_VAR or TCL_NO_LARGE_INDEX */ int *localIndexPtr; /* must not be NULL */ int *simpleVarNamePtr; /* must not be NULL */ int *isScalarPtr; /* must not be NULL */ @@ -3382,11 +3398,11 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, int removedParen = 0; /* - * Decide if we can use a frame slot for the var/array name or if we - * need to emit code to compute and push the name at runtime. We use a - * frame slot (entry in the array of local vars) if we are compiling a - * procedure body and if the name is simple text that does not include - * namespace qualifiers. + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. */ simpleVarName = 0; @@ -3396,8 +3412,8 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, /* * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether - * curly braces surround the variable name. - * This really matters for array elements to handle things like + * curly braces surround the variable name. This really matters for array + * elements to handle things like * set {x($foo)} 5 * which raises an undefined var error if we are not careful here. */ @@ -3413,7 +3429,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, name = varTokenPtr[1].start; nameChars = varTokenPtr[1].size; if (name[nameChars-1] == ')') { - /* + /* * last char is ')' => potential array reference. */ @@ -3428,8 +3444,8 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, if ((elName != NULL) && elNameChars) { /* - * An array element, the element name is a simple - * string: assemble the corresponding token. + * An array element, the element name is a simple string: + * assemble the corresponding token. */ elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token)); @@ -3443,28 +3459,28 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, } } else if (((n = varTokenPtr->numComponents) > 1) && (varTokenPtr[1].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { + && (varTokenPtr[n].type == TCL_TOKEN_TEXT) + && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { - /* + /* * Check for parentheses inside first token */ - simpleVarName = 0; - for (i = 0, p = varTokenPtr[1].start; - i < varTokenPtr[1].size; i++, p++) { - if (*p == '(') { - simpleVarName = 1; - break; - } - } - if (simpleVarName) { + simpleVarName = 0; + for (i = 0, p = varTokenPtr[1].start; + i < varTokenPtr[1].size; i++, p++) { + if (*p == '(') { + simpleVarName = 1; + break; + } + } + if (simpleVarName) { int remainingChars; /* - * Check the last token: if it is just ')', do not count - * it. Otherwise, remove the ')' and flag so that it is - * restored at the end. + * Check the last token: if it is just ')', do not count it. + * Otherwise, remove the ')' and flag so that it is restored at + * the end. */ if (varTokenPtr[n].size == 1) { @@ -3474,15 +3490,15 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, removedParen = n; } - name = varTokenPtr[1].start; - nameChars = p - varTokenPtr[1].start; - elName = p + 1; - remainingChars = (varTokenPtr[2].start - p) - 1; - elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2; + name = varTokenPtr[1].start; + nameChars = p - varTokenPtr[1].start; + elName = p + 1; + remainingChars = (varTokenPtr[2].start - p) - 1; + elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2; if (remainingChars) { /* - * Make a first token with the extra characters in the first + * Make a first token with the extra characters in the first * token. */ @@ -3499,14 +3515,14 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, */ memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]), - ((n-1) * sizeof(Tcl_Token))); + (n-1) * sizeof(Tcl_Token)); } else { /* * Use the already available tokens. */ elemTokenPtr = &varTokenPtr[2]; - elemTokenCount = n - 1; + elemTokenCount = n - 1; } } } @@ -3525,15 +3541,15 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, } /* - * Look up the var name's index in the array of local vars in the - * proc frame. If retrieving the var's value and it doesn't already - * exist, push its name and look it up at runtime. + * Look up the var name's index in the array of local vars in the proc + * frame. If retrieving the var's value and it doesn't already exist, + * push its name and look it up at runtime. */ if ((envPtr->procPtr != NULL) && !hasNsQualifiers) { localIndex = TclFindCompiledLocal(name, nameChars, - /*create*/ (flags & TCL_CREATE_VAR), - /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY), + /*create*/ flags & TCL_CREATE_VAR, + /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY), envPtr->procPtr); if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { /* we'll push the name */ @@ -3541,7 +3557,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, } } if (localIndex < 0) { - TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr); + PushLiteral(envPtr, name, nameChars); } /* @@ -3552,7 +3568,7 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, if (elNameChars) { TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr); } else { - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + PushLiteral(envPtr, "", 0); } } } else { @@ -3560,8 +3576,8 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, * The var name isn't simple: compile and push it. */ - TclCompileTokens(interp, varTokenPtr+1, - varTokenPtr->numComponents, envPtr); + TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, + envPtr); } if (removedParen) { @@ -3570,8 +3586,16 @@ PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, if (allocedTokens) { ckfree((char *) elemTokenPtr); } - *localIndexPtr = localIndex; - *simpleVarNamePtr = simpleVarName; - *isScalarPtr = (elName == NULL); + *localIndexPtr = localIndex; + *simpleVarNamePtr = simpleVarName; + *isScalarPtr = (elName == NULL); return TCL_OK; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |