New TEBC opcode, INST_JUMP_TABLE, for compiling the simple (and common) case of

[switch] into a jump-table. Much faster for long switches.
Also compiler support for generating the new instruction where appropriate.

4 files changed, 314 insertions, 26 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index de87da3..2c63d5b 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.81 2005/11/02 14:51:04 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.82 2005/11/30 14:59:40 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -116,6 +116,8 @@
 
 static ClientData	DupForeachInfo(ClientData clientData);
 static void		FreeForeachInfo(ClientData clientData);
+static ClientData	DupJumptableInfo(ClientData clientData);
+static void		FreeJumptableInfo(ClientData clientData);
 static int		PushVarName(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
 			    int flags, int *localIndexPtr,
@@ -137,6 +139,12 @@ AuxDataType tclForeachInfoType = {
     DupForeachInfo,		/* dupProc */
     FreeForeachInfo		/* freeProc */
 };
+
+AuxDataType tclJumptableInfoType = {
+    "JumptableInfo",		/* name */
+    DupJumptableInfo,		/* dupProc */
+    FreeJumptableInfo		/* freeProc */
+};
 
 /*
  *----------------------------------------------------------------------
@@ -3282,6 +3290,7 @@ TclCompileSwitchCmd(
     int savedStackDepth = envPtr->currStackDepth;
     int noCase;			/* Has the -nocase flag been given? */
     int foundMode = 0;		/* Have we seen a mode flag yet? */
+    int isListedArms = 0;
     int i;
 
     /*
@@ -3321,6 +3330,7 @@ TclCompileSwitchCmd(
 	 * at time of writing). Note that -exact and -glob may only be given
 	 * at most once or we bail out (error case).
 	 */
+
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) {
 	    return TCL_ERROR;
 	}
@@ -3420,6 +3430,7 @@ TclCompileSwitchCmd(
 	    return TCL_ERROR;
 	}
 
+	isListedArms = 1;
 	bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords);
 	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
 
