Working on the optimizer.

2 files changed, 223 insertions, 82 deletions

diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index fdb281b..908dceb 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -122,9 +122,9 @@ typedef struct ExceptionAux {
 				 * problem. */
     int expandTargetDepth;	/* The stack depth expected at the outermost
 				 * expansion within the loop. Not meaningful
-				 * if there have are no open expansions
-				 * between the looping level and the point of
-				 * jump issue. */
+				 * if there are no open expansions between the
+				 * looping level and the point of jump
+				 * issue. */
     int numBreakTargets;	/* The number of [break]s that want to be
 				 * targeted to the place where this loop
 				 * exception will be bound to. */
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 18dc208..7d4226e 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -13,18 +13,48 @@
 #include "tclCompile.h"
 #include <assert.h>
 
+/*
+ * Forward declarations.
+ */
+
+static void		AdvanceJumps(CompileEnv *envPtr);
+static void		ConvertZeroEffectToNOP(CompileEnv *envPtr);
+static void		LocateTargetAddresses(CompileEnv *envPtr,
+			    Tcl_HashTable *tablePtr);
+static void		TrimUnreachable(CompileEnv *envPtr);
+
+/*
+ * Helper macros.
+ */
+
 #define DefineTargetAddress(tablePtr, address) \
     ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew))
 #define IsTargetAddress(tablePtr, address) \
     (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL)
+#define AddrLength(address) \
+    (tclInstructionTable[*(unsigned char *)(address)].numBytes)
+#define InstLength(instruction) \
+    (tclInstructionTable[(unsigned char)(instruction)].numBytes)
 
