diff options
author | Kevin B Kenny <kennykb@acm.org> | 2010-09-28 02:11:19 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2010-09-28 02:11:19 (GMT) |
commit | febbc1b38ee29ebd5f6115e579a65c0660cf1837 (patch) | |
tree | 432d1921702cc2ca1ef21ba414c1f07ddd5933a2 /generic/tclAssembly.c | |
parent | e7e975cd6f4d6d27ec49946ba6b5d6aeb0d75689 (diff) | |
download | tcl-febbc1b38ee29ebd5f6115e579a65c0660cf1837.zip tcl-febbc1b38ee29ebd5f6115e579a65c0660cf1837.tar.gz tcl-febbc1b38ee29ebd5f6115e579a65c0660cf1837.tar.bz2 |
* tests/assemble.test: Added more "white box" tests.
* generic/tclAssembly.c: Added the error checking and reporting
for undefined labels. Revised code so that no pointers into the
bytecode sequence are held (because the sequence can move!),
that no Tcl_HashEntry pointers are held (because the hash table
doesn't guarantee their stability!) and to eliminate the BBHash
table, which is merely additional information indexed by jump
labels and can just as easily be held in the 'label' structure.
Renamed shared structures to CamelCase, and renamed 'label' to
JumpLabel because other types of labels may eventually be possible.
Diffstat (limited to 'generic/tclAssembly.c')
-rw-r--r-- | generic/tclAssembly.c | 252 |
1 files changed, 136 insertions, 116 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 4735a59..899d419 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -3,35 +3,6 @@ #include "tclAssembly.h" #include "tclOOInt.h" - -/* Structure that holds the state of the assembler while generating code */ - -typedef struct AssembleEnv { - CompileEnv* envPtr; /* Compilation environment being used - * for code generation */ - Tcl_Parse* parsePtr; /* Parse of the current line of source */ - Tcl_HashTable labelHash; /* Hash table whose keys are labels and - * whose values are 'label' objects storing - * the code offsets of the labels. */ - - int cmdLine; /* Current line number within the assembly - * code */ - int* clNext; /* Invisible continuation line for - * [info frame] */ - - /* TODO: Next table could be a simple list keyed off memory address? - * Or the BB pointers could be in the 'label' struct */ - Tcl_HashTable BBHash; /* Hash table whose keys are labels and - * whose values are BasicBlock structure - * pointers for the basic blocks at those - * locations */ - BasicBlock* head_bb; /* First basic block in the code */ - BasicBlock* curr_bb; /* Current basic block */ - - int maxDepth; /* Maximum stack depth encountered */ - int flags; /* Compilation flags (TCL_EVAL_DIRECT) */ -} AssembleEnv; - /* Static functions defined in this file */ static void AddBasicBlockRangeToErrorInfo(AssembleEnv*, BasicBlock*); @@ -51,6 +22,7 @@ static int CheckOneByte(Tcl_Interp*, int); static int CheckSignedOneByte(Tcl_Interp*, int); static int CheckStack(AssembleEnv*); static int CheckStrictlyPositive(Tcl_Interp*, int); +static int CheckUndefinedLabels(AssembleEnv*); static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr); static int DefineLabel(AssembleEnv* envPtr, const char* label); static void DupAssembleCodeInternalRep(Tcl_Obj* src, Tcl_Obj* dest); @@ -64,7 +36,7 @@ static int GetNextOperand(AssembleEnv*, Tcl_Token**, Tcl_Obj**); static AssembleEnv* NewAssembleEnv(CompileEnv*, int); static int StackCheckBasicBlock(AssembleEnv*, BasicBlock *, BasicBlock *, int); static BasicBlock* StartBasicBlock(AssembleEnv*, int fallthrough, - const char* jumpLabel); + Tcl_Obj* jumpLabel); /* static int AdvanceIp(const unsigned char *pc); */ static int StackCheckBasicBlock(AssembleEnv*, BasicBlock *, BasicBlock *, int); static void SyncStackDepth(AssembleEnv*); @@ -102,7 +74,7 @@ static const Tcl_ObjType assembleCodeType = { #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ -talInstDesc talInstructionTable[] = { +TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ @@ -307,13 +279,6 @@ BBAdjustStackDepth(BasicBlock* bbPtr, bbPtr->maxStackDepth = depth; } bbPtr->finalStackDepth = depth; -#if 0 - fprintf(stderr, "update bb: consumed %d produced %d" - " min %d max %d final %d\n", - consumed, produced, bbPtr->minStackDepth, bbPtr->maxStackDepth, - bbPtr->finalStackDepth); - fflush(stderr); -#endif } /* @@ -344,12 +309,12 @@ BBAdjustStackDepth(BasicBlock* bbPtr, static void BBUpdateStackReqs(BasicBlock* bbPtr, /* Structure describing the basic block */ - int tblind, /* Index in talInstructionTable of the + int tblind, /* Index in TalInstructionTable of the * operation being assembled */ int count) /* Count of operands for variadic insts */ { - int consumed = talInstructionTable[tblind].operandsConsumed; - int produced = talInstructionTable[tblind].operandsProduced; + int consumed = TalInstructionTable[tblind].operandsConsumed; + int produced = TalInstructionTable[tblind].operandsProduced; if (consumed == INT_MIN) { /* The instruction is variadic; it consumes 'count' operands. */ consumed = count; @@ -383,18 +348,22 @@ BBUpdateStackReqs(BasicBlock* bbPtr, static void BBEmitOpcode(AssembleEnv* assemEnvPtr, /* Assembly environment */ - int tblind, /* Table index in talInstructionTable of op */ + int tblind, /* Table index in TalInstructionTable of op */ int count) /* Operand count for variadic ops */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ - int op = talInstructionTable[tblind].tclInstCode & 0xff; -#if 0 - fprintf(stderr, "Emit %s (%d)\n", tclInstructionTable[op].name, count); - fflush(stderr); -#endif + int op = TalInstructionTable[tblind].tclInstCode & 0xff; + + /* If this is the first instruction in a basic block, record its + * line number. */ + + if (bbPtr->startOffset == envPtr->codeNext - envPtr->codeStart) { + bbPtr->startLine = assemEnvPtr->cmdLine; + } + TclEmitInt1(op, envPtr); envPtr->atCmdStart = ((op) == INST_START_CMD); BBUpdateStackReqs(bbPtr, tblind, count); @@ -402,7 +371,7 @@ BBEmitOpcode(AssembleEnv* assemEnvPtr, static void BBEmitInstInt1(AssembleEnv* assemEnvPtr, /* Assembly environment */ - int tblind, /* Index in talInstructionTable of op */ + int tblind, /* Index in TalInstructionTable of op */ unsigned char opnd, /* 1-byte operand */ int count) /* Operand count for variadic ops */ @@ -413,7 +382,7 @@ BBEmitInstInt1(AssembleEnv* assemEnvPtr, static void BBEmitInstInt4(AssembleEnv* assemEnvPtr, /* Assembly environment */ - int tblind, /* Index in talInstructionTable of op */ + int tblind, /* Index in TalInstructionTable of op */ int opnd, /* 4-byte operand */ int count) /* Operand count for variadic ops */ { @@ -435,7 +404,7 @@ BBEmitInstInt4(AssembleEnv* assemEnvPtr, static void BBEmitInst1or4(AssembleEnv* assemEnvPtr, /* Assembly environment */ - int tblind, /* Index in talInstructionTable of op */ + int tblind, /* Index in TalInstructionTable of op */ int param, /* Variable-length parameter */ int count) /* Arity if variadic */ { @@ -444,16 +413,12 @@ BBEmitInst1or4(AssembleEnv* assemEnvPtr, BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ - int op = talInstructionTable[tblind].tclInstCode; + int op = TalInstructionTable[tblind].tclInstCode; if (param <= 0xff) { op >>= 8; } else { op &= 0xff; } -#if 0 - fprintf(stderr, "Emit %s (%d)\n", tclInstructionTable[op].name, count); - fflush(stderr); -#endif TclEmitInt1(op, envPtr); if (param <= 0xff) { TclEmitInt1(param, envPtr); @@ -845,7 +810,6 @@ NewAssembleEnv(CompileEnv* envPtr, /* Make the hashtables that store symbol resolution */ Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS); - Tcl_InitHashTable(&assemEnvPtr->BBHash, TCL_STRING_KEYS); /* Start the first basic block */ @@ -884,11 +848,13 @@ FreeAssembleEnv(AssembleEnv* assemEnvPtr) * successor */ Tcl_HashEntry* hashEntry; Tcl_HashSearch hashSearch; - label* labelPtr; + JumpLabel* labelPtr; - /* Free the basic block hash index and all the basic block structures */ - Tcl_DeleteHashTable(&assemEnvPtr->BBHash); + /* Free all the basic block structures */ for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) { + if (thisBB->jumpTarget != NULL) { + Tcl_DecrRefCount(thisBB->jumpTarget); + } nextBB = thisBB->successor1; ckfree((char*)thisBB); } @@ -896,7 +862,7 @@ FreeAssembleEnv(AssembleEnv* assemEnvPtr) /* Free all the labels */ while ((hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash, &hashSearch)) != NULL) { - labelPtr = (label*) Tcl_GetHashValue(hashEntry); + labelPtr = (JumpLabel*) Tcl_GetHashValue(hashEntry); ckfree((char*) labelPtr); Tcl_DeleteHashEntry(hashEntry); } @@ -935,9 +901,9 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) Tcl_Token* tokenPtr; /* Current token within the line of code */ Tcl_Obj* instNameObj = NULL; /* Name of the instruction */ - int tblind; /* Index in talInstructionTable of the + int tblind; /* Index in TalInstructionTable of the * instruction */ - enum talInstType instType; /* Type of the instruction */ + enum TalInstType instType; /* Type of the instruction */ Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ @@ -946,7 +912,7 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) * block operations */ int isNew; /* Flag indicating that a new hash entry * has been created */ - label* l; /* Structure descibing a label in the + JumpLabel* l; /* Structure descibing a label in the * assembly code */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ @@ -965,15 +931,15 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) /* Look up the instruction name */ if (Tcl_GetIndexFromObjStruct(interp, instNameObj, - &talInstructionTable[0].name, - sizeof(talInstDesc), "instruction", + &TalInstructionTable[0].name, + sizeof(TalInstDesc), "instruction", TCL_EXACT, &tblind) != TCL_OK) { return TCL_ERROR; } /* Vector on the type of instruction being processed */ - instType = talInstructionTable[tblind].instType; + instType = TalInstructionTable[tblind].instType; switch (instType) { case ASSEM_PUSH: @@ -1042,7 +1008,7 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) */ if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, - ((talInstructionTable[tblind].tclInstCode + ((TalInstructionTable[tblind].tclInstCode == INST_EVAL_STK) ? "script" : "expression")); goto cleanup; } @@ -1056,7 +1022,7 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) int savedMaxStackDepth = envPtr->maxStackDepth; envPtr->currStackDepth = 0; envPtr->maxStackDepth = 0; - switch(talInstructionTable[tblind].tclInstCode) { + switch(TalInstructionTable[tblind].tclInstCode) { case INST_EVAL_STK: TclCompileScript(interp, tokenPtr[1].start, tokenPtr[1].size, envPtr); @@ -1067,8 +1033,8 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) break; default: Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen", - talInstructionTable[tblind].name, - talInstructionTable[tblind].tclInstCode); + TalInstructionTable[tblind].name, + TalInstructionTable[tblind].tclInstCode); } SyncStackDepth(assemEnvPtr); envPtr->currStackDepth = savedStackDepth; @@ -1109,7 +1075,7 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(operand1Obj), &isNew); if (isNew) { - l = (label *) ckalloc(sizeof(label)); + l = (JumpLabel*) ckalloc(sizeof(JumpLabel)); l -> isDefined = 0; l -> offset = -1; Tcl_SetHashValue(entry, l); @@ -1118,19 +1084,20 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) } if (l -> isDefined) { BBEmitInst1or4(assemEnvPtr, tblind, - (l->offset + envPtr->codeStart - - envPtr->codeNext), 0); + l->offset - (envPtr->codeNext - envPtr->codeStart), + 0); } else { int here = envPtr->codeNext - envPtr->codeStart; BBEmitInstInt4(assemEnvPtr, tblind, l->offset, 0); l->offset = here; - } + } /* Start a new basic block at the instruction following the jump */ + assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; StartBasicBlock(assemEnvPtr, - talInstructionTable[tblind].operandsConsumed, - Tcl_GetString(operand1Obj)); + TalInstructionTable[tblind].operandsConsumed, + operand1Obj); break; @@ -1147,15 +1114,6 @@ AssembleOneLine(AssembleEnv* assemEnvPtr) if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) { goto cleanup; } - StartBasicBlock(assemEnvPtr, 1, NULL); - - /* Attach the label to the new basic block */ - - /* TODO - do this in DefineLable and make the BB a field in the - * label struct */ - entry = Tcl_CreateHashEntry(&assemEnvPtr->BBHash, - Tcl_GetString(operand1Obj), &opnd); - Tcl_SetHashValue(entry, assemEnvPtr->curr_bb); break; case ASSEM_LVT: @@ -1679,8 +1637,11 @@ DefineLabel(AssembleEnv* assemEnvPtr, /* Assembly environment */ Tcl_HashEntry* entry; /* Label's entry in the symbol table */ int isNew; /* Flag == 1 iff the label was previously * undefined */ - label* l; /* */ - Tcl_Obj* result; + JumpLabel* l; /* 'JumpLabel' struct describing the + * newly defined label */ + Tcl_Obj* result; /* Error message */ + + StartBasicBlock(assemEnvPtr, 1, NULL); /* Look up the newly-defined label in the symbol table */ @@ -1689,21 +1650,27 @@ DefineLabel(AssembleEnv* assemEnvPtr, /* Assembly environment */ /* This is the first appearance of the label in the code */ - l = (label *)ckalloc(sizeof(label)); + l = (JumpLabel*)ckalloc(sizeof(JumpLabel)); l->isDefined = 1; l->offset = envPtr->codeNext - envPtr->codeStart; + l->basicBlock = assemEnvPtr->curr_bb; Tcl_SetHashValue(entry, l); } else { /* The label has appeared earlier. Make sure that it's not defined. */ - l = (label *) Tcl_GetHashValue(entry); + l = (JumpLabel*) Tcl_GetHashValue(entry); if (l->isDefined) { - result = Tcl_NewStringObj("duplicate definition of label \"", -1); - Tcl_AppendToObj(result, labelName, -1); - Tcl_AppendToObj(result, "\"", -1); - Tcl_SetObjResult(interp, result); + if (assemEnvPtr-> flags & (TCL_EVAL_DIRECT)) { + result = Tcl_NewStringObj("duplicate definition " + "of label \"", -1); + Tcl_AppendToObj(result, labelName, -1); + Tcl_AppendToObj(result, "\"", -1); + Tcl_SetObjResult(interp, result); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", + labelName, NULL); + } return TCL_ERROR; } else { @@ -1715,18 +1682,16 @@ DefineLabel(AssembleEnv* assemEnvPtr, /* Assembly environment */ int jump = l->offset; while (jump >= 0) { int prevJump = TclGetInt4AtPtr(envPtr->codeStart + jump + 1); -#if 0 - fprintf(stderr, "fixup jump at %d to refer to %d\n", - jump, envPtr->codeNext - envPtr->codeStart); -#endif TclStoreInt4AtPtr(envPtr->codeNext - envPtr->codeStart - jump, envPtr->codeStart + jump + 1); jump = prevJump; } l->offset = envPtr->codeNext - envPtr->codeStart; + l->basicBlock = assemEnvPtr->curr_bb; l->isDefined = 1; } } + return TCL_OK; } @@ -1750,20 +1715,19 @@ StartBasicBlock(AssembleEnv* assemEnvPtr, int fallsThrough, /* 1 if execution falls through into * the following block, 0 otherwise */ - const char* jumpLabel) + Tcl_Obj* jumpLabel) /* Label of the location that the * block jumps to, or NULL if the block * does not jump */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ - int isNew; /* Unused return from Tcl_CreateHashEntry */ BasicBlock* newBB; /* BasicBlock structure for the new block */ BasicBlock* currBB = assemEnvPtr->curr_bb; /* Coalesce zero-length blocks */ - if (currBB->start == envPtr->codeNext) { + if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) { return currBB; } @@ -1773,11 +1737,8 @@ StartBasicBlock(AssembleEnv* assemEnvPtr, /* Record the jump target if there is one. */ - if (jumpLabel) { - currBB->jumpTargetLabelHashEntry = - Tcl_CreateHashEntry(&assemEnvPtr->BBHash, jumpLabel, &isNew); - } else { - currBB->jumpTargetLabelHashEntry = NULL; + if ((currBB->jumpTarget = jumpLabel) != NULL) { + Tcl_IncrRefCount(currBB->jumpTarget); } /* Record the fallthrough if there is one. */ @@ -1812,8 +1773,9 @@ AllocBB(AssembleEnv* assemEnvPtr) CompileEnv* envPtr = assemEnvPtr->envPtr; BasicBlock * bb = (BasicBlock *) ckalloc(sizeof(BasicBlock)); - bb->start = envPtr->codeNext; + bb->startOffset = envPtr->codeNext - envPtr->codeStart; bb->startLine = assemEnvPtr->cmdLine; + bb->jumpLine = -1; bb->initialStackDepth = 0; bb->minStackDepth = 0; bb->maxStackDepth = 0; @@ -1823,7 +1785,7 @@ AllocBB(AssembleEnv* assemEnvPtr) bb->predecessor = NULL; bb->may_fall_thru = 0; - bb->jumpTargetLabelHashEntry = NULL; + bb->jumpTarget = NULL; bb->successor1 = NULL; return bb; @@ -1864,12 +1826,16 @@ FinishAssembly(AssembleEnv* assemEnvPtr) Tcl_Obj* resultObj; /* Error message from this function */ int litIndex; /* Index of the empty literal {} */ - /* TODO - Check for undefined labels */ - /* Tie off the last basic block */ curr_bb->may_fall_thru = 0; - curr_bb->jumpTargetLabelHashEntry = NULL; + curr_bb->jumpTarget = NULL; + + /* Make sure there are no undefined labels */ + + if (CheckUndefinedLabels(assemEnvPtr) != TCL_OK) { + return TCL_ERROR; + } /* Compute stack balance throughout the program */ @@ -1890,7 +1856,7 @@ FinishAssembly(AssembleEnv* assemEnvPtr) if (depth == 0) { /* Emit a 'push' of the empty literal */ litIndex = TclRegisterNewLiteral(envPtr, "", 0); - /* Assumes that 'push' is at slot 0 in talInstructionTable */ + /* Assumes that 'push' is at slot 0 in TalInstructionTable */ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); ++depth; } @@ -1922,6 +1888,58 @@ FinishAssembly(AssembleEnv* assemEnvPtr) /* *----------------------------------------------------------------------------- * + * CheckUndefinedLabels -- + * + * Check to make sure that the assembly code contains no undefined + * labels. + * + * Results: + * Returns a standard Tcl result, with an appropriate error message + * if undefined labels exist. + * + *----------------------------------------------------------------------------- + */ + +static int +CheckUndefinedLabels(AssembleEnv* assemEnvPtr) + /* Assembly environment */ +{ + 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 */ + JumpLabel* l; /* Exit label of the block */ + Tcl_Obj* result; /* Error message */ + + for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) + { + if (bbPtr->jumpTarget != NULL) { + entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(bbPtr->jumpTarget)); + l = (JumpLabel*) Tcl_GetHashValue(entry); + if (!(l->isDefined)) { + 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); + } + return TCL_ERROR; + } + } + } + return TCL_OK; +} + +/* + *----------------------------------------------------------------------------- + * * CheckStack -- * * Audit stack usage in a block of assembly code. @@ -2065,11 +2083,13 @@ StackCheckBasicBlock(AssembleEnv* assemEnvPtr, blockPtr, stackDepth); } - if (result == TCL_OK && blockPtr->jumpTargetLabelHashEntry != NULL) { - BasicBlock * targetBlock = (BasicBlock *) - Tcl_GetHashValue(blockPtr->jumpTargetLabelHashEntry); - result = StackCheckBasicBlock(assemEnvPtr, targetBlock, blockPtr, - stackDepth); + if (result == TCL_OK && blockPtr->jumpTarget != NULL) { + Tcl_HashEntry* entry = + Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(blockPtr->jumpTarget)); + JumpLabel* targetLabel = (JumpLabel*) Tcl_GetHashValue(entry); + result = StackCheckBasicBlock(assemEnvPtr, targetLabel->basicBlock, + blockPtr, stackDepth); } return result; } |