@@ -3540,6 +3551,181 @@ TclCompileSwitchCmd(
     CompileTokens(envPtr, valueTokenPtr, interp);
 
     /*
+     * Check if we can generate a jump table, since if so that's faster than
+     * doing an explicit compare with each body. Note that we're definitely
+     * over-conservative with determining whether we can do the jump table,
+     * but it handles the most common case well enough.
+     */
+
+    if (isListedArms && mode == Switch_Exact && !noCase) {
+	JumptableInfo *jtPtr;
+	int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
+	int mustGenerate, jumpToDefault;
+	Tcl_DString buffer;
+	Tcl_HashEntry *hPtr;
+
+	/*
+	 * Compile the switch by using a jump table, which is basically a
+	 * hashtable that maps from literal values to match against to the
+	 * offset (relative to the INST_JUMP_TABLE instruction) to jump to.
+	 * The jump table itself is independent of any invokation of the
+	 * bytecode, and as such is stored in an auxData block.
+	 *
+	 * Start by allocating the jump table itself, plus some workspace.
+	 */
+
+	jtPtr = (JumptableInfo *) ckalloc(sizeof(JumptableInfo));
+	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
+	infoIndex = TclCreateAuxData((ClientData) jtPtr,
+		&tclJumptableInfoType, envPtr);
+	finalFixups = (int *) ckalloc(sizeof(int) * (numWords/2));
+	foundDefault = 0;
+	mustGenerate = 1;
+
+	/*
+	 * Next, issue the instruction to do the jump, together with what we
+	 * want to do if things do not work out (jump to either the default
+	 * clause or the "default" default, which just sets the result to
+	 * empty). Note that we will come back and rewrite the jump's offset
+	 * parameter when we know what it should be, and that all jumps we
+	 * issue are of the wide kind because that makes the code much easier
+	 * to debug!
+	 */
+
+	jumpLocation = CurrentOffset(envPtr);
+	TclEmitInstInt4(INST_JUMP_TABLE, infoIndex, envPtr);
+	jumpToDefault = CurrentOffset(envPtr);
+	TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+
+	for (i=0 ; i<numWords ; i+=2) {
+	    /*
+	     * For each arm, we must first work out what to do with the match
+	     * term.
+	     */
+
+	    if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
+		    memcmp(bodyToken[numWords-2]->start, "default", 7)) {
+		/*
+		 * This is not a default clause, so insert the current
+		 * location as a target in the jump table (assuming it isn't
+		 * already there, which would indicate that this clause is
+		 * probably masked by an earlier one). Note that we use a
+		 * Tcl_DString here simply because the hash API does not let
+		 * us specify the string length.
+		 */
+
+		Tcl_DStringInit(&buffer);
+		Tcl_DStringAppend(&buffer, bodyToken[i]->start,
+			bodyToken[i]->size);
+		hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
+			Tcl_DStringValue(&buffer), &isNew);
+		if (isNew) {
+		    /*
+		     * First time we've encountered this match clause, so it
+		     * must point to here.
+		     */
+
+		    Tcl_SetHashValue(hPtr, (ClientData)
+			    (CurrentOffset(envPtr) - jumpLocation));
+		}
+		Tcl_DStringFree(&buffer);
+	    } else {
+		/*
+		 * This is a default clause, so patch up the fallthrough from
+		 * the INST_JUMP_TABLE instruction to here.
+		 */
+
+		foundDefault = 1;
+		isNew = 1;
+		TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
+			envPtr->codeStart+jumpToDefault+1);
+	    }
+
+	    /*
+	     * Now, for each arm we must deal with the body of the clause.
+	     *
+	     * If this is a continuation body (never true of a final clause,
+	     * whether default or not) we're done because the next jump target
+	     * will also point here, so we advance to the next clause.
+	     */
+
+	    if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') {
+		mustGenerate = 1;
+		continue;
+	    }
+
+	    /*
+	     * Also skip this arm if its only match clause is masked. (We
+	     * could probably be more aggressive about this, but that would be
+	     * much more difficult to get right.)
+	     */
+
+	    if (!isNew && !mustGenerate) {
+		continue;
+	    }
+	    mustGenerate = 0;
+
+	    /*
+	     * Compile the body of the arm.
+	     */
+
+	    TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
+
+	    /*
+	     * Compile a jump in to the end of the command if this body is
+	     * anything other than a user-supplied default arm (to either skip
+	     * over the remaining bodies or the code that generates an empty
+	     * result).
+	     */
+
+	    if (i+2 < numWords || !foundDefault) {
+		finalFixups[numRealBodies++] = CurrentOffset(envPtr);
+
+		/*
+		 * Easier by far to issue this jump as a fixed-width jump.
+		 * Otherwise we'd need to do a lot more (and more awkward)
+		 * rewriting when we fixed this all up.
+		 */
+
+		TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+	    }
+	}
+
+	/*
+	 * We're at the end. If we've not already done so through the
+	 * processing of a user-supplied default clause, add in a "default"
+	 * default clause now.
+	 */
+
+	if (!foundDefault) {
+	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
+		    envPtr->codeStart+jumpToDefault+1);
+	    PushLiteral(envPtr, "", 0);
+	}
+
+	/*
+	 * No more instructions to be issued; everything that needs to jump to
+	 * the end of the command is fixed up at this point.
+	 */
+
+	for (i=0 ; i<numRealBodies ; i++) {
+	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i],
+		    envPtr->codeStart+finalFixups[i]+1);
+	}
+
+	/*
+	 * Clean up all our temporary space and return.
+	 */
+
+	ckfree((char *) finalFixups);
+	ckfree((char *) bodyToken);
+	if (bodyTokenArray != NULL) {
+	    ckfree((char *) bodyTokenArray);
+	}
+	return TCL_OK;
+    }
+
+    /*
      * Generate a test for each arm.
      */
 
