summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmds.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r--generic/tclCompCmds.c587
1 files changed, 314 insertions, 273 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 8f4363b..431f0af 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -37,6 +37,12 @@ static void PrintForeachInfo(ClientData clientData,
static void DisassembleForeachInfo(ClientData clientData,
Tcl_Obj *dictObj, ByteCode *codePtr,
unsigned int pcOffset);
+static void PrintNewForeachInfo(ClientData clientData,
+ Tcl_Obj *appendObj, ByteCode *codePtr,
+ unsigned int pcOffset);
+static void DisassembleNewForeachInfo(ClientData clientData,
+ Tcl_Obj *dictObj, ByteCode *codePtr,
+ unsigned int pcOffset);
static int CompileEachloopCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr, int collect);
@@ -56,6 +62,14 @@ const AuxDataType tclForeachInfoType = {
DisassembleForeachInfo /* disassembleProc */
};
+const AuxDataType tclNewForeachInfoType = {
+ "NewForeachInfo", /* name */
+ DupForeachInfo, /* dupProc */
+ FreeForeachInfo, /* freeProc */
+ PrintNewForeachInfo, /* printProc */
+ DisassembleNewForeachInfo /* disassembleProc */
+};
+
const AuxDataType tclDictUpdateInfoType = {
"DictUpdateInfo", /* name */
DupDictUpdateInfo, /* dupProc */
@@ -253,8 +267,8 @@ TclCompileArraySetCmd(
Tcl_Token *varTokenPtr, *dataTokenPtr;
int isScalar, localIndex, code = TCL_OK;
int isDataLiteral, isDataValid, isDataEven, len;
- int dataVar, iterVar, keyVar, valVar, infoIndex;
- int back, fwd, offsetBack, offsetFwd;
+ int keyVar, valVar, infoIndex;
+ int fwd, offsetBack, offsetFwd;
Tcl_Obj *literalObj;
ForeachInfo *infoPtr;
@@ -276,8 +290,8 @@ TclCompileArraySetCmd(
if (isDataValid && !isDataEven) {
PushStringLiteral(envPtr, "list must have an even number of elements");
- PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
- TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
goto done;
}
@@ -298,6 +312,7 @@ TclCompileArraySetCmd(
code = TCL_ERROR;
goto done;
}
+
/*
* Special case: literal empty value argument is just an "ensure array"
* operation.
@@ -322,20 +337,29 @@ TclCompileArraySetCmd(
goto done;
}
+ if (localIndex < 0) {
+ /*
+ * a non-local variable: upvar from a local one! This consumes the
+ * variable name that was left at stacktop.
+ */
+
+ localIndex = AnonymousLocal(envPtr);
+ PushStringLiteral(envPtr, "0");
+ TclEmitInstInt4(INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+
/*
* Prepare for the internal foreach.
*/
- dataVar = AnonymousLocal(envPtr);
- iterVar = AnonymousLocal(envPtr);
keyVar = AnonymousLocal(envPtr);
valVar = AnonymousLocal(envPtr);
- infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
+ infoPtr = ckalloc(sizeof(ForeachInfo));
infoPtr->numLists = 1;
- infoPtr->firstValueTemp = dataVar;
- infoPtr->loopCtTemp = iterVar;
- infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int));
+ infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
infoPtr->varLists[0]->numVars = 2;
infoPtr->varLists[0]->varIndexes[0] = keyVar;
infoPtr->varLists[0]->varIndexes[1] = valVar;
@@ -361,61 +385,30 @@ TclCompileArraySetCmd(
offsetFwd = CurrentOffset(envPtr);
TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
PushStringLiteral(envPtr, "list must have an even number of elements");
- PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
- TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
+ TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
fwd = CurrentOffset(envPtr) - offsetFwd;
TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
}
- Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- if (localIndex >= 0) {
- TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
- TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
- TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
- TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
- offsetBack = CurrentOffset(envPtr);
- TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
- offsetFwd = CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
- Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- back = offsetBack - CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP1, back, envPtr);
- fwd = CurrentOffset(envPtr) - offsetFwd;
- TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
- } else {
- TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr);
- TclEmitInstInt1(INST_JUMP_TRUE1, 4, envPtr);
- TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr);
- TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
- offsetBack = CurrentOffset(envPtr);
- TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
- offsetFwd = CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
- TclEmitOpcode( INST_DUP, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
- Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
- TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- back = offsetBack - CurrentOffset(envPtr);
- TclEmitInstInt1(INST_JUMP1, back, envPtr);
- fwd = CurrentOffset(envPtr) - offsetFwd;
- TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
- TclEmitOpcode( INST_POP, envPtr);
- }
- if (!isDataLiteral) {
- TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( dataVar, envPtr);
- }
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
+ TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
+ TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
+ offsetBack = CurrentOffset(envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
+ Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr);
+ Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */
+ TclEmitOpcode( INST_FOREACH_STEP, envPtr);
+ TclEmitOpcode( INST_FOREACH_END, envPtr);
+ TclAdjustStackDepth(-3, envPtr);
PushStringLiteral(envPtr, "");
- done:
+
+ done:
Tcl_DecrRefCount(literalObj);
return code;
}
@@ -508,17 +501,14 @@ TclCompileBreakCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopBreakFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real break.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_BREAK, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -552,9 +542,10 @@ TclCompileCatchCmd(
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
- int resultIndex, optsIndex, range;
+ int resultIndex, optsIndex, range, dropScript = 0;
DefineLineInformation; /* TIP #280 */
-
+ int depth = TclGetStackDepth(envPtr);
+
/*
* If syntax does not match what we expect for [catch], do not compile.
* Let runtime checks determine if syntax has changed.
@@ -601,11 +592,7 @@ TclCompileCatchCmd(
/*
* We will compile the catch command. Declare the exception range that it
* uses.
- */
-
- range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-
- /*
+ *
* If the body is a simple word, compile a BEGIN_CATCH instruction,
* followed by the instructions to eval the body.
* Otherwise, compile instructions to substitute the body text before
@@ -618,6 +605,7 @@ TclCompileCatchCmd(
* begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
*/
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
@@ -628,71 +616,51 @@ TclCompileCatchCmd(
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_EVAL_STK, envPtr);
- }
- /* Stack at this point:
- * nonsimple: script <mark> result
- * simple: <mark> result
- */
-
- if (resultIndex == -1) {
- /*
- * Special case when neither result nor options are being saved. In
- * that case, we can skip quite a bit of the command epilogue; all we
- * have to do is drop the result and push the return code (and, of
- * course, finish the catch context).
- */
-
+ TclEmitInvoke(envPtr, INST_EVAL_STK);
+ /* drop the script */
+ dropScript = 1;
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
TclEmitOpcode( INST_POP, envPtr);
- PushStringLiteral(envPtr, "0");
- TclEmitInstInt1( INST_JUMP1, 3, envPtr);
- TclAdjustStackDepth(-1, envPtr);
- ExceptionRangeTarget(envPtr, range, catchOffset);
- TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
- ExceptionRangeEnds(envPtr, range);
- TclEmitOpcode( INST_END_CATCH, envPtr);
-
- /*
- * Stack at this point:
- * nonsimple: script <mark> returnCode
- * simple: <mark> returnCode
- */
-
- goto dropScriptAtEnd;
}
+ ExceptionRangeEnds(envPtr, range);
+
/*
* Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
* and jump around the "error case" code.
*/
+ TclCheckStackDepth(depth+1, envPtr);
PushStringLiteral(envPtr, "0");
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- /* Stack at this point: ?script? <mark> result TCL_OK */
/*
* Emit the "error case" epilogue. Push the interpreter result and the
* return code.
*/
- TclAdjustStackDepth(-2, envPtr);
ExceptionRangeTarget(envPtr, range, catchOffset);
- /* Stack at this point: ?script? */
+ TclSetStackDepth(depth + dropScript, envPtr);
+
+ if (dropScript) {
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+
+ /* Stack at this point is empty */
TclEmitOpcode( INST_PUSH_RESULT, envPtr);
TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr);
- /*
- * Update the target of the jump after the "no errors" code.
- */
+ /* Stack at this point on both branches: result returnCode */
- /* Stack at this point: ?script? result returnCode */
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
/*
- * Push the return options if the caller wants them.
+ * Push the return options if the caller wants them. This needs to happen
+ * before INST_END_CATCH
*/
if (optsIndex != -1) {
@@ -703,53 +671,118 @@ TclCompileCatchCmd(
* End the catch
*/
- ExceptionRangeEnds(envPtr, range);
TclEmitOpcode( INST_END_CATCH, envPtr);
/*
- * At this point, the top of the stack is inconveniently ordered:
- * ?script? result returnCode ?returnOptions?
- * Reverse the stack to bring the result to the top.
+ * Save the result and return options if the caller wants them. This needs
+ * to happen after INST_END_CATCH (compile-3.6/7).
*/
if (optsIndex != -1) {
- TclEmitInstInt4( INST_REVERSE, 3, envPtr);
- } else {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
/*
- * Store the result and remove it from the stack.
+ * At this point, the top of the stack is inconveniently ordered:
+ * result returnCode
+ * Reverse the stack to store the result.
*/
- Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ if (resultIndex != -1) {
+ Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr);
+ }
+ TclEmitOpcode( INST_POP, envPtr);
+
+ TclCheckStackDepth(depth+1, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileConcatCmd --
+ *
+ * Procedure called to compile the "concat" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "concat" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileConcatCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Obj *objPtr, *listObj;
+ Tcl_Token *tokenPtr;
+ int i;
+
+ /* TODO: Consider compiling expansion case. */
+ if (parsePtr->numWords == 1) {
+ /*
+ * [concat] without arguments just pushes an empty object.
+ */
+
+ PushStringLiteral(envPtr, "");
+ return TCL_OK;
+ }
/*
- * Stack is now ?script? ?returnOptions? returnCode.
- * If the options dict has been requested, it is buried on the stack under
- * the return code. Reverse the stack to bring it to the top, store it and
- * remove it from the stack.
+ * Test if all arguments are compile-time known. If they are, we can
+ * implement with a simple push.
*/
- if (optsIndex != -1) {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ listObj = Tcl_NewObj();
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ objPtr = Tcl_NewObj();
+ if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(listObj);
+ listObj = NULL;
+ break;
+ }
+ (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
}
+ if (listObj != NULL) {
+ Tcl_Obj **objs;
+ const char *bytes;
+ int len;
- dropScriptAtEnd:
+ Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
+ objPtr = Tcl_ConcatObj(len, objs);
+ Tcl_DecrRefCount(listObj);
+ bytes = Tcl_GetStringFromObj(objPtr, &len);
+ PushLiteral(envPtr, bytes, len);
+ Tcl_DecrRefCount(objPtr);
+ return TCL_OK;
+ }
/*
- * Stack is now ?script? result. Get rid of the subst'ed script if it's
- * hanging arond.
+ * General case: runtime concat.
*/
- if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- TclEmitInstInt4( INST_REVERSE, 2, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, i);
}
+ TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr);
+
return TCL_OK;
}
@@ -804,17 +837,14 @@ TclCompileContinueCmd(
TclCleanupStackForBreakContinue(envPtr, auxPtr);
TclAddLoopContinueFixup(envPtr, auxPtr);
- TclAdjustStackDepth(1, envPtr);
} else {
/*
* Emit a real continue.
*/
- PushStringLiteral(envPtr, "");
- TclEmitOpcode(INST_DUP, envPtr);
- TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
- TclEmitInt4(0, envPtr);
+ TclEmitOpcode(INST_CONTINUE, envPtr);
}
+ TclAdjustStackDepth(1, envPtr);
return TCL_OK;
}
@@ -1683,7 +1713,7 @@ TclCompileDictUpdateCmd(
TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
TclEmitInt4( infoIndex, envPtr);
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr,INST_RETURN_STK);
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
@@ -1747,7 +1777,7 @@ TclCompileDictAppendCmd(
tokenPtr = TokenAfter(tokenPtr);
}
if (parsePtr->numWords > 4) {
- TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
}
/*
@@ -2041,7 +2071,7 @@ TclCompileDictWithCmd(
} else {
TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
}
- TclEmitOpcode( INST_RETURN_STK, envPtr);
+ TclEmitInvoke(envPtr, INST_RETURN_STK);
/*
* Prepare for the start of the next command.
@@ -2164,19 +2194,48 @@ TclCompileErrorCmd(
{
/*
* General syntax: [error message ?errorInfo? ?errorCode?]
- * However, we only deal with the case where there is just a message.
*/
- Tcl_Token *messageTokenPtr;
+
+ Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
- if (parsePtr->numWords != 2) {
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
return TCL_ERROR;
}
- messageTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushStringLiteral(envPtr, "-code error -level 0");
- CompileWord(envPtr, messageTokenPtr, interp, 1);
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ /*
+ * Handle the message.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+
+ /*
+ * Construct the options. Note that -code and -level are not here.
+ */
+
+ if (parsePtr->numWords == 2) {
+ PushStringLiteral(envPtr, "");
+ } else {
+ PushStringLiteral(envPtr, "-errorinfo");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ if (parsePtr->numWords == 3) {
+ TclEmitInstInt4( INST_LIST, 2, envPtr);
+ } else {
+ PushStringLiteral(envPtr, "-errorcode");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 3);
+ TclEmitInstInt4( INST_LIST, 4, envPtr);
+ }
+ }
+
+ /*
+ * Issue the error via 'returnImm error 0'.
+ */
+
+ TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr);
+ TclEmitInt4( 0, envPtr);
return TCL_OK;
}
@@ -2342,6 +2401,7 @@ TclCompileForCmd(
SetLineInformation(2);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ TclClearNumConversion(envPtr);
jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
if (jumpDist > 127) {
@@ -2469,18 +2529,10 @@ CompileEachloopCmd(
ForeachInfo *infoPtr; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
- int firstValueTemp; /* Index of the first temp var in the frame
- * used to point to a value list. */
- int loopCtTemp; /* Index of temp var holding the loop's
- * iteration count. */
- int collectVar = -1; /* Index of temp var holding the result var
- * index. */
-
+
Tcl_Token *tokenPtr, *bodyTokenPtr;
- unsigned char *jumpPc;
- JumpFixup jumpFalseFixup;
- int jumpBackDist, jumpBackOffset, infoIndex, range;
- int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
+ int jumpBackOffset, infoIndex, range;
+ int numWords, numLists, numVars, loopIndex, i, j, code;
DefineLineInformation; /* TIP #280 */
/*
@@ -2588,32 +2640,11 @@ CompileEachloopCmd(
loopIndex++;
}
- if (collect == TCL_EACH_COLLECT) {
- collectVar = AnonymousLocal(envPtr);
- if (collectVar < 0) {
- return TCL_ERROR;
- }
- }
-
/*
- * 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.
+ * We will compile the foreach command.
*/
code = TCL_OK;
- firstValueTemp = -1;
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- tempVar = AnonymousLocal(envPtr);
- if (loopIndex == 0) {
- firstValueTemp = tempVar;
- }
- }
- loopCtTemp = AnonymousLocal(envPtr);
/*
* Create and initialize the ForeachInfo and ForeachVarList data
@@ -2622,16 +2653,14 @@ CompileEachloopCmd(
*/
infoPtr = ckalloc(sizeof(ForeachInfo)
- + numLists * sizeof(ForeachVarList *));
+ + (numLists - 1) * sizeof(ForeachVarList *));
infoPtr->numLists = numLists;
- infoPtr->firstValueTemp = firstValueTemp;
- infoPtr->loopCtTemp = loopCtTemp;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
ForeachVarList *varListPtr;
numVars = varcList[loopIndex];
varListPtr = ckalloc(sizeof(ForeachVarList)
- + numVars * sizeof(int));
+ + (numVars - 1) * sizeof(int));
varListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
const char *varName = varvList[loopIndex][j];
@@ -2642,131 +2671,77 @@ CompileEachloopCmd(
}
infoPtr->varLists[loopIndex] = varListPtr;
}
- infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+ infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
/*
- * Create an exception record to handle [break] and [continue].
+ * Create the collecting object, unshared.
*/
-
- range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
+
+ if (collect == TCL_EACH_COLLECT) {
+ TclEmitInstInt4(INST_LIST, 0, envPtr);
+ }
+
/*
- * Evaluate then store each value list in the associated temporary.
+ * Evaluate each value list and leave it on stack.
*/
- loopIndex = 0;
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
if ((i%2 == 0) && (i > 0)) {
CompileWord(envPtr, tokenPtr, interp, i);
- tempVar = (firstValueTemp + loopIndex);
- Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- loopIndex++;
}
}
- /*
- * Create temporary variable to capture return values from loop body.
- */
-
- if (collect == TCL_EACH_COLLECT) {
- PushStringLiteral(envPtr, "");
- Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
- }
-
- /*
- * Initialize the temporary var that holds the count of loop iterations.
- */
-
- TclEmitInstInt4( INST_FOREACH_START4, infoIndex, envPtr);
-
- /*
- * Top of loop code: assign each loop variable and check whether
- * to terminate the loop.
- */
-
- ExceptionRangeTarget(envPtr, range, continueOffset);
- TclEmitInstInt4( INST_FOREACH_STEP4, infoIndex, envPtr);
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-
+ TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
+
/*
* Inline compile the loop body.
*/
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
ExceptionRangeStarts(envPtr, range);
BODY(bodyTokenPtr, numWords - 1);
ExceptionRangeEnds(envPtr, range);
-
+
if (collect == TCL_EACH_COLLECT) {
- Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr);
- }
- 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
- * 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 = CurrentOffset(envPtr);
- jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+ TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
} else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
/*
- * Fix the target of the jump after the foreach_step test.
+ * Bottom of loop code: assign each loop variable and check whether
+ * to terminate the loop. Set the loop's break target.
*/
- if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
- /*
- * Update the loop body's starting PC offset since it moved down.
- */
-
- envPtr->exceptArrayPtr[range].codeOffset += 3;
-
- /*
- * Update the jump back to the test at the top of the loop since it
- * also moved down 3 bytes.
- */
-
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
- } else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
- }
- }
+ ExceptionRangeTarget(envPtr, range, continueOffset);
+ TclEmitOpcode(INST_FOREACH_STEP, envPtr);
+ ExceptionRangeTarget(envPtr, range, breakOffset);
+ TclFinalizeLoopExceptionRange(envPtr, range);
+ TclEmitOpcode(INST_FOREACH_END, envPtr);
+ TclAdjustStackDepth(-(numLists+2), envPtr);
/*
- * Set the loop's break target.
+ * Set the jumpback distance from INST_FOREACH_STEP to the start of the
+ * body's code. Misuse loopCtTemp for storing the jump size.
*/
-
- ExceptionRangeTarget(envPtr, range, breakOffset);
- TclFinalizeLoopExceptionRange(envPtr, range);
+
+ jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
+ envPtr->exceptArrayPtr[range].codeOffset;
+ infoPtr->loopCtTemp = -jumpBackOffset;
/*
- * The command's result is an empty string if not collecting, or the
- * list of results from evaluating the loop body.
+ * The command's result is an empty string if not collecting. If
+ * collecting, it is automatically left on stack after FOREACH_END.
*/
- if (collect == TCL_EACH_COLLECT) {
- Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
- TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( collectVar, envPtr);
- } else {
+ if (collect != TCL_EACH_COLLECT) {
PushStringLiteral(envPtr, "");
}
-
- done:
+
+ done:
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
if (varvList[loopIndex] != NULL) {
ckfree(varvList[loopIndex]);
@@ -2922,6 +2897,36 @@ PrintForeachInfo(
}
static void
+PrintNewForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *appendObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+
+ Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
+ infoPtr->loopCtTemp);
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ if (i) {
+ Tcl_AppendToObj(appendObj, ",", -1);
+ }
+ Tcl_AppendToObj(appendObj, "[", -1);
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ if (j) {
+ Tcl_AppendToObj(appendObj, ",", -1);
+ }
+ Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+ (unsigned) varsPtr->varIndexes[j]);
+ }
+ Tcl_AppendToObj(appendObj, "]", -1);
+ }
+}
+
+static void
DisassembleForeachInfo(
ClientData clientData,
Tcl_Obj *dictObj,
@@ -2967,6 +2972,42 @@ DisassembleForeachInfo(
}
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
}
+
+static void
+DisassembleNewForeachInfo(
+ ClientData clientData,
+ Tcl_Obj *dictObj,
+ ByteCode *codePtr,
+ unsigned int pcOffset)
+{
+ register ForeachInfo *infoPtr = clientData;
+ register ForeachVarList *varsPtr;
+ int i, j;
+ Tcl_Obj *objPtr, *innerPtr;
+
+ /*
+ * Jump offset.
+ */
+
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
+ Tcl_NewIntObj(infoPtr->loopCtTemp));
+
+ /*
+ * Assignment targets.
+ */
+
+ objPtr = Tcl_NewObj();
+ for (i=0 ; i<infoPtr->numLists ; i++) {
+ innerPtr = Tcl_NewObj();
+ varsPtr = infoPtr->varLists[i];
+ for (j=0 ; j<varsPtr->numVars ; j++) {
+ Tcl_ListObjAppendElement(NULL, innerPtr,
+ Tcl_NewIntObj(varsPtr->varIndexes[j]));
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
+ }
+ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+}
/*
*----------------------------------------------------------------------
@@ -3173,7 +3214,7 @@ TclCompileFormatCmd(
* Do the concatenation, which produces the result.
*/
- TclEmitInstInt1(INST_CONCAT1, i, envPtr);
+ TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
} else {
/*
* EVIL HACK! Force there to be a string representation in the case
generated by cgit v0.12 at 2024-11-07 03:47:13 (GMT)