From 8f8438c53e0a086672a12fec00764d770323caed Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 5 Dec 2013 15:15:23 +0000
Subject: New compiler and bytecodes for foreach and lmap: 70% faster

   * speed as measured by http://wiki.tcl.tk/39021: runs in <1/3 the time

   * still need to adapt array-set to use this

   * assemble.test-16.5 or 16.6 bombs in a purify/symbols build (?)

   * removing the old opcodes would force recompilation of old .tbc files or adaptation of tbcload
---
 generic/tcl.h         |   4 ++
 generic/tclCompCmds.c | 131 ++++++++++-----------------------------
 generic/tclCompile.c  |  10 +++
 generic/tclCompile.h  |  12 +++-
 generic/tclExecute.c  | 168 +++++++++++++++++++++++++++++++++++++++++++++++++-
 5 files changed, 220 insertions(+), 105 deletions(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index 4bf81cc..aab299e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -848,6 +848,10 @@ typedef struct Tcl_Obj {
 	    void *ptr;
 	    unsigned long value;
 	} ptrAndLongRep;
+	struct {
+	    long int1;
+	    long int2;
+	} twoIntValue;
     } internalRep;
 } Tcl_Obj;
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 9c43bfe..e934d92 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2469,18 +2469,12 @@ 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,6 +2582,10 @@ CompileEachloopCmd(
 	loopIndex++;
     }
 