@@ -3697,6 +3883,56 @@ TclCompileSwitchCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * DupJumptableInfo, FreeJumptableInfo --
+ *
+ *	Functions to duplicate and release a jump-table created for use with
+ *	the INST_JUMP_TABLE instruction.
+ *
+ * Results:
+ *	DupJumptableInfo: a copy of the jump-table
+ *	FreeJumptableInfo: none
+ *
+ * Side effects:
+ *	DupJumptableInfo: allocates memory
+ *	FreeJumptableInfo: releases memory
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+DupJumptableInfo(
+    ClientData clientData)
+{
+    JumptableInfo *jtPtr = (JumptableInfo *) clientData;
+    JumptableInfo *newJtPtr = (JumptableInfo *)
+	    ckalloc(sizeof(JumptableInfo));
+    Tcl_HashEntry *hPtr, *newHPtr;
+    Tcl_HashSearch search;
+    int isNew;
+
+    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
+    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
+    while (hPtr != NULL) {
+	newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
+		Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
+	Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
+    }
+    return (ClientData) newJtPtr;
+}
+
+static void
+FreeJumptableInfo(
+    ClientData clientData)
+{
+    JumptableInfo *jtPtr = (JumptableInfo *) clientData;
+
+    Tcl_DeleteHashTable(&jtPtr->hashTable);
+    ckfree((char *) jtPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileVariableCmd --
  *
  *	Procedure called to reserve the local variables for the "variable"
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d58e18f..659a611 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.92 2005/11/07 15:23:56 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.93 2005/11/30 14:59:40 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -362,6 +362,13 @@ InstructionDesc tclInstructionTable[] = {
 	 * dictionary in the variable referred to by the immediate argument.
 	 * Stack:  ... keyList LVTindexList => ...
 	 * Same notes as in "dictUpdateStart" apply here. */
+    {"jumpTable",	  5,	-1,	   1,	{OPERAND_UINT4}},
+	/* Jump according to the jump-table (in AuxData as indicated by the
+	 * operand) and the argument popped from the list. Always executes the
+	 * next instruction if no match against the table's entries was found.
+	 * Stack:  ... value => ...
+	 * Note that the jump table contains offsets relative to the PC when
+	 * it points to this instruction; the code is relocatable. */
     {0}
 };
 
@@ -2500,7 +2507,7 @@ TclFixupForwardJump(
  */
 
 void * /* == InstructionDesc* == */
-TclGetInstructionTable()
+TclGetInstructionTable(void)
 {
     return &tclInstructionTable[0];
 }
@@ -2616,7 +2623,7 @@ TclGetAuxDataType(
  */
 
 void
-TclInitAuxDataTypeTable()
+TclInitAuxDataTypeTable(void)
 {
     /*
      * The table mutex must already be held before this routine is invoked.
@@ -2626,10 +2633,11 @@ TclInitAuxDataTypeTable()
     Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
 
     /*
-     * There is only one AuxData type at this time, so register it here.
+     * There are only two AuxData type at this time, so register them here.
      */
 
     TclRegisterAuxDataType(&tclForeachInfoType);
+    TclRegisterAuxDataType(&tclJumptableInfoType);
 }
 
 /*
@@ -2652,7 +2660,7 @@ TclInitAuxDataTypeTable()
  */
 
 void
-TclFinalizeAuxDataTypeTable()
+TclFinalizeAuxDataTypeTable(void)
 {
     Tcl_MutexLock(&tableMutex);
     if (auxDataTypeTableInitialized) {
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index af25ace..21871aa 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.60 2005/10/12 23:42:29 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.61 2005/11/30 14:59:40 dkf Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -562,8 +562,15 @@ typedef struct ByteCode {
 #define INST_DICT_UPDATE_START		119
 #define INST_DICT_UPDATE_END		120
 
+/*
+ * Instruction to support jumps defined by tables (instead of the classic
+ * [switch] technique of chained comparisons).
+ */
+
+#define INST_JUMP_TABLE			121
+
 /* The last opcode */
-#define LAST_INST_OPCODE		120
+#define LAST_INST_OPCODE		121
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -694,7 +701,20 @@ typedef struct ForeachInfo {
 				 * LAST FIELD IN THE STRUCTURE! */
 } ForeachInfo;
 
-MODULE_SCOPE AuxDataType		tclForeachInfoType;
+MODULE_SCOPE AuxDataType	tclForeachInfoType;
+
+/*
+ * Structure used to hold information about a switch command that is needed
+ * during program execution. These structures are stored in CompileEnv and
+ * ByteCode structures as auxiliary data.
+ */
+
+typedef struct JumptableInfo {
+    Tcl_HashTable hashTable;	/* Hash that maps strings to signed ints (PC
+				 * offsets). */
+} JumptableInfo;
+
+MODULE_SCOPE AuxDataType	tclJumptableInfoType;
 
 /*
  *----------------------------------------------------------------
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 38a7a6e..31870b5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.221 2005/11/27 02:33:49 das Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.222 2005/11/30 14:59:40 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2601,25 +2601,23 @@ TclExecuteByteCode(
      * ---------------------------------------------------------
      */
 
-    case INST_JUMP1:
-	{
-	    int opnd;
+    case INST_JUMP1: {
+	int opnd;
 
-	    opnd = TclGetInt1AtPtr(pc+1);
-	    TRACE(("%d => new pc %u\n", opnd,
-			  (unsigned int)(pc + opnd - codePtr->codeStart)));
-	    NEXT_INST_F(opnd, 0, 0);
-	}
+	opnd = TclGetInt1AtPtr(pc+1);
+	TRACE(("%d => new pc %u\n", opnd,
+		(unsigned int)(pc + opnd - codePtr->codeStart)));
+	NEXT_INST_F(opnd, 0, 0);
+    }
 
-    case INST_JUMP4:
-	{
-	   int opnd;
+    case INST_JUMP4: {
+	int opnd;
 
-	   opnd = TclGetInt4AtPtr(pc+1);
-	   TRACE(("%d => new pc %u\n", opnd,
-			 (unsigned int)(pc + opnd - codePtr->codeStart)));
-	   NEXT_INST_F(opnd, 0, 0);
-	}
+	opnd = TclGetInt4AtPtr(pc+1);
+	TRACE(("%d => new pc %u\n", opnd,
+		(unsigned int)(pc + opnd - codePtr->codeStart)));
+	NEXT_INST_F(opnd, 0, 0);
+    }
 
     {
 	int jmpOffset[2];
@@ -2680,6 +2678,32 @@ TclExecuteByteCode(
 	NEXT_INST_F(jmpOffset[b], 1, 0);
     }
 
+    case INST_JUMP_TABLE: {
+	Tcl_HashEntry *hPtr;
+	JumptableInfo *jtPtr;
+	int opnd;
+
+	/*
+	 * Jump to location looked up in a hashtable; fall through to next
+	 * instr if lookup fails.
+	 */
+
+	opnd = TclGetInt4AtPtr(pc+1);
+	jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
+	TRACE(("%d => %.20s ", opnd, O2S(*tosPtr)));
+	hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, Tcl_GetString(*tosPtr));
+	if (hPtr != NULL) {
+	    int jumpOffset = (int) Tcl_GetHashValue(hPtr);
+
+	    TRACE_APPEND(("found in table, new pc %u\n",
+		    (unsigned int)(pc - codePtr->codeStart + jumpOffset)));
+	    NEXT_INST_F(jumpOffset, 1, 0);
+	} else {
+	    TRACE_APPEND(("not found in table\n"));
+	    NEXT_INST_F(5, 1, 0);
+	}
+    }
+
     /*
      * These two instructions are now redundant: the complete logic of the LOR
      * and LAND is now handled by the expression compiler.