diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | generic/tclAssembly.c | 416 | ||||
| -rw-r--r-- | tests/assemble.test | 139 |
3 files changed, 544 insertions, 25 deletions
@@ -1,8 +1,14 @@ +2010-10-28 Kevin B. Kenny <kennykb@acm.org> + + [dogeen-assembler-branch] + * generic/tclAssembly.c: + * tests/assembly.test (assemble-31.*): Added jump tables. + 2010-10-24 Kevin B. Kenny <kennykb@acm.org> [dogeen-assembler-branch] - * tclAssembly.c: - * assembly.test (assemble-17.15): Reworked branch handling so that + * generic/tclAssembly.c: + * tests/assembly.test (assemble-17.15): Reworked branch handling so that forward branches can use jump1 (jumpTrue1, jumpFalse1). Added test cases that the forward branches will expand to jump4, jumpTrue4, jumpFalse4 when needed. @@ -10,10 +16,10 @@ 2010-10-23 Kevin B. Kenny <kennykb@acm.org> [dogeen-assembler-branch] - * tclAssembly.h (removed): + * generic/tclAssembly.h (removed): Removed file that was included in only one source file. - * tclAssembly.c: Inlined tclAssembly.h. + * generictclAssembly.c: Inlined tclAssembly.h. 2010-10-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net> diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 490ba4b..1b12987 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.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: tclAssembly.c,v 1.1.2.16 2010/10/24 01:46:42 kennykb Exp $ + * RCS: @(#) $Id: tclAssembly.c,v 1.1.2.17 2010/10/28 19:40:12 kennykb Exp $ */ /*- @@ -25,10 +25,9 @@ *- expandStart, expandStkTop, invokeExpanded *- dictFirst, dictNext, dictDone *- dictUpdateStart, dictUpdateEnd - *- jumpTable + *- jumpTable testing *- syntax (?) *- returnCodeBranch - *- enterCatch/leaveCatch */ #include "tclInt.h" @@ -109,6 +108,8 @@ typedef struct BasicBlock { * exception ranges belonging to embedded * scripts and expressions in this block */ + JumptableInfo* jtPtr; /* Jump table at the end of this basic block */ + int flags; /* Boolean flags */ } BasicBlock; @@ -122,15 +123,16 @@ enum BasicBlockFlags { * a successor */ BB_JUMP1 = (1 << 2), /* Basic block ends with a 1-byte-offset * jump and may need expansion */ - BB_BEGINCATCH = (1 << 3), /* Block ends with a 'beginCatch' instruction, + BB_JUMPTABLE = (1 << 3), /* Basic block ends with a jump table */ + BB_BEGINCATCH = (1 << 4), /* Block ends with a 'beginCatch' instruction, * marking it as the start of a 'catch' * sequence. The 'jumpTarget' is the exception * exit from the catch block. */ - BB_DONECATCH = (1 << 4), /* Block commences with a 'doneCatch' + BB_DONECATCH = (1 << 5), /* Block commences with a 'doneCatch' * directive, indicating that the program * is finished with the body of a catch block. */ - BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction, + BB_ENDCATCH = (1 << 6), /* Block ends with an 'endCatch' instruction, * unwinding the catch from the exception * stack. */ }; @@ -166,6 +168,7 @@ typedef enum TalInstType { * consumes N, produces 1. */ ASSEM_JUMP, /* Jump instructions */ ASSEM_JUMP4, /* Jump instructions forcing a 4-byte offset */ + ASSEM_JUMPTABLE,/* Jumptable (switch -exact) */ ASSEM_LABEL, /* The assembly directive that defines a label */ ASSEM_LINDEX_MULTI, /* 4-byte operand count, must be strictly positive, @@ -250,6 +253,7 @@ static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblind, int count); static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr); static int CalculateJumpRelocations(AssemblyEnv*, int*); static int CheckForUnclosedCatches(AssemblyEnv*); +static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*); static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int); static int CheckNonNegative(Tcl_Interp*, int); static int CheckOneByte(Tcl_Interp*, int); @@ -259,8 +263,10 @@ static int CheckStrictlyPositive(Tcl_Interp*, int); static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, TalInstDesc*); static int DefineLabel(AssemblyEnv* envPtr, const char* label); +static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void DupAssembleCodeInternalRep(Tcl_Obj* src, Tcl_Obj* dest); static void FillInJumpOffsets(AssemblyEnv*); +static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_Obj* jumpTable); static int FindLocalVar(AssemblyEnv* envPtr, Tcl_Token** tokenPtrPtr); static int FinishAssembly(AssemblyEnv*); static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr); @@ -277,6 +283,8 @@ static int ProcessCatches(AssemblyEnv*); static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*, BasicBlock*, enum BasicBlockCatchState, int); static void ResetVisitedBasicBlocks(AssemblyEnv*); +static void ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*); +static void ReportUndefinedLabel(AssemblyEnv*, BasicBlock*, Tcl_Obj*); static void RestoreEmbeddedExceptionRanges(AssemblyEnv*); static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *, BasicBlock *, int); static BasicBlock* StartBasicBlock(AssemblyEnv*, int fallthrough, @@ -387,6 +395,7 @@ TalInstDesc TalInstructionTable[] = { {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0}, {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0}, {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0}, + {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0}, {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0}, {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0}, {"label", ASSEM_LABEL, 0, 0, 0}, @@ -1078,6 +1087,10 @@ FreeAssemblyEnv(AssemblyEnv* assemEnvPtr) ckfree((char*)(thisBB->foreignExceptions)); } nextBB = thisBB->successor1; + if (thisBB->jtPtr != NULL) { + DeleteMirrorJumpTable(thisBB->jtPtr); + thisBB->jtPtr = NULL; + } ckfree((char*)thisBB); } @@ -1131,6 +1144,8 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) int litIndex; /* Literal pool index of a constant */ int localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ + JumptableInfo* jtPtr; /* Pointer to a jumptable */ + int infoIndex; /* Index of the jumptable in auxdata */ int status = TCL_ERROR; /* Return value from this function */ /* Make sure that the instruction name is known at compile time. */ @@ -1358,6 +1373,30 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) break; + case ASSEM_JUMPTABLE: + if (parsePtr->numWords != 2) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "table"); + goto cleanup; + } + if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { + goto cleanup; + } + jtPtr = (JumptableInfo*) ckalloc(sizeof(JumptableInfo)); + Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); + assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; + assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart; + /*fprintf(stderr, "bb %p jumpLine %d jumpOffset %d\n", + assemEnvPtr->curr_bb, assemEnvPtr->cmdLine, + envPtr->codeNext - envPtr->codeStart); fflush(stderr); */ + infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); + /* fprintf(stderr, "auxdata index=%d\n", infoIndex); */ + BBEmitInstInt4(assemEnvPtr, tblind, infoIndex, 0); + if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) { + goto cleanup; + } + StartBasicBlock(assemEnvPtr, BB_JUMPTABLE|BB_FALLTHRU, NULL); + break; + case ASSEM_LABEL: if (parsePtr->numWords != 2) { @@ -1750,6 +1789,130 @@ MoveExceptionRangesToBasicBlock(AssemblyEnv* assemEnvPtr, /* *----------------------------------------------------------------------------- + * + * CreateMirrorJumpTable -- + * + * Makes a jump table with comparison values and assembly code labels. + * + * Results: + * Returns a standard Tcl status, with an error message in the interpreter + * on error. + * + * Side effects: + * Initializes the jump table pointer in the current basic block to + * a JumptableInfo. The keys in the JumptableInfo are the comparison + * strings. The values, instead of being jump displacements, are + * Tcl_Obj's with the code labels. + */ + +static int +CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, + /* Assembly environment */ + Tcl_Obj* jumps) + /* List of alternating keywords and labels */ +{ + int objc; /* Number of elements in the 'jumps' list */ + Tcl_Obj** objv; /* Pointers to the elements in the list */ + + CompileEnv* envPtr = assemEnvPtr->envPtr; + /* Compilation environment */ + Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; + /* Tcl interpreter */ + BasicBlock* bbPtr = assemEnvPtr->curr_bb; + /* Current basic block */ + JumptableInfo* jtPtr; + Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */ + Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */ + int isNew; /* Flag==1 if the key is not yet in the table */ + Tcl_Obj* result; /* Error message */ + int i; + + if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { + return TCL_ERROR; + } + if (objc % 2 != 0) { + if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("jump table must have an " + "even number of list " + "elements", -1)); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL); + } + return TCL_ERROR; + } + + /* Allocate the jumptable */ + + jtPtr = (JumptableInfo*) ckalloc(sizeof(JumptableInfo)); + jtHashPtr = &(jtPtr->hashTable); + Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS); + + /* Fill the keys and labels into the table */ + + /* fprintf(stderr, "jump table {\n"); */ + for (i = 0; i < objc; i+=2) { + /* fprintf(stderr, " %s -> %s\n", Tcl_GetString(objv[i]), + Tcl_GetString(objv[i+1])); fflush(stderr); */ + hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]), + &isNew); + if (!isNew) { + if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { + result = Tcl_NewStringObj("duplicate entry in jump table for " + "\"", -1); + Tcl_AppendObjToObj(result, objv[i]); + Tcl_AppendToObj(result, "\"", -1); + Tcl_SetObjResult(interp, result); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY"); + DeleteMirrorJumpTable(jtPtr); + return TCL_ERROR; + } + } + Tcl_SetHashValue(hashEntry, (ClientData) objv[i+1]); + Tcl_IncrRefCount(objv[i+1]); + } + /* fprintf(stderr, "}\n"); fflush(stderr); */ + + + /* Put the mirror jumptable in the basic block struct */ + + bbPtr->jtPtr = jtPtr; + + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * DeleteMirrorJumpTable -- + * + * Cleans up a jump table when the basic block is deleted. + * + *----------------------------------------------------------------------------- + */ + +static void +DeleteMirrorJumpTable(JumptableInfo* jtPtr) +{ + Tcl_HashTable* jtHashPtr = &jtPtr->hashTable; + /* Hash table pointer */ + Tcl_HashSearch search; /* Hash search control */ + Tcl_HashEntry* entry; /* Hash table entry containing a jump label */ + Tcl_Obj* label; /* Jump label from the hash table */ + + for (entry = Tcl_FirstHashEntry(jtHashPtr, &search); + entry != NULL; + entry = Tcl_NextHashEntry(&search)) { + label = (Tcl_Obj*) Tcl_GetHashValue(entry); + Tcl_DecrRefCount(label); + Tcl_SetHashValue(entry, NULL); + } + Tcl_DeleteHashTable(jtHashPtr); + ckfree((char*)jtPtr); +} + + +/* + *----------------------------------------------------------------------------- * * GetNextOperand -- * @@ -2349,6 +2512,7 @@ AllocBB(AssemblyEnv* assemEnvPtr) bb->foreignExceptionBase = -1; bb->foreignExceptionCount = 0; bb->foreignExceptions = NULL; + bb->jtPtr = NULL; bb->flags = 0; return bb; @@ -2457,12 +2621,9 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr, { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ - Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; - /* Tcl interpreter */ BasicBlock* bbPtr; /* Pointer to a basic block being checked */ Tcl_HashEntry* entry; /* Exit label's entry in the symbol table */ BasicBlock* jumpTarget; /* Basic block where the jump goes */ - Tcl_Obj* result; /* Error message */ int motion; /* Amount by which the code has expanded */ int offset; /* Offset in the bytecode from a jump * instruction to its target */ @@ -2493,16 +2654,8 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr, entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(bbPtr->jumpTarget)); if (entry == NULL) { - if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - result = Tcl_NewStringObj("undefined label \"", -1); - Tcl_AppendObjToObj(result, bbPtr->jumpTarget); - Tcl_AppendToObj(result, "\"", -1); - Tcl_SetObjResult(interp, result); - Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL", - Tcl_GetString(bbPtr->jumpTarget), - NULL); - Tcl_SetErrorLine(interp, bbPtr->jumpLine); - } + ReportUndefinedLabel(assemEnvPtr, bbPtr, + bbPtr->jumpTarget); return TCL_ERROR; } @@ -2526,6 +2679,18 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr, } } } + + /* + * If the basic block references a jump table, that doesn't + * affect the code locations, but resolve the labels now, and + * store basic block pointers in the jumptable hash. + */ + + if (bbPtr->flags & BB_JUMPTABLE) { + if (CheckJumpTableLabels(assemEnvPtr, bbPtr) != TCL_OK) { + return TCL_ERROR; + } + } } *mustMove += motion; } while (motion != 0); @@ -2536,6 +2701,93 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr, /* *----------------------------------------------------------------------------- * + * CheckJumpTableLabels -- + * + * Make sure that all the labels in a jump table are defined. + * + * Results: + * Returns TCL_OK if they are, TCL_ERROR if they aren't. + * + *----------------------------------------------------------------------------- + */ + +static int +CheckJumpTableLabels(AssemblyEnv* assemEnvPtr, + /* Assembly environment */ + BasicBlock* bbPtr) + /* Basic block that ends in a jump table */ +{ + Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable; + /* Hash table with the symbols */ + Tcl_HashSearch search; /* Hash table iterator */ + Tcl_HashEntry* symEntryPtr; /* Hash entry for the symbols */ + Tcl_Obj* symbolObj; /* Jump target */ + Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */ + + /* Look up every jump target in the jump hash */ + + /* fprintf(stderr, "check jump table labels %p {\n", bbPtr); */ + for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); + symEntryPtr != NULL; + symEntryPtr = Tcl_NextHashEntry(&search)) { + symbolObj = (Tcl_Obj*) Tcl_GetHashValue(symEntryPtr); + valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(symbolObj)); + /* fprintf(stderr, " %s -> %s (%d)\n", + (char*)Tcl_GetHashKey(symHash, symEntryPtr), + Tcl_GetString(symbolObj), + (valEntryPtr != NULL)); fflush(stderr); */ + if (valEntryPtr == NULL) { + ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj); + return TCL_ERROR; + } + } + /* fprintf(stderr, "}\n"); fflush(stderr); */ + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * + * ReportUndefinedLabel -- + * + * Report that a basic block refers to an undefined jump label + * + * Side effects: + * Stores an error message, error code, and line number information in + * the assembler's Tcl interpreter. + * + *----------------------------------------------------------------------------- + */ +static void +ReportUndefinedLabel(AssemblyEnv* assemEnvPtr, + /* Assembler environment */ + BasicBlock* bbPtr, + /* Basic block that contains the + * undefined label */ + Tcl_Obj* jumpTarget) + /* Label of a jump target */ +{ + CompileEnv* envPtr = assemEnvPtr->envPtr; + /* Compilation environment */ + Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; + /* Tcl interpreter */ + Tcl_Obj* result; /* Error message */ + + if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { + result = Tcl_NewStringObj("undefined label \"", -1); + Tcl_AppendObjToObj(result, jumpTarget); + Tcl_AppendToObj(result, "\"", -1); + Tcl_SetObjResult(interp, result); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL", + Tcl_GetString(jumpTarget), NULL); + Tcl_SetErrorLine(interp, bbPtr->jumpLine); + } +} + +/* + *----------------------------------------------------------------------------- + * * MoveCodeForJumps -- * * Move bytecodes in memory to accommodate JUMP1 instructions that have @@ -2571,6 +2823,9 @@ MoveCodeForJumps(AssemblyEnv* assemEnvPtr, topOffset = envPtr->codeNext - envPtr->codeStart; for (bbPtr = assemEnvPtr->curr_bb; bbPtr != NULL; bbPtr = bbPtr->prevPtr) { + /* fprintf(stderr, "move code from %d to %d\n", + bbPtr->originalStartOffset, bbPtr->startOffset); fflush(stderr); + */ memmove(envPtr->codeStart + bbPtr->startOffset, envPtr->codeStart + bbPtr->originalStartOffset, topOffset - bbPtr->originalStartOffset); @@ -2620,7 +2875,85 @@ FillInJumpOffsets(AssemblyEnv* assemEnvPtr) envPtr->codeStart + fromOffset + 1); } } + if (bbPtr->flags & BB_JUMPTABLE) { + ResolveJumpTableTargets(assemEnvPtr, bbPtr); + } } + +} + +/* + *----------------------------------------------------------------------------- + * + * ResolveJumpTableTargets -- + * + * Puts bytecode addresses for the targets of a jumptable into the + * table + * + * Results: + * Returns TCL_OK if they are, TCL_ERROR if they aren't. + * + *----------------------------------------------------------------------------- + */ + +static void +ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr, + /* Assembly environment */ + BasicBlock* bbPtr) + /* Basic block that ends in a jump table */ +{ + CompileEnv* envPtr = assemEnvPtr->envPtr;; + /* Compilation environment */ + Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable; + /* Hash table with the symbols */ + Tcl_HashSearch search; /* Hash table iterator */ + Tcl_HashEntry* symEntryPtr; /* Hash entry for the symbols */ + Tcl_Obj* symbolObj; /* Jump target */ + Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */ + int auxDataIndex; /* Index of the auxdata */ + JumptableInfo* realJumpTablePtr; + /* Jump table in the actual code */ + Tcl_HashTable* realJumpHashPtr; + /* Jump table hash in the actual code */ + Tcl_HashEntry* realJumpEntryPtr; + /* Entry in the jump table hash in + * the actual code */ + BasicBlock* jumpTargetBBPtr; + /* Basic block that the jump proceeds to */ + int junk; + + auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); + /* fprintf(stderr, "bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", + bbPtr, bbPtr->jumpOffset, auxDataIndex); */ + realJumpTablePtr = (JumptableInfo*) + envPtr->auxDataArrayPtr[auxDataIndex].clientData; + realJumpHashPtr = &(realJumpTablePtr->hashTable); + + /* Look up every jump target in the jump hash */ + + /* fprintf(stderr, "resolve jump table {\n"); fflush(stderr); */ + for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search); + symEntryPtr != NULL; + symEntryPtr = Tcl_NextHashEntry(&search)) { + symbolObj = (Tcl_Obj*) Tcl_GetHashValue(symEntryPtr); + /* fprintf(stderr, " symbol %s\n", Tcl_GetString(symbolObj)); */ + valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(symbolObj)); + jumpTargetBBPtr = (BasicBlock*) Tcl_GetHashValue(valEntryPtr); + realJumpEntryPtr = + Tcl_CreateHashEntry(realJumpHashPtr, + Tcl_GetHashKey(symHash, symEntryPtr), + &junk); + /* fprintf(stderr, " %s -> %s -> bb %p (pc %d) hash entry %p\n", + (char*)Tcl_GetHashKey(symHash, symEntryPtr), + Tcl_GetString(symbolObj), jumpTargetBBPtr, + jumpTargetBBPtr->startOffset, realJumpEntryPtr); + fflush(stderr); */ + Tcl_SetHashValue(realJumpEntryPtr, + (ClientData) (jumpTargetBBPtr->startOffset + - bbPtr->jumpOffset)); + } + /* fprintf(stderr, "}\n"); fflush(stderr); */ } /* @@ -2720,7 +3053,10 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, int stackDepth; /* Current stack depth */ int maxDepth; /* Maximum stack depth so far */ int result; /* Tcl status return */ - Tcl_HashEntry* entry; + Tcl_HashSearch jtSearch; /* Search structure for the jump table */ + Tcl_HashEntry* jtEntry; /* Hash entry in the jump table */ + Tcl_Obj* targetLabel; /* Target label from the jump table */ + Tcl_HashEntry* entry; /* Hash entry in the label table */ if (blockPtr->flags & BB_VISITED) { @@ -2789,6 +3125,23 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, stackDepth); } + + /* All blocks referenced in a jump table are successors */ + + if (blockPtr->flags & BB_JUMPTABLE) { + for (jtEntry = Tcl_FirstHashEntry(&(blockPtr->jtPtr->hashTable), + &jtSearch); + result == TCL_OK && jtEntry != NULL; + jtEntry = Tcl_NextHashEntry(&jtSearch)) { + targetLabel = (Tcl_Obj*) Tcl_GetHashValue(jtEntry); + entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(targetLabel)); + jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry); + result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, + blockPtr, stackDepth); + } + } + return result; } @@ -2985,7 +3338,10 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, * to be checked because the state of this * block has changed. */ BasicBlock* jumpTarget; /* Basic block where a jump goes */ - Tcl_HashEntry* entry; + Tcl_HashSearch jtSearch; /* Hash search control for a jumptable */ + Tcl_HashEntry* jtEntry; /* Entry in a jumptable */ + Tcl_Obj* targetLabel; /* Target label from a jumptable */ + Tcl_HashEntry* entry; /* Entry from the label table */ /* * Update the state of the current block, checking for consistency. @@ -3111,6 +3467,24 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, jumpEnclosing, jumpState, catchDepth); } + + /* All blocks referenced in a jump table are successors */ + + if (bbPtr->flags & BB_JUMPTABLE) { + for (jtEntry = Tcl_FirstHashEntry(&(bbPtr->jtPtr->hashTable), + &jtSearch); + result == TCL_OK && jtEntry != NULL; + jtEntry = Tcl_NextHashEntry(&jtSearch)) { + targetLabel = (Tcl_Obj*) Tcl_GetHashValue(jtEntry); + entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(targetLabel)); + jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry); + result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, + jumpEnclosing, jumpState, + catchDepth); + } + } + return result; } diff --git a/tests/assemble.test b/tests/assemble.test index c5898c1..7a05137 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -1,3 +1,16 @@ +# assemble.test -- +# +# Test suite for the 'tcl::unsupported::assemble' command +# +# Copyright (c) 2010 by Ozgur Dogan Ugurlu. +# Copyright (c) 2010 by Kevin B. Kenny. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: assemble.test,v 1.1.2.15 2010/10/28 19:40:13 kennykb Exp $ +#----------------------------------------------------------------------------- + # Commands covered: assemble if {[lsearch [namespace children] ::tcltest] == -1} { @@ -3021,6 +3034,8 @@ test assemble-29.7 {regexp} { -result 1 } +# assemble-30 - Catches + test assemble-30.1 {simplest possible catch} { -body { proc x {} { @@ -3096,6 +3111,91 @@ test assemble-30.3 {embedded catches} { -cleanup {rename x {}} } +# assemble-31 - Jump tables + +test assemble-31.1 {jumpTable, wrong # args} { + -body { + assemble {jumpTable} + } + -returnCodes error + -match glob + -result {wrong # args*} +} +test assemble-31.2 {jumpTable, wrong # args} { + -body { + assemble {jumpTable too many} + } + -returnCodes error + -match glob + -result {wrong # args*} +} +test assemble-31.3 {jumpTable - bad subst} { + -body { + assemble {jumpTable $foo} + } + -returnCodes error + -match glob + -result {assembly code may not contain substitutions} +} +test assemble-31.4 {jumptable - not a list} { + -body { + assemble {jumpTable \{rubbish} + } + -returnCodes error + -result {unmatched open brace in list} +} +test assemble-31.5 {jumpTable, badly structured} { + -body { + list [catch {assemble { + # line 2 + jumpTable {one two three};# line 3 + }} result] \ + $result $::errorCode $::errorInfo + } + -match glob + -result {1 {jump table must have an even number of list elements} {TCL ASSEM BADJUMPTABLE} {jump table must have an even number of list elements*("assemble" body, line 3)*}} +} +test assemble-31.6 {jumpTable, missing symbol} { + -body { + list [catch {assemble { + # line 2 + jumpTable {1 a};# line 3 + }} result] \ + $result $::errorCode $::errorInfo + } + -match glob + -result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}} +} + +test assemble-31.7 {jumptable, actual example} { + -setup { + proc x {} { + set result {} + for {set i 0} {$i < 5} {incr i} { + lappend result [assemble { + load i + jumpTable {1 @one 2 @two 3 @three} + push {none of the above} + jump @done + label @one + push one + jump @done + label @two + push two + jump @done + label @three + push three + label @done + }] + } + set tcl_traceCompile 2 + set result + } + } + -body x + -result {{none of the above} one two three {none of the above}} + -cleanup {set tcl_traceCompile 0; rename x {}} +} test assemble-40.1 {unbalanced stack} { -body { @@ -3164,6 +3264,45 @@ test assemble-41.1 {Inconsistent stack usage} {*}{ ("assemble" body, line 10)*} } +test assemble-41.2 {Inconsistent stack, jumptable and default} { + -body { + proc x {y} { + assemble { + load y + jumpTable {0 else} + push 0 + label else + pop + } + } + catch {x 1} + set errorInfo + } + -match glob + -result {inconsistent stack depths on two execution paths + ("assemble" body, line 6)*} +} + +test assemble-41.3 {Inconsistent stack, two legs of jumptable} { + -body { + proc x {y} { + assemble { + load y + jumpTable {0 no 1 yes} + label no + push 0 + label yes + pop + } + } + catch {x 1} + set errorInfo + } + -match glob + -result {inconsistent stack depths on two execution paths + ("assemble" body, line 7)*} +} + test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} { -body { proc ulam {n} { |