summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCmdAH.c73
-rw-r--r--generic/tclCompCmds.c142
-rw-r--r--generic/tclInt.h18
3 files changed, 126 insertions, 107 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index d7872ef..14951e4 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -32,7 +32,9 @@ struct ForeachState {
int *argcList; /* Array of value list sizes. */
Tcl_Obj ***argvList; /* Array of value lists. */
Tcl_Obj **aCopyList; /* Copies of value list arguments. */
- Tcl_Obj *resultList; /* List of result values from the loop body. */
+ Tcl_Obj *resultList; /* List of result values from the loop body,
+ * or NULL if we're not collecting them
+ * ([lmap] vs [foreach]). */
};
/*
@@ -53,8 +55,8 @@ static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
static const char * GetTypeFromMode(int mode);
static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
Tcl_StatBuf *statPtr);
-static int TclNREachloopCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[], int collect);
+static inline int EachloopCmd(Tcl_Interp *interp, int collect,
+ int objc, Tcl_Obj *const objv[]);
static Tcl_NRPostProc CatchObjCmdCallback;
static Tcl_NRPostProc ExprCallback;
static Tcl_NRPostProc ForSetupCallback;
@@ -2568,7 +2570,7 @@ ForPostNextCallback(
/*
*----------------------------------------------------------------------
*
- * Tcl_ForeachObjCmd, TclNRForeachCmd, TclNREachloopCmd --
+ * Tcl_ForeachObjCmd, TclNRForeachCmd, EachloopCmd --
*
* This object-based procedure is invoked to process the "foreach" Tcl
* command. See the user documentation for details on what it does.
@@ -2600,7 +2602,7 @@ TclNRForeachCmd(
int objc,
Tcl_Obj *const objv[])
{
- return TclNREachloopCmd(dummy, interp, objc, objv, TCL_EACH_KEEP_NONE);
+ return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
}
int
@@ -2620,18 +2622,18 @@ TclNRLmapCmd(
int objc,
Tcl_Obj *const objv[])
{
- return TclNREachloopCmd(dummy, interp, objc, objv, TCL_EACH_COLLECT);
+ return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
}
-int
-TclNREachloopCmd(
- ClientData dummy,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[],
- int collect) /* Select collecting or accumulating mode (TCL_EACH_*) */
+static inline int
+EachloopCmd(
+ Tcl_Interp *interp, /* Our context for variables and script
+ * evaluation. */
+ int collect, /* Select collecting or accumulating mode
+ * (TCL_EACH_*) */
+ int objc, /* The arguments being passed in... */
+ Tcl_Obj *const objv[])
{
-
int numLists = (objc-2) / 2;
register struct ForeachState *statePtr;
int i, j, result;
@@ -2675,7 +2677,11 @@ TclNREachloopCmd(
statePtr->bodyPtr = objv[objc - 1];
statePtr->bodyIdx = objc - 1;
- statePtr->resultList = Tcl_NewListObj(0, NULL);
+ if (collect == TCL_EACH_COLLECT) {
+ statePtr->resultList = Tcl_NewListObj(0, NULL);
+ } else {
+ statePtr->resultList = NULL;
+ }
/*
* Break up the value lists and variable lists into elements.
@@ -2690,9 +2696,11 @@ TclNREachloopCmd(
TclListObjGetElements(NULL, statePtr->vCopyList[i],
&statePtr->varcList[i], &statePtr->varvList[i]);
if (statePtr->varcList[i] < 1) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "foreach varlist is empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s varlist is empty",
+ (statePtr->resultList != NULL ? "lmap" : "foreach")));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ (statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
"NEEDVARS", NULL);
result = TCL_ERROR;
goto done;
@@ -2726,7 +2734,7 @@ TclNREachloopCmd(
goto done;
}
- TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL);
+ TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
return TclNREvalObjEx(interp, objv[objc-1], 0,
((Interp *) interp)->cmdFramePtr, objc-1);
}
@@ -2753,7 +2761,6 @@ ForeachLoopStep(
int result)
{
register struct ForeachState *statePtr = data[0];
- int collect = (int)data[1]; /* Selected collecting or accumulating mode. */
/*
* Process the result code from this run of the [foreach] body. Note that
@@ -2765,8 +2772,9 @@ ForeachLoopStep(
result = TCL_OK;
break;
case TCL_OK:
- if (collect == TCL_EACH_COLLECT) {
- Tcl_ListObjAppendElement(interp, statePtr->resultList, Tcl_GetObjResult(interp));
+ if (statePtr->resultList != NULL) {
+ Tcl_ListObjAppendElement(interp, statePtr->resultList,
+ Tcl_GetObjResult(interp));
}
break;
case TCL_BREAK:
@@ -2774,7 +2782,9 @@ ForeachLoopStep(
goto finish;
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"foreach\" body line %d)", Tcl_GetErrorLine(interp)));
+ "\n (\"%s\" body line %d)",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
+ Tcl_GetErrorLine(interp)));
default:
goto done;
}
@@ -2790,7 +2800,7 @@ ForeachLoopStep(
goto done;
}
- TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL);
+ TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
}
@@ -2798,9 +2808,15 @@ ForeachLoopStep(
/*
* We're done. Tidy up our work space and finish off.
*/
+
finish:
- Tcl_SetObjResult(interp, statePtr->resultList);
- statePtr->resultList = NULL; /* Don't clean it up */
+ if (statePtr->resultList == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_SetObjResult(interp, statePtr->resultList);
+ statePtr->resultList = NULL; /* Don't clean it up */
+ }
+
done:
ForeachCleanup(interp, statePtr);
return result;
@@ -2833,7 +2849,8 @@ ForeachAssignments(
if (varValuePtr == NULL) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (setting foreach loop variable \"%s\")",
+ "\n (setting %s loop variable \"%s\")",
+ (statePtr->resultList != NULL ? "lmap" : "foreach"),
TclGetString(statePtr->varvList[i][v])));
return TCL_ERROR;
}
@@ -2862,7 +2879,7 @@ ForeachCleanup(
TclDecrRefCount(statePtr->aCopyList[i]);
}
}
- if (statePtr->resultList) {
+ if (statePtr->resultList != NULL) {
TclDecrRefCount(statePtr->resultList);
}
TclStackFree(interp, statePtr);
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 4d015ec..13f479d 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -40,10 +40,10 @@ static int PushVarName(Tcl_Interp *interp,
int flags, int *localIndexPtr,
int *simpleVarNamePtr, int *isScalarPtr,
int line, int *clNext);
-static int TclCompileEachloopCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr,
- int collect);
-static int TclCompileDictEachCmd(Tcl_Interp *interp,
+static int CompileEachloopCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ CompileEnv *envPtr, int collect);
+static int CompileDictEachCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr, int collect);
@@ -795,37 +795,42 @@ TclCompileDictForCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- return TclCompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, 0);
+ return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_KEEP_NONE);
}
int
TclCompileDictMapCmd(
- Tcl_Interp *interp, /* Used for looking up stuff. */
- Tcl_Parse *parsePtr, /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- Command *cmdPtr, /* Points to defintion of command being
- * compiled. */
- CompileEnv *envPtr) /* Holds resulting instructions. */
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
{
- return TclCompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, 1);
+ return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_COLLECT);
}
int
-TclCompileDictEachCmd(
- Tcl_Interp *interp, /* Used for looking up stuff. */
- Tcl_Parse *parsePtr, /* Points to a parse structure for the command
- * created by Tcl_ParseCommand. */
- Command *cmdPtr, /* Points to defintion of command being
- * compiled. */
- CompileEnv *envPtr, /* Holds resulting instructions. */
- int collect) /* Flag == 1 to collect and return loop body result. */
+CompileDictEachCmd(
+ Tcl_Interp *interp, /* Used for looking up stuff. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr, /* Holds resulting instructions. */
+ int collect) /* Flag == TCL_EACH_COLLECT to collect and
+ * construct a new dictionary with the loop
+ * body result. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
int numVars, endTargetOffset;
- int collectTemp; /* Index of temp var holding the result list. */
+ int collectVar = -1; /* Index of temp var holding the result
+ * dict. */
int savedStackDepth = envPtr->currStackDepth;
/* Needed because jumps confuse the stack
* space calculator. */
@@ -901,16 +906,12 @@ TclCompileDictEachCmd(
* Create temporary variable to capture return values from loop body.
*/
- if (collect == 1) {
- collectTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, envPtr);
-
- PushLiteral(envPtr, "", 0);
- if (collectTemp <= 255) {
- TclEmitInstInt1(INST_STORE_SCALAR1, collectTemp, envPtr);
- } else {
- TclEmitInstInt4(INST_STORE_SCALAR4, collectTemp, envPtr);
+ if (collect == TCL_EACH_COLLECT) {
+ collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1,
+ envPtr);
+ if (collectVar < 0) {
+ return TCL_ERROR;
}
- TclEmitOpcode(INST_POP, envPtr);
}
/*
@@ -927,6 +928,16 @@ TclCompileDictEachCmd(
TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr);
/*
+ * Initialize the accumulator dictionary, if needed.
+ */
+
+ if (collect == TCL_EACH_COLLECT) {
+ PushLiteral(envPtr, "", 0);
+ Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
+ }
+
+ /*
* Now we catch errors from here on so that we can finalize the search
* started by Tcl_DictObjFirst above.
*/
@@ -958,12 +969,12 @@ TclCompileDictEachCmd(
SetLineInformation(3);
CompileBody(envPtr, bodyTokenPtr, interp);
- if (collect == 1) {
- if (collectTemp <= 255) {
- TclEmitInstInt1(INST_LAPPEND_SCALAR1, collectTemp, envPtr);
- } else {
- TclEmitInstInt4(INST_LAPPEND_SCALAR4, collectTemp, envPtr);
- }
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr);
+ TclEmitInstInt4(INST_OVER, 1, envPtr);
+ TclEmitInstInt4(INST_DICT_SET, 1, envPtr);
+ TclEmitInt4( collectVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
TclEmitOpcode( INST_POP, envPtr);
@@ -1039,12 +1050,8 @@ TclCompileDictEachCmd(
jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement,
envPtr->codeStart + endTargetOffset);
- if (collect == 1) {
- if (collectTemp <= 255) {
- TclEmitInstInt1(INST_LOAD_SCALAR1, collectTemp, envPtr);
- } else {
- TclEmitInstInt4(INST_LOAD_SCALAR4, collectTemp, envPtr);
- }
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
} else {
PushLiteral(envPtr, "", 0);
}
@@ -1935,13 +1942,14 @@ TclCompileForeachCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- return TclCompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, 0);
+ return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_KEEP_NONE);
}
/*
*----------------------------------------------------------------------
*
- * TclCompileEachloopCmd --
+ * CompileEachloopCmd --
*
* Procedure called to compile the "foreach" and "lmap" commands.
*
@@ -1957,14 +1965,15 @@ TclCompileForeachCmd(
*/
static int
-TclCompileEachloopCmd(
+CompileEachloopCmd(
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. */
- int collect) /* Select collecting or accumulating mode (TCL_EACH_*) */
+ int collect) /* Select collecting or accumulating mode
+ * (TCL_EACH_*) */
{
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr; /* Points to the structure describing this
@@ -1974,7 +1983,8 @@ TclCompileEachloopCmd(
* used to point to a value list. */
int loopCtTemp; /* Index of temp var holding the loop's
* iteration count. */
- int collectTemp = -1; /* Index of temp var holding the result var index. */
+ int collectVar = -1; /* Index of temp var holding the result var
+ * index. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
unsigned char *jumpPc;
@@ -2091,6 +2101,14 @@ TclCompileEachloopCmd(
loopIndex++;
}
+ if (collect == TCL_EACH_COLLECT) {
+ collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1,
+ envPtr);
+ if (collectVar < 0) {
+ return TCL_ERROR;
+ }
+ }
+
/*
* We will compile the foreach command. Reserve (numLists + 1) temporary
* variables:
@@ -2171,15 +2189,9 @@ TclCompileEachloopCmd(
*/
if (collect == TCL_EACH_COLLECT) {
- collectTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, envPtr);
-
PushLiteral(envPtr, "", 0);
- if (collectTemp <= 255) {
- TclEmitInstInt1( INST_STORE_SCALAR1, collectTemp, envPtr);
- } else {
- TclEmitInstInt4( INST_STORE_SCALAR4, collectTemp, envPtr);
- }
- TclEmitOpcode( INST_POP, envPtr);
+ Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr);
+ TclEmitOpcode( INST_POP, envPtr);
}
/*
@@ -2208,14 +2220,9 @@ TclCompileEachloopCmd(
envPtr->currStackDepth = savedStackDepth + 1;
if (collect == TCL_EACH_COLLECT) {
- if (collectTemp <= 255) {
- TclEmitInstInt1( INST_LAPPEND_SCALAR1, collectTemp, envPtr);
- } else {
- TclEmitInstInt4( INST_LAPPEND_SCALAR4, collectTemp, envPtr);
- }
+ Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr);
}
- TclEmitOpcode( INST_POP, envPtr);
-
+ TclEmitOpcode( INST_POP, envPtr);
/*
* Jump back to the test at the top of the loop. Generate a 4 byte jump if
@@ -2270,12 +2277,8 @@ TclCompileEachloopCmd(
*/
envPtr->currStackDepth = savedStackDepth;
- if (collectTemp >= 0) {
- if (collectTemp <= 255) {
- TclEmitInstInt1( INST_LOAD_SCALAR1, collectTemp, envPtr);
- } else {
- TclEmitInstInt4( INST_LOAD_SCALAR4, collectTemp, envPtr);
- }
+ if (collect == TCL_EACH_COLLECT) {
+ Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr);
} else {
PushLiteral(envPtr, "", 0);
}
@@ -3856,7 +3859,8 @@ TclCompileLmapCmd(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- return TclCompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, 1);
+ return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
+ TCL_EACH_COLLECT);
}
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index df1fa37..c716ed2 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2487,6 +2487,14 @@ typedef struct List {
(((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)
/*
+ * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
+ * TclNRLmapCmd and their compilations.
+ */
+
+#define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */
+#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
+
+/*
* Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
* Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
*
@@ -2859,16 +2867,6 @@ struct Tcl_LoadHandle_ {
#define TCL_DD_SHORTEST0 0x0
/* 'Shortest possible' after masking */
-/* Modes for collecting or accumulating in TclNREachloopCmd,
- * TclCompileEachloopCmd and INST_FOREACH_STEP4. */
-
-#define TCL_EACH_KEEP_NONE 0
- /* Discard iteration result like [foreach] */
-
-#define TCL_EACH_COLLECT 1
- /* Collect iteration result like [lmap] */
-
-
/*
*----------------------------------------------------------------
* Procedures shared among Tcl modules but not used by the outside world:
generated by cgit v0.12 at 2024-07-08 23:41:52 (GMT)