+    /*
+     * We will compile the foreach command.
+     */
+
     if (collect == TCL_EACH_COLLECT) {
 	collectVar = AnonymousLocal(envPtr);
 	if (collectVar < 0) {
@@ -2595,25 +2593,7 @@ CompileEachloopCmd(
 	}
     }
 	    
-    /*
-     * 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.
-     */
-
     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
@@ -2624,8 +2604,8 @@ CompileEachloopCmd(
     infoPtr = ckalloc(sizeof(ForeachInfo)
 	    + numLists * sizeof(ForeachVarList *));
     infoPtr->numLists = numLists;
-    infoPtr->firstValueTemp = firstValueTemp;
-    infoPtr->loopCtTemp = loopCtTemp;
+    infoPtr->firstValueTemp = collect;
+    infoPtr->loopCtTemp = 0;
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	ForeachVarList *varListPtr;
 
@@ -2645,25 +2625,14 @@ CompileEachloopCmd(
     infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
 
     /*
-     * Create an exception record to handle [break] and [continue].
+     * Evaluate each value list and leave it on stack.
      */
 
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
-    /*
-     * Evaluate then store each value list in the associated temporary.
-     */
-
-    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++;
 	}
     }
 
@@ -2677,81 +2646,43 @@ CompileEachloopCmd(
 	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.
+     * Bottom of loop code: assign each loop variable and check whether
+     * to terminate the loop. Set the loop's break target. 
      */
 
-    jumpBackOffset = CurrentOffset(envPtr);
-    jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
-    if (jumpBackDist > 120) {
-	TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
-    } else {
-	TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
-    }
-
-    /*
-     * Fix the target of the jump after the foreach_step test.
-     */
-
-    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
      */
-
-    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
@@ -2765,8 +2696,8 @@ CompileEachloopCmd(
     } else {
 	PushStringLiteral(envPtr, "");
     }
-
-  done:
+    
+    done:
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	if (varvList[loopIndex] != NULL) {
 	    ckfree(varvList[loopIndex]);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 3c8e4ef..7cd9796 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -545,6 +545,16 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Drops an element from the auxiliary stack, popping stack elements
 	 * until the matching stack depth is reached. */
 
+    /* New foreach implementation */
+    {"foreach_start",	  5,   +2,          1,	{OPERAND_AUX4}},
+	/* Initialize execution of a foreach loop. Operand is aux data index
+	 * of the ForeachInfo structure for the foreach command. It pushes 2
+	 * elements which hold runtime params for foreach_step, they are later
+	 * dropped by foreach_end together with the value lists. */ 
+    {"foreach_step",	  1,    0,         0,	{OPERAND_NONE}},
+	/* "Step" or begin next iteration of foreach loop. */
+    {"foreach_end",	  1,    0,         0,	{OPERAND_NONE}},
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a39e0f1..c4e6222 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -586,8 +586,8 @@ typedef struct ByteCode {
 #define INST_CONTINUE			66
 
 /* Opcodes 67 to 68 */
-#define INST_FOREACH_START4		67
-#define INST_FOREACH_STEP4		68
+#define INST_FOREACH_START4		67 /* DEPRECATED */
+#define INST_FOREACH_STEP4		68 /* DEPRECATED */
 
 /* Opcodes 69 to 72 */
 #define INST_BEGIN_CATCH4		69
@@ -768,8 +768,14 @@ typedef struct ByteCode {
 
 #define INST_EXPAND_DROP		165
 
+/* New foreach implementation */
+
+#define INST_FOREACH_START              166
+#define INST_FOREACH_STEP               167
+#define INST_FOREACH_END                168
+
 /* The last opcode */
-#define LAST_INST_OPCODE		165
+#define LAST_INST_OPCODE		168
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d3c1227..32b64a2 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6029,7 +6029,7 @@ TEBCresume(
 	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
 	long i;
 
-    case INST_FOREACH_START4:
+    case INST_FOREACH_START4: /* DEPRECATED */
 	/*
 	 * Initialize the temporary local var that holds the count of the
 	 * number of iterations of the loop body to -1.
@@ -6062,7 +6062,7 @@ TEBCresume(
 	NEXT_INST_F(5, 0, 0);
 #endif
 
-    case INST_FOREACH_STEP4:
+    case INST_FOREACH_STEP4: /* DEPRECATED */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
@@ -6180,6 +6180,170 @@ TEBCresume(
 	} else {
 	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
 	}
+
+    }
+    {
+	ForeachInfo *infoPtr;
+	Tcl_Obj *listPtr, **elements, *tmpPtr;
+	ForeachVarList *varListPtr;
+	int numLists, iterMax, listLen, numVars;
+	int iterTmp, iterNum, listTmpDepth;
+	int varIndex, valIndex, j;
+	long i;
+
+    case INST_FOREACH_START:
+	/*
+	 * Initialize the data for the looping construct, pushing the
+	 * corresponding Tcl_Objs to the stack.
+	 */
+
+	
+	opnd = TclGetUInt4AtPtr(pc+1);
+	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
+	numLists = infoPtr->numLists;
+
+	/*
+	 * Compute the number of iterations that will be run: iterMax
+	 */
+
+	iterMax = 0;
+	listTmpDepth = numLists-1;
+	for (i = 0;  i < numLists;  i++) {
+	    varListPtr = infoPtr->varLists[i];
+	    numVars = varListPtr->numVars;
+	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
+	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
+			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+		goto gotError;
+	    }
+	    if (Tcl_IsShared(listPtr)) {
+		objPtr = TclListObjCopy(NULL, listPtr);
+		Tcl_IncrRefCount(objPtr);
+		Tcl_DecrRefCount(listPtr);
+		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
+	    }
+	    iterTmp = (listLen + (numVars - 1))/numVars;
+	    if (iterTmp > iterMax) {
+		iterMax = iterTmp;
+	    }
+	    listTmpDepth--;
+	}
+	
+	/*
+	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
+	 * nul-string obj with the pointer stored in the ptrValue so that the
+	 * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
+	 * it will never leave this scope and is read-only.
+	 */
+
+	TclNewObj(tmpPtr);
+	tmpPtr->internalRep.twoIntValue.int1 = 0;
+	tmpPtr->internalRep.twoIntValue.int2 = iterMax;
+	PUSH_OBJECT(tmpPtr); /* iterCounts object */
+		
+	/*
+	 * Store a pointer to the ForeachInfo struct; same dirty trick
+	 * as above 
+	 */
+	
+	TclNewObj(tmpPtr);
+	tmpPtr->internalRep.otherValuePtr = infoPtr;
+	PUSH_OBJECT(tmpPtr); /* infoPtr object */
+
+	/*
+	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
+	 * falls through.
+	 */ 
+
+	pc += 5 - infoPtr->loopCtTemp;
+	
+    case INST_FOREACH_STEP:
+	/*
+	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
+	 * the next value list element to each loop var.
+	 */
+
+	tmpPtr = OBJ_AT_TOS;
+	infoPtr = tmpPtr->internalRep.otherValuePtr;
+	numLists = infoPtr->numLists;
+
+	tmpPtr = OBJ_AT_DEPTH(1);
+	iterNum = tmpPtr->internalRep.twoIntValue.int1;
+	iterMax = tmpPtr->internalRep.twoIntValue.int2;
+
+	/*
+	 * If some list still has a remaining list element iterate one more
+	 * time. Assign to var the next element from its value list.
+	 */
+	    
+	if (iterNum < iterMax) {
+	    /*
+	     * Set the variables and jump back to run the body
+	     */
+
+	    tmpPtr->internalRep.twoIntValue.int1 = iterNum + 1;
+	    
+	    listTmpDepth = numLists + 1;
+
+	    for (i = 0;  i < numLists;  i++) {
+		varListPtr = infoPtr->varLists[i];
+		numVars = varListPtr->numVars;
+
+		listPtr = OBJ_AT_DEPTH(listTmpDepth);
+		TclListObjGetElements(interp, listPtr, &listLen, &elements);
+
+		valIndex = (iterNum * numVars);
+		for (j = 0;  j < numVars;  j++) {
+		    if (valIndex >= listLen) {
+			TclNewObj(valuePtr);
+		    } else {
+			valuePtr = elements[valIndex];
+		    }
+
+		    varIndex = varListPtr->varIndexes[j];
+		    varPtr = LOCAL(varIndex);
+		    while (TclIsVarLink(varPtr)) {
+			varPtr = varPtr->value.linkPtr;
+		    }
+		    if (TclIsVarDirectWritable(varPtr)) {
+			value2Ptr = varPtr->value.objPtr;
+			if (valuePtr != value2Ptr) {
+			    if (value2Ptr != NULL) {
+				TclDecrRefCount(value2Ptr);
+			    }
+			    varPtr->value.objPtr = valuePtr;
+			    Tcl_IncrRefCount(valuePtr);
+			}
+		    } else {
+			DECACHE_STACK_INFO();
+			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+			    CACHE_STACK_INFO();
+			    TRACE_WITH_OBJ((
+				    "%u => ERROR init. index temp %d: ",
+				    opnd,varIndex), Tcl_GetObjResult(interp));
+			    goto gotError;
+			}
+			CACHE_STACK_INFO();
+		    }
+		    valIndex++;
+		}
+		listTmpDepth--;
+	    }
+	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
+	}
+
+	/*
+	 * FALL THROUGH
+	 */
+	pc++;
+
+    case INST_FOREACH_END:
+	tmpPtr = OBJ_AT_TOS;
+	infoPtr = tmpPtr->internalRep.otherValuePtr;
+	numLists = infoPtr->numLists;
+	NEXT_INST_V(1, numLists+2, 0);
     }
 
     case INST_BEGIN_CATCH4:
-- 
cgit v0.12


From 631b9c724ec78675e289d7f1dec92dc7d5165fc2 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 5 Dec 2013 16:01:16 +0000
Subject: add comments on field "misuse"

---
 generic/tclCompCmds.c | 2 +-
 generic/tclExecute.c  | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index e934d92..78c6c5a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2677,7 +2677,7 @@ CompileEachloopCmd(
 
     /*
      * Set the jumpback distance from INST_FOREACH_STEP to the start of the
-     * body's code
+     * body's code. Misuse loopCtTemp for storing the jump size.
      */
     
     jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 32b64a2..191a897 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6331,6 +6331,7 @@ TEBCresume(
 		}
 		listTmpDepth--;
 	    }
+	    /* loopCtTemp being 'misused' for storing the jump size */
 	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
 	}
 
-- 
cgit v0.12


From ff9c2d4ad9a37c50a4921bada422365ae85d5ac1 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 5 Dec 2013 17:18:54 +0000
Subject: add comments on INST_FOREACH_*

---
 generic/tclExecute.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 191a897..fe05b30 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6259,6 +6259,7 @@ TEBCresume(
 	pc += 5 - infoPtr->loopCtTemp;
 	
     case INST_FOREACH_STEP:
+	/* THIS INSTRUCTION IS ONLY CALLED AS A CONTINUE TARGET */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
@@ -6341,6 +6342,7 @@ TEBCresume(
 	pc++;
 
     case INST_FOREACH_END:
+	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
 	tmpPtr = OBJ_AT_TOS;
 	infoPtr = tmpPtr->internalRep.otherValuePtr;
 	numLists = infoPtr->numLists;
-- 
cgit v0.12


From ec2f589b56bb7241ee7f7b60aad33ccdfa46ec98 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 00:02:16 +0000
Subject: tighter mem management

---
 generic/tclCompCmds.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 78c6c5a..da14af1 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2602,16 +2602,14 @@ CompileEachloopCmd(
      */
 
     infoPtr = ckalloc(sizeof(ForeachInfo)
-	    + numLists * sizeof(ForeachVarList *));
+	    + (numLists - 1) * sizeof(ForeachVarList *));
     infoPtr->numLists = numLists;
-    infoPtr->firstValueTemp = collect;
-    infoPtr->loopCtTemp = 0;
     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];
-- 
cgit v0.12


From bd06c04659422136285db5fbcb585c18d10b595d Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 00:16:07 +0000
Subject: tighter mem management in array-set compiler

---
 generic/tclCompCmds.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index da14af1..73b1ec3 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -323,11 +323,11 @@ TclCompileArraySetCmd(
     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;
-- 
cgit v0.12


From 53009920c226ade2ef2f7f12b73ee9cc0bcf766b Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 01:07:10 +0000
Subject: adapted the array-set compiler to use the new foreach opcodes

---
 generic/tclCompCmds.c | 83 +++++++++++++++++++--------------------------------
 generic/tclExecute.c  |  1 -
 2 files changed, 31 insertions(+), 53 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 73b1ec3..b8b2605 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -245,8 +245,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;
 
@@ -290,6 +290,7 @@ TclCompileArraySetCmd(
 	code = TCL_ERROR;
 	goto done;
     }
+
     /*
      * Special case: literal empty value argument is just an "ensure array"
      * operation.
@@ -314,19 +315,28 @@ 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));
     infoPtr->numLists = 1;
-    infoPtr->firstValueTemp = dataVar;
-    infoPtr->loopCtTemp = iterVar;
     infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
     infoPtr->varLists[0]->numVars = 2;
     infoPtr->varLists[0]->varIndexes[0] = keyVar;
@@ -360,54 +370,23 @@ TclCompileArraySetCmd(
 	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;
 }
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fe05b30..a831cd6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6259,7 +6259,6 @@ TEBCresume(
 	pc += 5 - infoPtr->loopCtTemp;
 	
     case INST_FOREACH_STEP:
-	/* THIS INSTRUCTION IS ONLY CALLED AS A CONTINUE TARGET */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
-- 
cgit v0.12


From 7631cbda15c13ff69b665f0b71ad20c866c00624 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 6 Dec 2013 09:28:45 +0000
Subject: Stop printing undefined values in disassembled code.

---
 generic/tclCompCmds.c | 42 +++++++++++++++++++++++++++++++++++++++++-
 generic/tclCompile.h  |  1 +
 generic/tclExecute.c  | 17 ++++++++---------
 3 files changed, 50 insertions(+), 10 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index b8b2605..bdab2ff 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -31,6 +31,9 @@ static void		FreeForeachInfo(ClientData clientData);
 static void		PrintForeachInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
+static void		PrintNewForeachInfo(ClientData clientData,
+			    Tcl_Obj *appendObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
 static int		CompileEachloopCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    CompileEnv *envPtr, int collect);
@@ -49,6 +52,13 @@ const AuxDataType tclForeachInfoType = {
     PrintForeachInfo		/* printProc */
 };
 
+const AuxDataType tclNewForeachInfoType = {
+    "NewForeachInfo",		/* name */
+    DupForeachInfo,		/* dupProc */
+    FreeForeachInfo,		/* freeProc */
+    PrintNewForeachInfo		/* printProc */
+};
+
 const AuxDataType tclDictUpdateInfoType = {
     "DictUpdateInfo",		/* name */
     DupDictUpdateInfo,		/* dupProc */
@@ -2599,7 +2609,7 @@ CompileEachloopCmd(
 	}
 	infoPtr->varLists[loopIndex] = varListPtr;
     }
-    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+    infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
 
     /*
      * Evaluate each value list and leave it on stack.
@@ -2828,6 +2838,36 @@ PrintForeachInfo(
 	Tcl_AppendToObj(appendObj, "]", -1);
     }
 }
+
+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);
+    }
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c4e6222..8b1724b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -908,6 +908,7 @@ typedef struct ForeachInfo {
 } ForeachInfo;
 
 MODULE_SCOPE const AuxDataType tclForeachInfoType;
+MODULE_SCOPE const AuxDataType tclNewForeachInfoType;
 
 #define FOREACHINFO(envPtr, index) \
     ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a831cd6..f496fe7 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6197,7 +6197,6 @@ TEBCresume(
 	 * corresponding Tcl_Objs to the stack.
 	 */
 
-	
 	opnd = TclGetUInt4AtPtr(pc+1);
 	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
 	numLists = infoPtr->numLists;
@@ -6229,7 +6228,7 @@ TEBCresume(
 	    }
 	    listTmpDepth--;
 	}
-	
+
 	/*
 	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
 	 * nul-string obj with the pointer stored in the ptrValue so that the
@@ -6241,12 +6240,12 @@ TEBCresume(
 	tmpPtr->internalRep.twoIntValue.int1 = 0;
 	tmpPtr->internalRep.twoIntValue.int2 = iterMax;
 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
-		
+
 	/*
 	 * Store a pointer to the ForeachInfo struct; same dirty trick
-	 * as above 
+	 * as above
 	 */
-	
+
 	TclNewObj(tmpPtr);
 	tmpPtr->internalRep.otherValuePtr = infoPtr;
 	PUSH_OBJECT(tmpPtr); /* infoPtr object */
@@ -6254,10 +6253,10 @@ TEBCresume(
 	/*
 	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
 	 * falls through.
-	 */ 
+	 */
 
 	pc += 5 - infoPtr->loopCtTemp;
-	
+
     case INST_FOREACH_STEP:
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
@@ -6276,14 +6275,14 @@ TEBCresume(
 	 * If some list still has a remaining list element iterate one more
 	 * time. Assign to var the next element from its value list.
 	 */
-	    
+
 	if (iterNum < iterMax) {
 	    /*
 	     * Set the variables and jump back to run the body
 	     */
 
 	    tmpPtr->internalRep.twoIntValue.int1 = iterNum + 1;
-	    
+
 	    listTmpDepth = numLists + 1;
 
 	    for (i = 0;  i < numLists;  i++) {
-- 
cgit v0.12


From 68864af6c2b0d93f8693c0f3447ffc7f8f92eb0e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 6 Dec 2013 10:04:48 +0000
Subject: Introducing a new union member in Tcl_Obj is not a good idea in a
 patch release, especially using "long". Better allow iterNum and iterMax to
 grow to ssize_t (or size_t) in Tcl 9 (or 8.x, why not?). Usage of "long" in
 public API causes interoperability problems between Cygwin64 and Win64
 (probably no-one cares except me).

---
 generic/tcl.h        |  4 ----
 generic/tclExecute.c | 10 +++++-----
 2 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index aab299e..4bf81cc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -848,10 +848,6 @@ typedef struct Tcl_Obj {
 	    void *ptr;
 	    unsigned long value;
 	} ptrAndLongRep;
-	struct {
-	    long int1;
-	    long int2;
-	} twoIntValue;
     } internalRep;
 } Tcl_Obj;
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f496fe7..c3f5372 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6237,8 +6237,8 @@ TEBCresume(
 	 */
 
 	TclNewObj(tmpPtr);
-	tmpPtr->internalRep.twoIntValue.int1 = 0;
-	tmpPtr->internalRep.twoIntValue.int2 = iterMax;
+	tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
 
 	/*
@@ -6268,8 +6268,8 @@ TEBCresume(
 	numLists = infoPtr->numLists;
 
 	tmpPtr = OBJ_AT_DEPTH(1);
-	iterNum = tmpPtr->internalRep.twoIntValue.int1;
-	iterMax = tmpPtr->internalRep.twoIntValue.int2;
+	iterNum = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr1);
+	iterMax = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr2);
 
 	/*
 	 * If some list still has a remaining list element iterate one more
@@ -6281,7 +6281,7 @@ TEBCresume(
 	     * Set the variables and jump back to run the body
 	     */
 
-	    tmpPtr->internalRep.twoIntValue.int1 = iterNum + 1;
+	    tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
 
 	    listTmpDepth = numLists + 1;
 
-- 
cgit v0.12


From c5df69b71626521628a0033c5e3720beaa366998 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 6 Dec 2013 10:17:58 +0000
Subject: Oops, wrong macro.

---
 generic/tclExecute.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c3f5372..b6d8841 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6268,8 +6268,8 @@ TEBCresume(
 	numLists = infoPtr->numLists;
 
 	tmpPtr = OBJ_AT_DEPTH(1);
-	iterNum = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr1);
-	iterMax = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr2);
+	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
+	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
 
 	/*
 	 * If some list still has a remaining list element iterate one more
-- 
cgit v0.12


From 3cfba0cf67f0c2170e26cbff26e5dcc8bc64bf61 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 14:29:49 +0000
Subject: change NULL to INT2PTR(0), for clarity

---
 generic/tclExecute.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b6d8841..a3083bc 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6237,7 +6237,7 @@ TEBCresume(
 	 */
 
 	TclNewObj(tmpPtr);
-	tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+	tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
 	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
 
-- 
cgit v0.12


From 5b08f1d1ef025223ce9bc15d06dbdb88c247822a Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Tue, 10 Dec 2013 11:38:17 +0000
Subject: new INST_LMAP_COLLECT, speeds up lmap and eliminates the need for a
 temp var

---
 generic/tclCompCmds.c | 42 ++++++++++++++----------------------------
 generic/tclCompile.c  |  1 +
 generic/tclCompile.h  |  3 ++-
 generic/tclExecute.c  | 19 +++++++++++++++++++
 4 files changed, 36 insertions(+), 29 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index bdab2ff..cd43cfc 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2458,8 +2458,6 @@ CompileEachloopCmd(
     ForeachInfo *infoPtr;	/* Points to the structure describing this
 				 * foreach command. Stored in a AuxData
 				 * record in the ByteCode. */
-    int collectVar = -1;	/* Index of temp var holding the result var
-				 * index. */
     
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     int jumpBackOffset, infoIndex, range;
@@ -2575,13 +2573,6 @@ CompileEachloopCmd(
      * We will compile the foreach command.
      */
 
-    if (collect == TCL_EACH_COLLECT) {
-	collectVar = AnonymousLocal(envPtr);
-	if (collectVar < 0) {
-	    return TCL_ERROR;
-	}
-    }
-	    
     code = TCL_OK;
 
     /*
@@ -2612,6 +2603,14 @@ CompileEachloopCmd(
     infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
 
     /*
+     * Create the collecting object, unshared.
+     */
+    
+    if (collect == TCL_EACH_COLLECT) {
+	TclEmitInstInt4(INST_LIST, 0, envPtr);
+    }
+	    
+    /*
      * Evaluate each value list and leave it on stack.
      */
 
@@ -2623,16 +2622,6 @@ CompileEachloopCmd(
 	}
     }
 
-    /*
-     * 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);
-    }
-
     TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
     
     /*
@@ -2646,9 +2635,10 @@ CompileEachloopCmd(
     ExceptionRangeEnds(envPtr, range);
     
     if (collect == TCL_EACH_COLLECT) {
-	Emit14Inst(		INST_LAPPEND_SCALAR, collectVar,envPtr);
+	TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
+    } else {
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
-    TclEmitOpcode(		INST_POP,			envPtr);
 
     /*
      * Bottom of loop code: assign each loop variable and check whether
@@ -2672,15 +2662,11 @@ CompileEachloopCmd(
     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, "");
     }
     
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7cd9796..c7b7875 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -554,6 +554,7 @@ InstructionDesc const tclInstructionTable[] = {
     {"foreach_step",	  1,    0,         0,	{OPERAND_NONE}},
 	/* "Step" or begin next iteration of foreach loop. */
     {"foreach_end",	  1,    0,         0,	{OPERAND_NONE}},
+    {"lmap_collect",	  1,    0,         0,	{OPERAND_NONE}},
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 8b1724b..7f62849 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -773,9 +773,10 @@ typedef struct ByteCode {
 #define INST_FOREACH_START              166
 #define INST_FOREACH_STEP               167
 #define INST_FOREACH_END                168
+#define INST_LMAP_COLLECT               169
 
 /* The last opcode */
-#define LAST_INST_OPCODE		168
+#define LAST_INST_OPCODE		169
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a3083bc..9261f19 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6345,6 +6345,25 @@ TEBCresume(
 	infoPtr = tmpPtr->internalRep.otherValuePtr;
 	numLists = infoPtr->numLists;
 	NEXT_INST_V(1, numLists+2, 0);
+
+    case INST_LMAP_COLLECT:
+	/*
+	 * This instruction is only issued by lmap. The stack is:
+	 *   - result
+	 *   - infoPtr
+	 *   - loop counters
+	 *   - valLists
+	 *   - collecting obj (unshared)
+	 * The instruction lappends the result to the collecting obj.
+	 */
+
+	tmpPtr = OBJ_AT_DEPTH(1);
+	infoPtr = tmpPtr->internalRep.otherValuePtr;
+	numLists = infoPtr->numLists;
+	
+	objPtr = OBJ_AT_DEPTH(3 + numLists);
+	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
+	NEXT_INST_F(1, 1, 0);
     }
 
     case INST_BEGIN_CATCH4:
-- 
cgit v0.12


From 05c6524f4576db17abf945a46f2a34d85d34a683 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Tue, 10 Dec 2013 12:05:06 +0000
Subject: fix stack computations for lmap

---
 generic/tclCompile.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c7b7875..6c2e2b6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -554,7 +554,7 @@ InstructionDesc const tclInstructionTable[] = {
     {"foreach_step",	  1,    0,         0,	{OPERAND_NONE}},
 	/* "Step" or begin next iteration of foreach loop. */
     {"foreach_end",	  1,    0,         0,	{OPERAND_NONE}},
-    {"lmap_collect",	  1,    0,         0,	{OPERAND_NONE}},
+    {"lmap_collect",	  1,   -1,         0,	{OPERAND_NONE}},
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
-- 
cgit v0.12


From 6af51247c19f071e11ea3f2b27724643bb7e0d70 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 13:49:20 +0000
Subject: simplifying: drop early the evaled script

---
 generic/tclCompCmds.c | 37 ++++++++-----------------------------
 1 file changed, 8 insertions(+), 29 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index cd43cfc..0a0aa8e 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -610,11 +610,10 @@ TclCompileCatchCmd(
 	ExceptionRangeStarts(envPtr, range);
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitInvoke(envPtr,	INST_EVAL_STK);
+	/* drop the script */
+	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
-    /* Stack at this point:
-     *    nonsimple:  script <mark> result
-     *    simple:            <mark> result
-     */
 
     if (resultIndex == -1) {
 	/*
@@ -632,14 +631,7 @@ TclCompileCatchCmd(
 	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;
+	return TCL_OK;
     }
 
     /*
@@ -649,7 +641,6 @@ TclCompileCatchCmd(
 
     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
@@ -658,7 +649,7 @@ TclCompileCatchCmd(
 
     TclAdjustStackDepth(-2, envPtr);
     ExceptionRangeTarget(envPtr, range, catchOffset);
-    /* Stack at this point:  ?script? */
+    /* Stack at this point is empty */
     TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
     TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
 
@@ -666,7 +657,7 @@ TclCompileCatchCmd(
      * Update the target of the jump after the "no errors" code. 
      */
 
-    /* Stack at this point: ?script? result returnCode */
+    /* Stack at this point: result returnCode */
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
@@ -689,7 +680,7 @@ TclCompileCatchCmd(
 
     /*
      * At this point, the top of the stack is inconveniently ordered:
-     *		?script? result returnCode ?returnOptions?
+     *		result returnCode ?returnOptions?
      * Reverse the stack to bring the result to the top.
      */
 
@@ -707,7 +698,7 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_POP,			envPtr);
 
     /*
-     * Stack is now ?script? ?returnOptions? returnCode.
+     * Stack is now ?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.
@@ -719,18 +710,6 @@ TclCompileCatchCmd(
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
-  dropScriptAtEnd:
-
-    /*
-     * Stack is now ?script? result. Get rid of the subst'ed script if it's
-     * hanging arond.
-     */
-
-    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-    }
-
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 13a7f30bb1ad0a3bb814f20efe88d5eb02d9e453 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 14:51:15 +0000
Subject: store options early: simplify compiler, reduce stack manipulations

---
 generic/tclCompCmds.c | 32 ++++++--------------------------
 1 file changed, 6 insertions(+), 26 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 0a0aa8e..65c50eb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -614,6 +614,7 @@ TclCompileCatchCmd(
 	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
+    ExceptionRangeEnds(envPtr, range);
 
     if (resultIndex == -1) {
 	/*
@@ -669,47 +670,26 @@ TclCompileCatchCmd(
 
     if (optsIndex != -1) {
 	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
+	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
     /*
      * End the catch
      */
 
-    ExceptionRangeEnds(envPtr, range);
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
      * At this point, the top of the stack is inconveniently ordered:
-     *		result returnCode ?returnOptions?
-     * Reverse the stack to bring the result to the top.
-     */
-
-    if (optsIndex != -1) {
-	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
-    } else {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-    }
-
-    /*
-     * Store the result and remove it from the stack.
+     *		result returnCode
+     * Reverse the stack to store the result.
      */
 
+    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
     Emit14Inst(			INST_STORE_SCALAR, resultIndex,	envPtr);
     TclEmitOpcode(		INST_POP,			envPtr);
 
-    /*
-     * Stack is now ?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.
-     */
-
-    if (optsIndex != -1) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-    }
-
     return TCL_OK;
 }
 
-- 
cgit v0.12


From d83a8d3b91859aa6d510256f3b26c4a3d98bdd5d Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 15:16:20 +0000
Subject: simplify: remove the special case

---
 generic/tclCompCmds.c | 25 ++++---------------------
 1 file changed, 4 insertions(+), 21 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 65c50eb..dbc876a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -616,25 +616,6 @@ TclCompileCatchCmd(
     }
     ExceptionRangeEnds(envPtr, range);
 
-    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).
-	 */
-
-	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);
-	return TCL_OK;
-    }
-
     /*
      * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
      * and jump around the "error case" code.
@@ -687,8 +668,10 @@ TclCompileCatchCmd(
      */
 
     TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-    Emit14Inst(			INST_STORE_SCALAR, resultIndex,	envPtr);
-    TclEmitOpcode(		INST_POP,			envPtr);
+    if (resultIndex != -1) {
+	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);
+    }
+    TclEmitOpcode(	INST_POP,			envPtr);
 
     return TCL_OK;
 }
-- 
cgit v0.12


From c7d612f81758056c1d7511f1f4f8dff108ef76d7 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 15:55:28 +0000
Subject: new test, and fix for bug

---
 generic/tclCompCmds.c | 15 +++++++++------
 tests/compile.test    | 30 ++++++++++++++++++++++++++++++
 2 files changed, 39 insertions(+), 6 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index dbc876a..7997efa 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -645,14 +645,8 @@ TclCompileCatchCmd(
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
-    /*
-     * Push the return options if the caller wants them.
-     */
-
     if (optsIndex != -1) {
 	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
-	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
     /*
@@ -662,6 +656,15 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
+     * Push the return options if the caller wants them.
+     */
+
+    if (optsIndex != -1) {
+	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+    }
+
+    /*
      * At this point, the top of the stack is inconveniently ordered:
      *		result returnCode
      * Reverse the stack to store the result.
diff --git a/tests/compile.test b/tests/compile.test
index 36e24de..2852bf2 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -167,6 +167,36 @@ test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}
     -cleanup {namespace delete catchtest}
 }
 
+test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
+     -setup {
+	 namespace eval catchtest {
+	     variable options1 {}
+	 }
+	 trace add variable catchtest::options1 write catchtest::failtrace
+	 proc catchtest::failtrace {n1 n2 op} {
+	     return -code error "trace on $n1 fails by request"
+	 }
+     }
+    -body {
+	proc catchtest::x {} {
+	    variable options1
+	    set count 0
+	    for {set i 0} {$i < 10} {incr i} {
+		set status2 [catch {
+		    set status1 [catch {
+			return -code error -level 0 "original failure"
+		    } result1 options1]
+		} result2 options2]
+		incr count
+	    }
+	    list $count $result2
+	}
+	catchtest::x
+    }
+    -result {10 {can't set "options1": trace on options1 fails by request}}
+    -cleanup {namespace delete catchtest}
+}
+
 test compile-4.1 {TclCompileForCmd: command substituted test expression} {
     set i 0
     set j 0
-- 
cgit v0.12


From 1ef52b35f0c918fa1c081116f142afd4e244eaf1 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 16:27:59 +0000
Subject: comments

---
 generic/tclCompCmds.c | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7997efa..e071bbd 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -645,6 +645,11 @@ TclCompileCatchCmd(
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
+    /*
+     * Push the return options if the caller wants them. This needs to happen
+     * before INST_END_CATCH
+     */
+
     if (optsIndex != -1) {
 	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
     }
@@ -656,7 +661,8 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
-     * Push the return options if the caller wants them.
+     * 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) {
-- 
cgit v0.12


From d2ffd68c98038a0690f6a6e2f9a32b6439a7fe7e Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 16:33:21 +0000
Subject: comments

---
 generic/tclCompCmds.c | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index e071bbd..43504bf 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -635,16 +635,13 @@ TclCompileCatchCmd(
     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: result returnCode */
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
+    /* Stack at this point: result returnCode */
+
     /*
      * Push the return options if the caller wants them. This needs to happen
      * before INST_END_CATCH
-- 
cgit v0.12


From ee023de8d6942ebb02809d498f6dd46f634fa98d Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 16:43:26 +0000
Subject: comments

---
 generic/tclCompCmds.c | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 43504bf..72b338c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -582,11 +582,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
@@ -599,6 +595,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);
@@ -635,13 +632,13 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
     TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
 
+    /* Stack at this point on both branches: result returnCode */
+
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
-    /* Stack at this point: result returnCode */
-
     /*
      * Push the return options if the caller wants them. This needs to happen
      * before INST_END_CATCH
-- 
cgit v0.12


From 12a14105a15ca9bae71b2020fdc9d1c1b1b95dff Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 15 Dec 2013 17:49:53 +0000
Subject: Improve descriptions of character escapes and ranges in Tcl.n.
 Improve output format handlers to cope with added escape for en-dashes.

---
 doc/Tcl.n                      | 39 ++++++++++++++++++++++-----------------
 tools/man2help2.tcl            |  2 +-
 tools/tcltk-man2html-utils.tcl |  1 +
 3 files changed, 24 insertions(+), 18 deletions(-)

diff --git a/doc/Tcl.n b/doc/Tcl.n
index 8b17f93..c7fa9f6 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -108,8 +108,8 @@ Variable substitution may take any of the following forms:
 \fIName\fR is the name of a scalar variable;  the name is a sequence
 of one or more characters that are a letter, digit, underscore,
 or namespace separators (two or more colons).
-Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
-\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
 .TP 15
 \fB$\fIname\fB(\fIindex\fB)\fR
 .
@@ -117,8 +117,8 @@ Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
 the name of an element within that array.
 \fIName\fR must contain only letters, digits, underscores, and
 namespace separators, and may be an empty string.
-Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
-\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
 Command substitutions, variable substitutions, and backslash
 substitutions are performed on the characters of \fIindex\fR.
 .TP 15
@@ -158,25 +158,25 @@ handled specially, along with the value that replaces each sequence.
 .RS
 .TP 7
 \e\fBa\fR
-Audible alert (bell) (0x7).
+Audible alert (bell) (Unicode U+000007).
 .TP 7
 \e\fBb\fR
-Backspace (0x8).
+Backspace (Unicode U+000008).
 .TP 7
 \e\fBf\fR
-Form feed (0xc).
+Form feed (Unicode U+00000C).
 .TP 7
 \e\fBn\fR
-Newline (0xa).
+Newline (Unicode U+00000A).
 .TP 7
 \e\fBr\fR
-Carriage-return (0xd).
+Carriage-return (Unicode U+00000D).
 .TP 7
 \e\fBt\fR
-Tab (0x9).
+Tab (Unicode U+000009).
 .TP 7
 \e\fBv\fR
-Vertical tab (0xb).
+Vertical tab (Unicode U+00000B).
 .TP 7
 \e\fB<newline>\fIwhiteSpace\fR
 .
@@ -194,8 +194,9 @@ Backslash
 \e\fIooo\fR 
 .
 The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal 
-value for the Unicode character that will be inserted, in the range \fI000\fR
-- \fI377\fR.  The parser will stop just before this range overflows, or when
+value for the Unicode character that will be inserted, in the range
+\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
+The parser will stop just before this range overflows, or when
 the maximum of three digits is reached.  The upper bits of the Unicode
 character will be 0.
 .TP 7
@@ -203,23 +204,27 @@ character will be 0.
 .
 The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
 hexadecimal value for the Unicode character that will be inserted.  The upper
-bits of the Unicode character will be 0.
+bits of the Unicode character will be 0 (i.e., the character will be in the
+range U+000000\(enU+0000FF).
 .TP 7
 \e\fBu\fIhhhh\fR 
 .
 The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
 sixteen-bit hexadecimal value for the Unicode character that will be
-inserted.  The upper bits of the Unicode character will be 0.
+inserted.  The upper bits of the Unicode character will be 0 (i.e., the
+character will be in the range U+000000\(enU+00FFFF).
 .TP 7
 \e\fBU\fIhhhhhhhh\fR 
 .
 The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
 twenty-one-bit hexadecimal value for the Unicode character that will be
-inserted, in the range U+0000..U+10FFFF.  The parser will stop just
+inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
 before this range overflows, or when the maximum of eight digits
 is reached.  The upper bits of the Unicode character will be 0.
+.RS
 .PP
-The range U+010000..U+10FFFD is reserved for the future.
+The range U+010000\(enU+10FFFD is reserved for the future.
+.RE
 .PP
 Backslash substitution is not performed on words enclosed in braces,
 except for backslash-newline as described above.
diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl
index fe4e7ad..9c8f503 100644
--- a/tools/man2help2.tcl
+++ b/tools/man2help2.tcl
@@ -717,7 +717,7 @@ proc char {name} {
 	    textSetup
 	    puts -nonewline $file "\\'d7 "
 	}
-	{\(em} {
+	{\(em} - {\(en} {
 	    textSetup
 	    puts -nonewline $file "-"
 	}
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index bdd0079..8fd1245 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -142,6 +142,7 @@ proc process-text {text} {
 	    {\(+-}	"&#177;" \
 	    {\(co}	"&copy;" \
 	    {\(em}	"&#8212;" \
+	    {\(en}	"&#8211;" \
 	    {\(fm}	"&#8242;" \
 	    {\(mu}	"&#215;" \
 	    {\(mi}	"&#8722;" \
-- 
cgit v0.12


From 4cc4d69fe462a3661da5df84b1897b9959f6d5fd Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 18 Dec 2013 15:34:39 +0000
Subject: Making the optimizer pluggable by extensions; please review for
 committing to trunk

---
 generic/tclBasic.c    | 3 +++
 generic/tclCompile.c  | 4 +++-
 generic/tclCompile.h  | 2 +-
 generic/tclInt.h      | 9 ++++++++-
 generic/tclOptimize.c | 2 +-
 5 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a41351e..8ec94ca 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -526,6 +526,9 @@ Tcl_CreateInterp(void)
     iPtr->hiddenCmdTablePtr = NULL;
     iPtr->interpInfo = NULL;
 
+    TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
+    iPtr->extra.optimizer = TclOptimizeBytecode;
+
     iPtr->numLevels = 0;
     iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
     iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6c2e2b6..525571d 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -765,7 +765,9 @@ TclSetByteCodeFromAny(
      * instruction generator boundaries.
      */
 
-    TclOptimizeBytecode(&compEnv);
+    if (iPtr->extra.optimizer) {
+	(iPtr->extra.optimizer)(&compEnv);
+    }
 
     /*
      * Invoke the compilation hook procedure if one exists.
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 7f62849..55dd37a 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1064,7 +1064,7 @@ MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
 MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
 MODULE_SCOPE int	TclLog2(int value);
 #endif
-MODULE_SCOPE void	TclOptimizeBytecode(CompileEnv *envPtr);
+MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
 #ifdef TCL_COMPILE_DEBUG
 MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5c8dbfd..8ccfadb 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1809,7 +1809,14 @@ typedef struct Interp {
     ClientData interpInfo;	/* Information used by tclInterp.c to keep
 				 * track of master/slave interps on a
 				 * per-interp basis. */
-    Tcl_HashTable unused2;	/* No longer used (was mathFuncTable) */
+    union {
+	void (*optimizer)(void *envPtr);
+	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
+				 * unused space in interp was repurposed for
+				 * pluggable bytecode optimizers. The core
+				 * contains one optimizer, which can be
+				 * selectively overriden by extensions. */
+    } extra;
 
     /*
      * Information related to procedures and variables. See tclProc.c and
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 3b16e6e..74de7a3 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -427,7 +427,7 @@ AdvanceJumps(
 
 void
 TclOptimizeBytecode(
-    CompileEnv *envPtr)
+    void *envPtr)
 {
     ConvertZeroEffectToNOP(envPtr);
     AdvanceJumps(envPtr);
-- 
cgit v0.12