add special opcodes for common forms of stack manipulations

6 files changed, 66 insertions, 40 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 729dfce..dbc5e36 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -356,6 +356,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"eq",		ASSEM_1BYTE,	INST_EQ,		2,	1},
     {"eval",		ASSEM_EVAL,	INST_EVAL_STK,		1,	1},
     {"evalStk",		ASSEM_1BYTE,	INST_EVAL_STK,		1,	1},
+    {"exch",		ASSEM_1BYTE,	INST_EXCH,		2,	2},
     {"exist",		ASSEM_LVT,	INST_EXIST_SCALAR,	0,	1},
     {"existArray",	ASSEM_LVT,	INST_EXIST_ARRAY,	1,	1},
     {"existArrayStk",	ASSEM_1BYTE,	INST_EXIST_ARRAY_STK,	2,	1},
@@ -441,6 +442,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"tclooSelf",	ASSEM_1BYTE,	INST_TCLOO_SELF,	0,	1},
     {"tryCvtToNumeric",	ASSEM_1BYTE,	INST_TRY_CVT_TO_NUMERIC,1,	1},
     {"uminus",		ASSEM_1BYTE,	INST_UMINUS,		1,	1},
+    {"under",		ASSEM_1BYTE,	INST_UNDER,		2,	3},
     {"unset",		ASSEM_BOOL_LVT,	INST_UNSET_SCALAR,	0,	0},
     {"unsetArray",	ASSEM_BOOL_LVT,	INST_UNSET_ARRAY,	1,	0},
     {"unsetArrayStk",	ASSEM_BOOL,	INST_UNSET_ARRAY_STK,	2,	0},