+/*
+ * ----------------------------------------------------------------------
+ *
+ * LocateTargetAddresses --
+ *
+ *	Populate a hash table with places that we need to be careful around
+ *	because they're the targets of various kinds of jumps and other
+ *	non-local behavior.
+ *
+ * ----------------------------------------------------------------------
+ */
+
 static void
 LocateTargetAddresses(
     CompileEnv *envPtr,
     Tcl_HashTable *tablePtr)
 {
-    unsigned char *pc, *target;
-    int size, isNew, i;
+    unsigned char *currentInstPtr, *targetInstPtr;
+    int isNew, i;
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch hSearch;
 
@@ -44,36 +74,39 @@ LocateTargetAddresses(
      * because they are the targets of various types of jumps.
      */
 
-    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
-	size = tclInstructionTable[*pc].numBytes;
-	switch (*pc) {
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext ;
+	    currentInstPtr += AddrLength(currentInstPtr)) {
+	switch (*currentInstPtr) {
 	case INST_JUMP1:
 	case INST_JUMP_TRUE1:
 	case INST_JUMP_FALSE1:
-	    target = pc + TclGetInt1AtPtr(pc+1);
+	    targetInstPtr = currentInstPtr+TclGetInt1AtPtr(currentInstPtr+1);
 	    goto storeTarget;
 	case INST_JUMP4:
 	case INST_JUMP_TRUE4:
 	case INST_JUMP_FALSE4:
-	    target = pc + TclGetInt4AtPtr(pc+1);
+	    targetInstPtr = currentInstPtr+TclGetInt4AtPtr(currentInstPtr+1);
 	    goto storeTarget;
 	case INST_BEGIN_CATCH4:
-	    target = envPtr->codeStart + envPtr->exceptArrayPtr[
-		    TclGetUInt4AtPtr(pc+1)].codeOffset;
+	    targetInstPtr = envPtr->codeStart + envPtr->exceptArrayPtr[
+		    TclGetUInt4AtPtr(currentInstPtr+1)].codeOffset;
 	storeTarget:
-	    DefineTargetAddress(tablePtr, target);
+	    DefineTargetAddress(tablePtr, targetInstPtr);
 	    break;
 	case INST_JUMP_TABLE:
 	    hPtr = Tcl_FirstHashEntry(
-		    &JUMPTABLEINFO(envPtr, pc+1)->hashTable, &hSearch);
+		    &JUMPTABLEINFO(envPtr, currentInstPtr+1)->hashTable,
+		    &hSearch);
 	    for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) {
-		target = pc + PTR2INT(Tcl_GetHashValue(hPtr));
-		DefineTargetAddress(tablePtr, target);
+		targetInstPtr = currentInstPtr +
+			PTR2INT(Tcl_GetHashValue(hPtr));
+		DefineTargetAddress(tablePtr, targetInstPtr);
 	    }
 	    break;
 	case INST_RETURN_CODE_BRANCH:
 	    for (i=TCL_ERROR ; i<TCL_CONTINUE+1 ; i++) {
-		DefineTargetAddress(tablePtr, pc + 2*i - 1);
+		DefineTargetAddress(tablePtr, currentInstPtr + 2*i - 1);
 	    }
 	    break;
 	case INST_START_CMD:
@@ -86,7 +119,7 @@ LocateTargetAddresses(
      * one past the end!
      */
 
-    DefineTargetAddress(tablePtr, pc);
+    DefineTargetAddress(tablePtr, currentInstPtr);
 
     /*
      * Enter in the targets of exception ranges.
@@ -96,14 +129,14 @@ LocateTargetAddresses(
 	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
 
 	if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
-	    target = envPtr->codeStart + rangePtr->catchOffset;
-	    DefineTargetAddress(tablePtr, target);
+	    targetInstPtr = envPtr->codeStart + rangePtr->catchOffset;
+	    DefineTargetAddress(tablePtr, targetInstPtr);
 	} else {
-	    target = envPtr->codeStart + rangePtr->breakOffset;
-	    DefineTargetAddress(tablePtr, target);
+	    targetInstPtr = envPtr->codeStart + rangePtr->breakOffset;
+	    DefineTargetAddress(tablePtr, targetInstPtr);
 	    if (rangePtr->continueOffset >= 0) {
-		target = envPtr->codeStart + rangePtr->continueOffset;
-		DefineTargetAddress(tablePtr, target);
+		targetInstPtr = envPtr->codeStart + rangePtr->continueOffset;
+		DefineTargetAddress(tablePtr, targetInstPtr);
 	    }
 	}
     }
@@ -112,96 +145,139 @@ LocateTargetAddresses(
 /*
  * ----------------------------------------------------------------------
  *
- * TclOptimizeBytecode --
+ * TrimUnreachable --
  *
- *	A very simple peephole optimizer for bytecode.
+ *	Converts code that provably can't be executed into NOPs and reduces
+ *	the overall reported length of the bytecode where that is possible.
  *
  * ----------------------------------------------------------------------
  */
 
-void
-TclOptimizeBytecode(
+static void
+TrimUnreachable(
     CompileEnv *envPtr)
 {
-    unsigned char *pc;
-    int size;
+    unsigned char *currentInstPtr;
     Tcl_HashTable targets;
 
-    /*
-     * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also replace
-     * PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an operation
-     * that guarantees the check for arithmeticity) and eliminate LNOT when we
-     * can invert the following JUMP condition.
-     */
+    LocateTargetAddresses(envPtr, &targets);
+
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext-1 ;
+	    currentInstPtr += AddrLength(currentInstPtr)) {
+	int clear = 0;
+
+	if (*currentInstPtr != INST_DONE) {
+	    continue;
+	}
+
+	while (!IsTargetAddress(&targets, currentInstPtr + 1 + clear)) {
+	    clear += AddrLength(currentInstPtr + 1 + clear);
+	}
+	if (currentInstPtr + 1 + clear == envPtr->codeNext) {
+	    envPtr->codeNext -= clear;
+	} else {
+	    while (clear --> 0) {
+		*(currentInstPtr + 1 + clear) = INST_NOP;
+	    }
+	}
+    }
+
+    Tcl_DeleteHashTable(&targets);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ConvertZeroEffectToNOP --
+ *
+ *	Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also
+ *	replace PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an
+ *	operation that guarantees the check for arithmeticity) and eliminate
+ *	LNOT when we can invert the following JUMP condition.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ConvertZeroEffectToNOP(
+    CompileEnv *envPtr)
+{
+    unsigned char *currentInstPtr;
+    int size;
+    Tcl_HashTable targets;
 
     LocateTargetAddresses(envPtr, &targets);
-    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
-	int blank = 0, i, inst;
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext ; currentInstPtr += size) {
+	int blank = 0, i, nextInst;
 
-	size = tclInstructionTable[*pc].numBytes;
-	while (*(pc+size) == INST_NOP) {
-	    if (IsTargetAddress(&targets, pc + size)) {
+	size = AddrLength(currentInstPtr);
+	while (*(currentInstPtr+size) == INST_NOP) {
+	    if (IsTargetAddress(&targets, currentInstPtr + size)) {
 		break;
 	    }
-	    size += tclInstructionTable[INST_NOP].numBytes;
+	    size += InstLength(INST_NOP);
 	}
-	if (IsTargetAddress(&targets, pc + size)) {
+	if (IsTargetAddress(&targets, currentInstPtr + size)) {
 	    continue;
 	}
-	inst = *(pc + size);
-	switch (*pc) {
+	nextInst = *(currentInstPtr + size);
+	switch (*currentInstPtr) {
 	case INST_PUSH1:
-	    if (inst == INST_POP) {
-		blank = size + tclInstructionTable[inst].numBytes;
-	    } else if (inst == INST_CONCAT1
-		    && TclGetUInt1AtPtr(pc + size + 1) == 2) {
+	    if (nextInst == INST_POP) {
+		blank = size + InstLength(nextInst);
+	    } else if (nextInst == INST_CONCAT1
+		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
 		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
-			TclGetUInt1AtPtr(pc + 1));
+			TclGetUInt1AtPtr(currentInstPtr + 1));
 		int numBytes;
 
 		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
 		if (numBytes == 0) {
-		    blank = size + tclInstructionTable[inst].numBytes;
+		    blank = size + InstLength(nextInst);
 		}
 	    }
 	    break;
 	case INST_PUSH4:
-	    if (inst == INST_POP) {
+	    if (nextInst == INST_POP) {
 		blank = size + 1;
-	    } else if (inst == INST_CONCAT1
-		    && TclGetUInt1AtPtr(pc + size + 1) == 2) {
+	    } else if (nextInst == INST_CONCAT1
+		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
 		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
-			TclGetUInt4AtPtr(pc + 1));
+			TclGetUInt4AtPtr(currentInstPtr + 1));
 		int numBytes;
 
 		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
 		if (numBytes == 0) {
-		    blank = size + tclInstructionTable[inst].numBytes;
+		    blank = size + InstLength(nextInst);
 		}
 	    }
 	    break;
+
 	case INST_LNOT:
-	    switch (inst) {
+	    switch (nextInst) {
 	    case INST_JUMP_TRUE1:
 		blank = size;
-		*(pc + size) = INST_JUMP_FALSE1;
+		*(currentInstPtr + size) = INST_JUMP_FALSE1;
 		break;
 	    case INST_JUMP_FALSE1:
 		blank = size;
-		*(pc + size) = INST_JUMP_TRUE1;
+		*(currentInstPtr + size) = INST_JUMP_TRUE1;
 		break;
 	    case INST_JUMP_TRUE4:
 		blank = size;
-		*(pc + size) = INST_JUMP_FALSE4;
+		*(currentInstPtr + size) = INST_JUMP_FALSE4;
 		break;
 	    case INST_JUMP_FALSE4:
 		blank = size;
-		*(pc + size) = INST_JUMP_TRUE4;
+		*(currentInstPtr + size) = INST_JUMP_TRUE4;
 		break;
 	    }
 	    break;
+
 	case INST_TRY_CVT_TO_NUMERIC:
-	    switch (inst) {
+	    switch (nextInst) {
 	    case INST_JUMP_TRUE1:
 	    case INST_JUMP_TRUE4:
 	    case INST_JUMP_FALSE1:
@@ -240,41 +316,106 @@ TclOptimizeBytecode(
 	    }
 	    break;
 	}
+
 	if (blank > 0) {
 	    for (i=0 ; i<blank ; i++) {
-		*(pc + i) = INST_NOP;
+		*(currentInstPtr + i) = INST_NOP;
 	    }
 	    size = blank;
 	}
     }
     Tcl_DeleteHashTable(&targets);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AdvanceJumps --
+ *
+ *	Advance jumps past NOPs and chained JUMPs. After this runs, the only
+ *	JUMPs that jump to a NOP or a JUMP will be length-1 ones that run out
+ *	of room in their opcode to be targeted to where they really belong.
+ *
+ * ----------------------------------------------------------------------
+ */
 
-    /*
-     * Trim unreachable instructions after a DONE.
-     */
+static void
+AdvanceJumps(
+    CompileEnv *envPtr)
+{
+    unsigned char *currentInstPtr;
 
-    LocateTargetAddresses(envPtr, &targets);
-    for (pc = envPtr->codeStart ; pc < envPtr->codeNext-1 ; pc += size) {
-	int clear = 0;
+    for (currentInstPtr = envPtr->codeStart ;
+	    currentInstPtr < envPtr->codeNext-1 ;
+	    currentInstPtr += AddrLength(currentInstPtr)) {
+	int offset, delta;
 
-	size = tclInstructionTable[*pc].numBytes;
-	if (*pc != INST_DONE) {
+	switch (*currentInstPtr) {
+	case INST_JUMP1:
+	case INST_JUMP_TRUE1:
+	case INST_JUMP_FALSE1:
+	    offset = TclGetInt1AtPtr(currentInstPtr + 1);
+	    for (delta=0 ; offset+delta != 0 ;) {
+		if (offset + delta < -128 || offset + delta > 127) {
+		    break;
+		}
+		offset += delta;
+		switch (*(currentInstPtr + offset)) {
+		case INST_NOP:
+		    delta = InstLength(INST_NOP);
+		    continue;
+		case INST_JUMP1:
+		    delta = TclGetInt1AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		case INST_JUMP4:
+		    delta = TclGetInt4AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		}
+		break;
+	    }
+	    TclStoreInt1AtPtr(offset, currentInstPtr + 1);
 	    continue;
-	}
-	assert (size == 1);
-	while (!IsTargetAddress(&targets, pc + 1 + clear)) {
-	    clear += tclInstructionTable[*(pc + 1 + clear)].numBytes;
-	}
-	if (pc + 1 + clear == envPtr->codeNext) {
-	    envPtr->codeNext -= clear;
-	} else {
-	    while (clear --> 0) {
-		*(pc + 1 + clear) = INST_NOP;
+
+	case INST_JUMP4:
+	case INST_JUMP_TRUE4:
+	case INST_JUMP_FALSE4:
+	    for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) {
+		switch (*(currentInstPtr + offset)) {
+		case INST_NOP:
+		    offset += InstLength(INST_NOP);
+		    continue;
+		case INST_JUMP1:
+		    offset += TclGetInt1AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		case INST_JUMP4:
+		    offset += TclGetInt4AtPtr(currentInstPtr + offset + 1);
+		    continue;
+		}
+		break;
 	    }
+	    TclStoreInt4AtPtr(offset, currentInstPtr + 1);
+	    continue;
 	}
     }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOptimizeBytecode --
+ *
+ *	A very simple peephole optimizer for bytecode.
+ *
+ * ----------------------------------------------------------------------
+ */
 
-    Tcl_DeleteHashTable(&targets);
+void
+TclOptimizeBytecode(
+    CompileEnv *envPtr)
+{
+    ConvertZeroEffectToNOP(envPtr);
+    AdvanceJumps(envPtr);
+    TrimUnreachable(envPtr);
 }
 
 /*