diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCompCmds.c | 238 | ||||
| -rw-r--r-- | generic/tclCompile.c | 18 | ||||
| -rw-r--r-- | generic/tclCompile.h | 26 | ||||
| -rw-r--r-- | generic/tclExecute.c | 58 |
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. |