summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2010-09-28 02:11:19 (GMT)
committerKevin B Kenny <kennykb@acm.org>2010-09-28 02:11:19 (GMT)
commitfebbc1b38ee29ebd5f6115e579a65c0660cf1837 (patch)
tree432d1921702cc2ca1ef21ba414c1f07ddd5933a2
parente7e975cd6f4d6d27ec49946ba6b5d6aeb0d75689 (diff)
downloadtcl-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.
-rw-r--r--ChangeLog15
-rw-r--r--generic/tclAssembly.c252
-rw-r--r--generic/tclAssembly.h82
-rw-r--r--tests/assemble.test235
4 files changed, 447 insertions, 137 deletions
diff --git a/ChangeLog b/ChangeLog
index 56bfc26..06b8bfb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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} {