summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmds.c238
-rw-r--r--generic/tclCompile.c18
-rw-r--r--generic/tclCompile.h26
-rw-r--r--generic/tclExecute.c58
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.