compilation code adjusted

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: