diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | generic/tclAssembly.c | 252 | ||||
| -rw-r--r-- | generic/tclAssembly.h | 82 | ||||
| -rw-r--r-- | tests/assemble.test | 235 |
4 files changed, 447 insertions, 137 deletions
@@ -1,3 +1,18 @@ +2010-09-28 Kevin B. Kenny <kennykb@acm.org> + + [dogeen-assembler-branch] + + * 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. + 2010-09-27 Kevin B. Kenny <kennykb@acm.org> [dogeen-assembler-branch] 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; } diff --git a/generic/tclAssembly.h b/generic/tclAssembly.h index c1cb0e5..6ea9137 100644 --- a/generic/tclAssembly.h +++ b/generic/tclAssembly.h @@ -3,12 +3,20 @@ #include "tclCompile.h" +/* + * Structure that defines a basic block - a linear sequence of bytecode + * instructions with no jumps in or out. + */ + typedef struct BasicBlock { - /* FIXME: start needs to be an offset from envPtr->codeStart */ - unsigned char * start; /* Instruction address of the start - * of the block */ - int startLine; /* Index in the input instruction - * list of the start of the block */ + + int startOffset; /* Instruction offset of the start of + * the block */ + int startLine; /* Line number in the input script of the + * instruction at the start of the block */ + int jumpLine; /* Line number in the input script of the + * 'jump' instruction that ends the block, + * or -1 if there is no jump */ int may_fall_thru; /* Flag == 1 if control passes from this * block to its successor. */ int visited; /* Flag==1 if this block has been visited @@ -21,8 +29,7 @@ typedef struct BasicBlock { * block: NULL at the end of the bytecode * sequence or if the block ends in an * unconditional jump */ - Tcl_HashEntry * jumpTargetLabelHashEntry; - /* Jump target label if the jump target + Tcl_Obj * jumpTarget; /* Jump target label if the jump target * is unresolved */ int initialStackDepth; /* Absolute stack depth on entry */ @@ -32,7 +39,9 @@ typedef struct BasicBlock { } BasicBlock; -typedef enum talInstType { +/* Source instruction type recognized by the assembler */ + +typedef enum TalInstType { ASSEM_1BYTE, /* The instructions that are directly mapped to tclInstructionTable in tclCompile.c*/ ASSEM_BOOL, /* One Boolean operand */ @@ -54,21 +63,56 @@ typedef enum talInstType { ASSEM_PUSH, /* These instructions will be looked up from talInstructionTable */ ASSEM_REVERSE, /* REVERSE: consumes n operands and produces n */ ASSEM_SINT1, /* One 1-byte signed-integer operand (INCR_STK_IMM) */ -} talInstType; +} TalInstType; -typedef struct talInstDesc { +/* Description of an instruction recognized by the assembler. */ + +typedef struct TalInstDesc { const char *name; /* Name of instruction. */ - talInstType instType; /* The type of instruction */ - int tclInstCode; - int operandsConsumed; - int operandsProduced; + TalInstType instType; /* The type of instruction */ + int tclInstCode; /* Instruction code. For instructions having + * 1- and 4-byte variables, tclInstCode is + * ((1byte)<<8) || (4byte) */ + int operandsConsumed; /* Number of operands consumed by the + * operation, or INT_MIN if the operation + * is variadic */ + int operandsProduced; /* Number of operands produced by the + * operation. If negative, the operation + * has a net stack effect of + * -1-operandsProduced */ +} TalInstDesc; + +/* Description of a label in the assembly code */ + +typedef struct JumpLabel { + int isDefined; /* Flag == 1 if label is defined */ + int offset; /* Offset in the code where the label starts, + * or head of a linked list of jump target + * addresses if the label is undefined */ + BasicBlock* basicBlock; /* Basic block that begins at the label */ +} JumpLabel; + +/* 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] */ -} talInstDesc; + BasicBlock* head_bb; /* First basic block in the code */ + BasicBlock* curr_bb; /* Current basic block */ -typedef struct label { - int isDefined; - int offset; -} label; + int maxDepth; /* Maximum stack depth encountered */ + int flags; /* Compilation flags (TCL_EVAL_DIRECT) */ +} AssembleEnv; MODULE_SCOPE int TclAssembleCode(CompileEnv* compEnv, const char* codePtr, int codeLen, int flags); diff --git a/tests/assemble.test b/tests/assemble.test index 1dc1ed9..0038346 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -1576,6 +1576,237 @@ test assemble-15.6 {invokeStk4} { -cleanup {rename x {}} } +# assemble-16 -- jumps and labels + +test assemble-16.1 {label, wrong # args} { + -body { + assemble {label} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-16.2 {label, wrong # args} { + -body { + assemble {label too many} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-16.3 {label, bad subst} { + -body { + list [catch {assemble {label $foo}} result] $result $::errorCode + } + -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} + -cleanup {unset result} +} + +test assemble-16.4 {duplicate label} { + -body { + list [catch {assemble {label foo; label foo}} result] \ + $result $::errorCode + } + -result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}} +} + +test assemble-16.5 {jump, wrong # args} { + -body { + assemble {jump} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-16.6 {jump, wrong # args} { + -body { + assemble {jump too many} + } + -returnCodes error + -match glob + -result {wrong # args*} +} + +test assemble-16.7 {jump, bad subst} { + -body { + list [catch {assemble {jump $foo}} result] $result $::errorCode + } + -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} + -cleanup {unset result} +} + +test assemble-16.8 {jump - ahead and back} { + -body { + assemble { + jump three + + label one + push a + jump four + + label two + push b + jump six + + label three + push c + jump five + + label four + push d + jump two + + label five + push e + jump one + + label six + push f + concat 6 + } + } + -result ceadbf +} + +test assemble-16.9 {jump - resolve a label multiple times} { + -body { + proc x {} { + set case 0 + set result {} + assemble { + jump common + + label zero + pop + incrImm case 1 + pop + push a + append result + pop + jump common + + label one + pop + incrImm case 1 + pop + push b + append result + pop + jump common + + label common + load case + dup + push 0 + eq + jumpTrue zero + dup + push 1 + eq + jumpTrue one + dup + push 2 + eq + jumpTrue two + dup + push 3 + eq + jumpTrue three + + label two + pop + incrImm case 1 + pop + push c + append result + pop + jump common + + label three + pop + incrImm case 1 + pop + push d + append result + } + } + x + } + -result abcd + -cleanup {rename x {}} +} + +test assemble-16.10 {jump4} { + -body { + assemble "push x; jump one; label two; [string repeat {dup; pop;} 128] + jump three; label one; jump two; label three" + } + -result x +} + +test assemble-16.11 {jumpTrue} { + -body { + proc x {y} { + assemble { + load y + jumpTrue then + push no + jump else + label then + push yes + label else + } + } + list [x 0] [x 1] + } + -result {no yes} + -cleanup {rename x {}} +} + +test assemble-16.12 {jumpFalse} { + -body { + proc x {y} { + assemble { + load y + jumpFalse then + push no + jump else + label then + push yes + label else + } + } + list [x 0] [x 1] + } + -result {yes no} + -cleanup {rename x {}} +} + +test assemble-16.13 {jump to undefined label} { + -body { + list [catch {assemble {jump nowhere}} result] $result $::errorCode + } + -result {1 {undefined label "nowhere"} {TCL ASSEM NOLABEL nowhere}} +} + +test assemble-16.14 {jump to undefined label, line number correct?} { + -body { + catch {assemble {#1 + #2 + #3 + jump nowhere + #5 + #6 + }} + set ::errorInfo + } + -match glob + -result {*"assemble" body, line 4*} +} + test assemble-1.6 {Testing push, dup, add} { -body { @@ -1661,7 +1892,7 @@ test assemble-1.8a {unbalanced stack} {*}{ } result] $result $::errorInfo } -result {1 {stack underflow} {stack underflow - in assembly code between lines 6 and 8*}} + in assembly code between lines 7 and 8*}} -match glob -returnCodes ok } @@ -2069,7 +2300,7 @@ test assemble-1.30 {Inconsistent stack usage} {*}{ } -match glob -result {inconsistent stack depths on two execution paths - ("assemble" body, line 9)*} + ("assemble" body, line 10)*} } test assemble-1.31 {unset, exists, lappend - smoke test} { |