@@ -463,17 +465,11 @@ static const TalInstDesc TalInstructionTable[] = {
  */
 
 static const unsigned char NonThrowingByteCodes[] = {
-    INST_PUSH, INST_POP, INST_DUP,				/* 1-3 */
-    INST_JUMP,							/* 28 */
-    INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,	/* 64- */
-    INST_PUSH_RETURN_OPTIONS,					/* -67 */
-    INST_OVER,							/* 114 */
-    INST_REVERSE, INST_NOP,					/* 116-117 */
-    INST_STR_MAP, INST_STR_FIND,				/* 127-128 */
-    INST_COROUTINE_NAME,					/* 133 */
-    INST_NS_CURRENT,						/* 135 */
-    INST_INFO_LEVEL_NUM,					/* 136 */
-    INST_RESOLVE_COMMAND					/* 138 */
+    INST_PUSH, INST_POP, INST_DUP, INST_JUMP,
+    INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,
+    INST_PUSH_RETURN_OPTIONS, INST_OVER, INST_REVERSE, INST_NOP,
+    INST_STR_MAP, INST_STR_FIND, INST_COROUTINE_NAME, INST_NS_CURRENT,
+    INST_INFO_LEVEL_NUM, INST_RESOLVE_COMMAND, INST_EXCH, INST_UNDER
 };
 
 /*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index de647cf..d3e3e6a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -638,7 +638,7 @@ TclCompileCatchCmd(
     if (optsIndex != -1) {
 	OP4(	REVERSE, 3);
     } else {
-	OP4(	REVERSE, 2);
+	OP(	EXCH);
     }
 
     /*
@@ -656,7 +656,7 @@ TclCompileCatchCmd(
      */
 
     if (optsIndex != -1) {
-	OP4(	REVERSE, 2);
+	OP(	EXCH);
 	OP4(	STORE_SCALAR, optsIndex);
 	OP(	POP);
     }
@@ -669,7 +669,7 @@ TclCompileCatchCmd(
      */
 
     if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	OP4(	REVERSE, 2);
+	OP(	EXCH);
 	OP(	POP);
     }
 
@@ -1177,6 +1177,8 @@ TclCompileDictMergeCmd(
     OP4(	BEGIN_CATCH, outLoop);
     ExceptionRangeStarts(envPtr, outLoop);
     for (i=2 ; i<parsePtr->numWords ; i++) {
+	int endloop, loop;
+
 	/*
 	 * Get the dictionary, and merge its pairs into the first dict (using
 	 * a small loop).
@@ -1185,13 +1187,15 @@ TclCompileDictMergeCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	PUSH_SUBST_WORD(tokenPtr, i);
 	OP4(	DICT_FIRST, infoIndex);
-	OP4(	JUMP_TRUE, 30);
-	OP4(	REVERSE, 2);
+	JUMP(endloop, JUMP_TRUE);
+	LABEL(loop);
+	OP(	EXCH);
 	OP44(	DICT_SET, 1, workerIndex);
 	TclAdjustStackDepth(-1, envPtr);
 	OP(	POP);
 	OP4(	DICT_NEXT, infoIndex);
-	OP4(	JUMP_FALSE, -20);
+	BACKJUMP(loop, JUMP_FALSE);
+	FIXJUMP(endloop);
 	OP(	POP);
 	OP(	POP);
 	OP14(	UNSET_SCALAR, 0, infoIndex);
@@ -1405,7 +1409,7 @@ CompileDictEachCmd(
     BODY(	bodyTokenPtr, 3);
     if (collect == TCL_EACH_COLLECT) {
 	OP4(	LOAD_SCALAR, keyVarIndex);
-	OP4(	OVER, 1);
+	OP(	UNDER);
 	OP44(	DICT_SET, 1, collectVar);
 	TclAdjustStackDepth(-1, envPtr);
 	OP(	POP);
@@ -1622,7 +1626,7 @@ TclCompileDictUpdateCmd(
      */
 
     OP(		END_CATCH);
-    OP4(	REVERSE, 2);
+    OP(		EXCH);
     OP44(	DICT_UPDATE_END, dictIndex, infoIndex);
 
     /*
@@ -1850,7 +1854,7 @@ TclCompileDictWithCmd(
 		}
 		OP4(	LIST, parsePtr->numWords-3);
 		OP4(	LOAD_SCALAR, dictVar);
-		OP4(	OVER, 1);
+		OP(	UNDER);
 		OP(	DICT_EXPAND);
 		OP4(	DICT_RECOMBINE_IMM, dictVar);
 		PUSH(	"");
@@ -1878,9 +1882,9 @@ TclCompileDictWithCmd(
 		    tokenPtr = TokenAfter(tokenPtr);
 		}
 		OP4(	LIST, parsePtr->numWords-3);
-		OP4(	OVER, 1);
+		OP(	UNDER);
 		OP(	LOAD_STK);
-		OP4(	OVER, 1);
+		OP(	UNDER);
 		OP(	DICT_EXPAND);
 		OP(	DICT_RECOMBINE_STK);
 		PUSH(	"");
@@ -1895,7 +1899,7 @@ TclCompileDictWithCmd(
 		PUSH(	"");
 		OP(	DICT_EXPAND);
 		PUSH(	"");
-		OP4(	REVERSE, 2);
+		OP(	EXCH);
 		OP(	DICT_RECOMBINE_STK);
 		PUSH(	"");
 	    }
@@ -3985,7 +3989,7 @@ TclCompileLassignCmd(
 	 */
 
 	if (!simpleVarName) {
-	    OP4(	OVER, 1);
+	    OP(		UNDER);
 	    OP4(	LIST_INDEX_IMM, idx);
 	    OP(		STORE_STK);
 	    OP(		POP);
@@ -3996,14 +4000,14 @@ TclCompileLassignCmd(
 		OP4(	STORE_SCALAR, localIndex);
 		OP(	POP);
 	    } else {
-		OP4(	OVER, 1);
+		OP(	UNDER);
 		OP4(	LIST_INDEX_IMM, idx);
 		OP(	STORE_SCALAR_STK);
 		OP(	POP);
 	    }
 	} else {
 	    if (localIndex >= 0) {
-		OP4(	OVER, 1);
+		OP(	UNDER);
 		OP4(	LIST_INDEX_IMM, idx);
 		OP4(	STORE_ARRAY, localIndex);
 		OP(	POP);
@@ -4775,7 +4779,7 @@ TclCompileNamespaceQualifiersCmd(
     PUSH(	"1");
     OP(		SUB);
     OP4(	OVER, 2);
-    OP4(	OVER, 1);
+    OP(		UNDER);
     OP(		STR_INDEX);
     PUSH(	":");
     OP(		STR_EQ);
@@ -4807,7 +4811,7 @@ TclCompileNamespaceTailCmd(
 
     PUSH_SUBST_WORD(tokenPtr, 1);
     PUSH(	"::");
-    OP4(	OVER, 1);
+    OP(		UNDER);
     OP(		STR_FIND_LAST);
     OP(		DUP);
     PUSH(	"0");
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index e76d8d6..87c51fa 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -860,7 +860,7 @@ TclSubstCompile(
 	 * Pull the result to top of stack, discard options dict.
 	 */
 
-	OP4(			REVERSE, 2);
+	OP(			EXCH);
 	OP(			POP);
 
 	/*
@@ -1333,7 +1333,7 @@ IssueSwitchChainedTests(
 		break;
 	    case Switch_Glob:
 		TclCompileTokens(interp, bodyToken[i], 1,	envPtr);
-		OP4(	OVER, 1);
+		OP(	UNDER);
 		OP1(	STR_MATCH, noCase);
 		break;
 	    case Switch_Regexp:
@@ -1373,7 +1373,6 @@ IssueSwitchChainedTests(
 		    TclCompileTokens(interp, bodyToken[i], 1, envPtr);
 		}
 
-		OP4(	OVER, 1);
 		if (!simple) {
 		    /*
 		     * Pass correct RE compile flags. We use only Int1
@@ -1385,10 +1384,12 @@ IssueSwitchChainedTests(
 		    int cflags = TCL_REG_ADVANCED
 			    | (noCase ? TCL_REG_NOCASE : 0);
 
+		    OP(	UNDER);
 		    OP1(REGEXP, cflags);
 		} else if (exact && !noCase) {
 		    OP(	STR_EQ);
 		} else {
+		    OP(	UNDER);
 		    OP1(STR_MATCH, noCase);
 		}
 		break;
@@ -2230,7 +2231,7 @@ IssueTryInstructions(
     BODY(				bodyToken, 1);
     ExceptionRangeEnds(envPtr, range);
     PUSH(				"0");
-    OP4(				REVERSE, 2);
+    OP(					EXCH);
     OP4(				JUMP, 7);
     ExceptionRangeTarget(envPtr, range, catchOffset);
     OP(					PUSH_RETURN_CODE);
@@ -2383,7 +2384,7 @@ IssueTryFinallyInstructions(
     BODY(				bodyToken, 1);
     ExceptionRangeEnds(envPtr, range);
     PUSH(				"0");
-    OP4(				REVERSE, 2);
+    OP(					EXCH);
     OP4(				JUMP, 7);
     ExceptionRangeTarget(envPtr, range, catchOffset);
     OP(					PUSH_RETURN_CODE);
@@ -2501,7 +2502,7 @@ IssueTryFinallyInstructions(
 	    BODY(			handlerTokens[i], 5+i*4);
 	    ExceptionRangeEnds(envPtr, range);
 	    OP(				PUSH_RETURN_OPTIONS);
-	    OP4(			REVERSE, 2);
+	    OP(				EXCH);
 	    OP4(			JUMP, 7);
 	    forwardsToFix[i] = -1;
 
@@ -3394,7 +3395,7 @@ TclCompileMinusOpCmd(
 
     OP4(	REVERSE, words-1);
     while (--words > 1) {
-	OP4(	REVERSE, 2);
+	OP(	EXCH);
 	OP(	SUB);
     }
     return TCL_OK;
@@ -3438,7 +3439,7 @@ TclCompileDivOpCmd(
 
     OP4(	REVERSE, words-1);
     while (--words > 1) {
-	OP4(	REVERSE, 2);
+	OP(	EXCH);
 	OP(	DIV);
     }
     return TCL_OK;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 960a3e1..3bc2afa 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -492,6 +492,13 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Forces the variable indexed by opnd to be an array. Does not touch
 	 * the stack. */
 
+    {"exch",		1,	0,	  0,	{OPERAND_NONE}},
+	/* Swap the two items on the top of the stack.
+	 * Stack:  ... a b => ... b a */
+    {"under",		1,	+1,	  0,	{OPERAND_NONE}},
+	/* Duplicates the item under the top of the stack.
+	 * Stack:  ... a b => ... a b a */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 15942af..daa866f 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -665,8 +665,11 @@ typedef struct ByteCode {
 #define INST_ARRAY_MAKE_STK		143
 #define INST_ARRAY_MAKE_IMM		144
 
+#define INST_EXCH			145
+#define INST_UNDER			146
+
 /* The last opcode */
-#define LAST_INST_OPCODE		144
+#define LAST_INST_OPCODE		146
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7646229..3e6e094 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2486,17 +2486,32 @@ ExecuteByteCode(
 	objResultPtr = OBJ_AT_TOS;
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
-
+    case INST_UNDER:
+	objResultPtr = OBJ_UNDER_TOS;
+	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
     case INST_OVER:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	objResultPtr = OBJ_AT_DEPTH(opnd);
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
 
-    case INST_REVERSE: {
+    {
 	Tcl_Obj **a, **b;
 
+    case INST_EXCH:
+	TRACE(("\"%.20s\" \"%.20s\" => ",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+	tmpPtr = OBJ_AT_TOS;
+	OBJ_AT_TOS = OBJ_UNDER_TOS;
+	OBJ_UNDER_TOS = tmpPtr;
+	TRACE_APPEND(("\"%.20s\" \"%.20s\"",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
+	NEXT_INST_F(1, 0, 0);
+
+    case INST_REVERSE:
 	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u\n", opnd));
 	a = tosPtr-(opnd-1);
 	b = tosPtr;
 	while (a<b) {
@@ -4315,7 +4330,7 @@ ExecuteByteCode(
 		 * list type.
 		 */
 
-		List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;
+		List *listPtr = ListRepPtr(valuePtr);
 
 		if (listPtr->refCount == 1) {
 		    TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),