* tclAssembly.c: Massive refactoring of the assembler

* tclAssembly.h:		to use a Tcl-like syntax (and use
* tests/assemble.test:		Tcl_ParseCommand to parse it). The
* tests/assemble1.bench:	refactoring also ensures that
Tcl_Tokens in the assembler have string ranges inside the source
code, which allows for [eval] and [expr] assembler directives
that simply call TclCompileScript and TclCompileExpr recursively.

1 files changed, 1196 insertions, 628 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7063b8a..40e79f5 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -3,38 +3,73 @@
 #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(Tcl_Interp* interp, Tcl_Obj* bcList,
-					  BasicBlock* bbPtr);
+static void AddBasicBlockRangeToErrorInfo(AssembleEnv*, BasicBlock*);
 static void AddInstructionToErrorInfo(Tcl_Interp* interp, Tcl_Obj* bcList,
 				      int index);
-static BasicBlock * AllocBB(CompileEnv*, int); 
-static int CheckNamespaceQualifiers(Tcl_Interp*, const char*);
+static BasicBlock * AllocBB(AssembleEnv*); 
+static int AssembleOneLine(AssembleEnv* envPtr);
+static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int);
 static int CheckOneByte(Tcl_Interp*, int);
 static int CheckSignedOneByte(Tcl_Interp*, int);
-static int StackCheckBasicBlock(StackCheckerState* , BasicBlock *, BasicBlock *, int);
-static BasicBlock* StartBasicBlock(CompileEnv* envPtr, 	Tcl_HashTable* BBHash,
-				   BasicBlock* currBB, int fallsThrough,
-				   int bcIndex, const char* jumpLabel);
-
-static int CheckStack(Tcl_Interp*, CompileEnv*, BasicBlock *, Tcl_Obj*);
-static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
+static int CheckStack(AssembleEnv*);
 static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static int DefineLabel(Tcl_Interp* interp, CompileEnv* envPtr,
-		       const char* label, Tcl_HashTable* labelHash);
+static int DefineLabel(AssembleEnv* envPtr, const char* label);
+static int FindLocalVar(AssembleEnv* envPtr, Tcl_Token** tokenPtrPtr);
+static int FinishAssembly(AssembleEnv*);
+static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
+static void FreeAssembleEnv(AssembleEnv*);
+static int GetBooleanOperand(AssembleEnv*, Tcl_Token**, int*);
+static int GetIntegerOperand(AssembleEnv*, Tcl_Token**, int*);
+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);
+/* static int AdvanceIp(const unsigned char *pc); */
+static int StackCheckBasicBlock(AssembleEnv*, BasicBlock *, BasicBlock *, int);
+static void SyncStackDepth(AssembleEnv*);
+
+/* Tcl_ObjType that describes bytecode emitted by the assembler */
 
 static const Tcl_ObjType assembleCodeType = {
     "assemblecode",
-    FreeAssembleCodeInternalRep,	/* freeIntRepProc */
-    NULL,	/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    NULL			/* setFromAnyProc */
+    FreeAssembleCodeInternalRep, /* freeIntRepProc */
+    NULL,			 /* dupIntRepProc */
+    NULL,			 /* updateStringProc */
+    NULL			 /* setFromAnyProc */
 };
 
-/* static int AdvanceIp(const unsigned char *pc); */
-static int StackCheckBasicBlock(StackCheckerState* , BasicBlock *, BasicBlock *, int);
-
 /*
  * TIP #280: Remember the per-word line information of the current command. An
  * index is used instead of a pointer as recursive compilation may reallocate,
@@ -80,8 +115,9 @@ talInstDesc talInstructionTable[] = {
                 ASSEM_1BYTE,    INST_APPEND_STK, 
                                                 2,      1}, 
     {"concat",	ASSEM_CONCAT1,	INST_CONCAT1,	INT_MIN,1},
-    {"eval",	ASSEM_EVAL,	0,		0,	1},
+    {"eval",	ASSEM_EVAL,	INST_EVAL_STK,	0,	1},
     {"evalStk",	ASSEM_1BYTE,	INST_EVAL_STK,	1,	1},
+    {"expr",	ASSEM_EVAL,	INST_EXPR_STK,	0,	1},
     {"exprStk", ASSEM_1BYTE,	INST_EXPR_STK,	1,	1},
     {"exist",	ASSEM_LVT4,	INST_EXIST_SCALAR,
                                                 0,      1},
@@ -336,11 +372,15 @@ BBUpdateStackReqs(BasicBlock* bbPtr,
  */
 
 static void
-BBEmitOpcode(CompileEnv* envPtr,/* Compilation environment */
-	     BasicBlock* bbPtr,	/* Basic block to which the op belongs */
+BBEmitOpcode(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
 	     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);
@@ -351,29 +391,25 @@ BBEmitOpcode(CompileEnv* envPtr,/* Compilation environment */
     BBUpdateStackReqs(bbPtr, tblind, count);
 }
 static void
-BBEmitInstInt1(CompileEnv* envPtr,
-				/* Compilation environment */
-	       BasicBlock* bbPtr,
-				/* basic block to which the op belongs */
+BBEmitInstInt1(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
 	       int tblind,	/* Index in talInstructionTable of op */
 	       unsigned char opnd,
 				/* 1-byte operand */
 	       int count)	/* Operand count for variadic ops */
 {
-    BBEmitOpcode(envPtr, bbPtr, tblind, count);
-    TclEmitInt1(opnd, envPtr);
+    BBEmitOpcode(assemEnvPtr, tblind, count);
+    TclEmitInt1(opnd, assemEnvPtr->envPtr);
 }
 static void
-BBEmitInstInt4(CompileEnv* envPtr,
-				/* Compilation environment */
-	       BasicBlock* bbPtr,
-				/* basic block to which the op belongs */
+BBEmitInstInt4(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
 	       int tblind,	/* Index in talInstructionTable of op */
 	       int opnd,	/* 4-byte operand */
 	       int count)	/* Operand count for variadic ops */
 {
-    BBEmitOpcode(envPtr, bbPtr, tblind, count);
-    TclEmitInt4(opnd, envPtr);
+    BBEmitOpcode(assemEnvPtr, tblind, count);
+    TclEmitInt4(opnd, assemEnvPtr->envPtr);
 }
 
 /*
@@ -388,14 +424,16 @@ BBEmitInstInt4(CompileEnv* envPtr,
  */
 
 static void
-BBEmitInst1or4(CompileEnv* envPtr,
-				/* Compilation environment */
-	       BasicBlock* bbPtr,
-				/* Basic block under construction */
+BBEmitInst1or4(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
 	       int tblind,	/* Index in talInstructionTable of op */
 	       int param,	/* Variable-length parameter */
 	       int count)	/* Arity if variadic */
 {
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
+				/* Current basic block */
 
     int op = talInstructionTable[tblind].tclInstCode;
     if (param <= 0xff) {
@@ -417,6 +455,23 @@ BBEmitInst1or4(CompileEnv* envPtr,
     BBUpdateStackReqs(bbPtr, tblind, count);
 }
 
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Tcl_AssembleObjCmd, TclNRAssembleObjCmd --
+ *
+ *	Direct evaluation path for tcl::unsupported::assemble
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Assembles the code in objv[1], and executes it, so side effects
+ *	include whatever the code does.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
 int
 Tcl_AssembleObjCmd(
     ClientData dummy,		/* Not used. */
@@ -424,9 +479,13 @@ Tcl_AssembleObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
+    /* 
+     * Boilerplate - make sure that there is an NRE trampoline on the
+     * C stack because there needs to be one in place to execute bytecode.
+     */
+        
     return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv);
 }
-
 int
 TclNRAssembleObjCmd(
     ClientData dummy,		/* Not used. */
@@ -434,50 +493,75 @@ TclNRAssembleObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Obj *objPtr;
-    ByteCode *codePtr;
+    ByteCode *codePtr;		/* Pointer to the bytecode to execute */
+    Tcl_Obj* backtrace;		/* Object where extra error information
+				 * is constructed. */
 
-#if 0
-    int i;
-    fprintf(stderr, "TclNRAssembleObjCmd:");
-    for (i=0; i < objc; ++i) {
-	fprintf(stderr, " {%s}", Tcl_GetString(objv[i]));
-    }
-    fprintf(stderr, "\n"); fflush(stderr);
-#endif
+    /* Check args */
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList");
 	return TCL_ERROR;
     }
 
-    objPtr = objv[1];
-    codePtr = CompileAssembleObj(interp, objPtr);
+    /* Assemble the source to bytecode */
+
+    codePtr = CompileAssembleObj(interp, objv[1]);
+
+    /* On failure, report error line */
+
     if (codePtr == NULL) {
+	Tcl_AddErrorInfo(interp, "\n    (\"");
+	Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0]));
+	Tcl_AddErrorInfo(interp, "\" body, line ");
+	backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
+	Tcl_IncrRefCount(backtrace);
+	Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace));
+	Tcl_DecrRefCount(backtrace);
+	Tcl_AddErrorInfo(interp, ")");
 	return TCL_ERROR;
     }
 
-#if 0
-    fprintf(stderr, "bytecode: %p\n", codePtr);
-#endif
+    /* Use NRE to evaluate the bytecode from the trampoline */
+
     Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
 	    NULL, NULL);
 
     return TCL_OK;
 }
-
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CompileAssembleObj --
+ *
+ *	Sets up and assembles Tcl bytecode for the direct-execution path
+ *	in the Tcl bytecode assembler.
+ *
+ * Results:
+ *	Returns a pointer to the assembled code. Returns NULL if the
+ *	assembly fails for any reason, with an appropriate error message
+ *	in the interpreter.
+ *
+ *-----------------------------------------------------------------------------
+ */
+ 
 static ByteCode *
 CompileAssembleObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr)
+    Tcl_Interp *interp,		/* Tcl interpreter */
+    Tcl_Obj *objPtr)		/* Source code to assemble */
 {
     Interp *iPtr = (Interp *) interp;
-    CompileEnv compEnv;		/* Compilation environment structure allocated
-				 * in frame. */
+				/* Internals of the interpreter */
+    CompileEnv compEnv;		/* Compilation environment structure */
     register ByteCode *codePtr = NULL;
-				/* Tcl Internal type of bytecode. Initialized
-				 * to avoid compiler warning. */
+				/* Bytecode resulting from the assembly */
+    Namespace* namespacePtr;	/* Namespace in which variable and
+				 * command names in the bytecode resolve */
     int status;			/* Status return from Tcl_AssembleCode */
+    const char* source;		/* String representation of the
+				 * source code */
+    int sourceLen;			/* Length of the source code in bytes */
 
     /*
      * Get the expression ByteCode from the object. If it exists, make sure it
@@ -485,8 +569,7 @@ CompileAssembleObj(
      */
      
     if (objPtr->typePtr == &assembleCodeType) {
-	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
-
+	namespacePtr = iPtr->varFramePtr->nsPtr;
 	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
 	    || (codePtr->compileEpoch != iPtr->compileEpoch)
@@ -499,34 +582,17 @@ CompileAssembleObj(
     }
     if (objPtr->typePtr != &assembleCodeType) {
 
-	int length;
-		
-	const char *string = TclGetStringFromObj(objPtr, &length);
-	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
-#if 0
-	fprintf(stderr, "assembling: %s\n", string); fflush(stderr);
-#endif
-	status = TclAssembleCode(interp, objPtr, &compEnv, TCL_EVAL_DIRECT);
+	/* Set up the compilation environment, and assemble the code */
+
+	source = TclGetStringFromObj(objPtr, &sourceLen);
+	TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
+	status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
 	if (status != TCL_OK) {
-#if 0
-	    fprintf(stderr, "assembly failed: %s\n", 
-		    Tcl_GetString(Tcl_GetObjResult(interp)));
-	    fflush(stderr);
-#endif
-	    /* FIXME - there's memory to clean up */
-	    return NULL;
-	}
 
-	/*
-	 * Successful compilation. If the expression yielded no instructions,
-	 * push an zero object as the expression's result.
-	 */
+	    /* Assembly failed. Clean up and report the error */
 
-	if (compEnv.codeNext == compEnv.codeStart) {
-	    fprintf(stderr, "empty bytecode, why did this happen?\n");
-	    fflush(stderr);
-	    TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
-		    &compEnv);
+	    TclFreeCompileEnv(&compEnv);
+	    return NULL;
 	}
 
 	/*
@@ -539,11 +605,19 @@ CompileAssembleObj(
 	TclInitByteCodeObj(objPtr, &compEnv);
 	objPtr->typePtr = &assembleCodeType;
 	TclFreeCompileEnv(&compEnv);
+
+	/*
+	 * Record the local variable context to which the bytecode pertains
+	 */
+
 	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
 	if (iPtr->varFramePtr->localCachePtr) {
 	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
 	    codePtr->localCachePtr->refCount++;
 	}
+
+	/* Report on what the assembler did. */
+
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile >= 2) {
 	    TclPrintByteCodeObj(interp, objPtr);
@@ -553,7 +627,7 @@ CompileAssembleObj(
     }
     return codePtr;
 }
-
+
 /*
  *-----------------------------------------------------------------------------
  *
@@ -585,7 +659,6 @@ int TclCompileAssembleCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 { 
     Tcl_Token *tokenPtr;	/* Token in the input script */
-    Tcl_Obj *bcList;		/* List of assembly instructions to process */
     int status;			/* Status return from assembling the code */
 
     /* Make sure that the command has a single arg */
@@ -603,10 +676,7 @@ int TclCompileAssembleCmd(
 
     /* Compile the code and return any error from the compilation */
 
-    bcList = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    Tcl_IncrRefCount(bcList);
-    status = TclAssembleCode(interp, bcList, envPtr, 0);
-    Tcl_DecrRefCount(bcList);
+    status = TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
     return status;
 
 }
@@ -632,472 +702,806 @@ int TclCompileAssembleCmd(
  */
 
 MODULE_SCOPE int
-TclAssembleCode(Tcl_Interp *interp, 
-				/* Tcl interpreter */
-		Tcl_Obj * bcList, 
-				/* List of assembly instructions */
-		CompileEnv *envPtr, 	
+TclAssembleCode(CompileEnv *envPtr, 	
 				/* Compilation environment that is to
 				 * receive the generated bytecode */
+		const char* codePtr,
+				/* Assembly-language code to be processed */
+		int codeLen,	/* Length of the code */
 		int flags)	/* OR'ed combination of flags */
 {
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    /* 
+     * Walk through the assembly script using the Tcl parser.
+     * Each 'command' will be an instruction or assembly directive.
+     */
 
-    int bcListLen = 0;		/* Length of the assembly code list */
-    Tcl_HashTable labelHash;	/* Hashtable storing information about
-				 * labels in the assembly code */
-    Tcl_HashTable BBHash;	/* Hashtable storing information about
-				 * the basic blocks in the bytecode */
-
-    BasicBlock* curr_bb = NULL;	/* Structure describing the current basic 
-				 * block */
-    BasicBlock* head_bb = NULL;	/* Structure describing the first basic
-				 * block in the code */
-    int ind;			/* Index in the list of instructions */
-    int result;			/* Return value from this function */
-    Tcl_Obj* bc;		/* One assembly instruction from the list */
-    int bcSize = 0;		/* Length of the instruction sublist */
-    Tcl_Obj ** bcArgs;		/* Arguments to the instruction */
-    char * instName; 		/* Name of the instruction */
-    enum talInstType instType;	/* Type of the current assembly instruction */
-    unsigned char instCode;	/* Opcode of the current assembly instruction */
-    const char* operand1;	/* First operand passed to the instruction */
-    int operand1Len;		/* Length of the first operand */
-    int tblind = 0;		/* Index in the instruction table of the
-				 * current instruction */
-    int isNew;			/* Flag == 1 if a JUMP is the first
-				 * occurrence of its associated label */
-    Tcl_Obj* resultObj;		/* Error message */
-    int savedMaxStackDepth;	/* Max stack depth saved around compilation
-				 * calls */
-    int savedCurrStackDepth;	/* Current stack depth saved around
-				 * compilation calls. */
-
-    int localVar, opnd = 0;
-    label *l;
-    Tcl_HashEntry * entry;
-    int litIndex;
-     
-    DefineLineInformation;	/* TIP #280 */ /* eclIndex? */
-     
-#if 0
-    fprintf(stderr, "Assembling: %s\n", Tcl_GetString(bcList));
-    fflush(stderr);
-#endif
+    const char* instPtr = codePtr;
+				/* Where to start looking for a line of code */
+    int instLen;		/* Length in bytes of the current line of 
+				 * code */
+    const char* nextPtr;	/* Pointer to the end of the line of code */
+    int bytesLeft = codeLen;	/* Number of bytes of source code remaining 
+				 * to be parsed */
+    int status;			/* Tcl status return */
 
-    /* Test that the bytecode that we're given is a well formed list */
+    AssembleEnv* assemEnvPtr = NewAssembleEnv(envPtr, flags);
+    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
 
-    if (Tcl_ListObjLength(interp, bcList, &bcListLen) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-  
-    /* Initialize the symbol table and the table of basic blocks */
+    do {
 
-    Tcl_InitHashTable(&labelHash, TCL_STRING_KEYS);
-    Tcl_InitHashTable(&BBHash, TCL_STRING_KEYS);
+	/* Parse out one command line from the assembly script */
 
-    /* Allocate a structure to describe the first basic block */
+	status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
+	instLen = parsePtr->commandSize;
+	if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
+	    --instLen;
+	}
 
-    curr_bb = AllocBB(envPtr, 0);
-    head_bb = curr_bb;
-     
-    /* 
-     * Index through the assembly directives and instructions, generating code.
-     */
+	/* Report errors in the parse */
 
-    for (ind = 0; ind < bcListLen; ind++) {
+	if (status != TCL_OK) {
+	    if (flags & TCL_EVAL_DIRECT) {
+		Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, 
+				   instLen);
+	    }
+	    FreeAssembleEnv(assemEnvPtr);
+	    return TCL_ERROR;
+	}
 
-	/* Extract the instruction name from a list element */
+	/* Advance the pointers around any leading commentary */
 
-	result = TCL_OK;
-	if (Tcl_ListObjIndex(interp, bcList, ind, &bc) != TCL_OK
-	    || Tcl_ListObjGetElements(interp, bc, &bcSize, &bcArgs) != TCL_OK) {
-	    goto cleanup;
-	}
-	if (bcSize == 0) {
-	    continue;
-	}
-	instName = Tcl_GetStringFromObj(bcArgs[0], NULL);
-#if 0
-	fprintf(stderr, "[%d] %s\n",
-		envPtr->codeNext - envPtr->codeStart, instName); 
-	fflush(stderr);
-#endif
+	TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr, parsePtr->commandStart);
+	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, 
+				parsePtr->commandStart - envPtr->source);
 
-	/* 
-	 * Extract the first operand, if there is one, and get its string
-       	 * representation 
-	 */
+	/* Process the line of code  */
 
-	if (bcSize >= 2) {
-	    operand1 = Tcl_GetStringFromObj(bcArgs[1], &operand1Len);
-	} else {
-	    operand1 = NULL; 
-	    operand1Len = 0;
-	}
+	if (parsePtr->numWords > 0) {
 
-	/* Look up the instruction in the table of instructions */
+	    /* If tracing, show each line assembled as it happens */
 
-	if (Tcl_GetIndexFromObjStruct(interp, bcArgs[0],
-				      &talInstructionTable[0].name,
-				      sizeof(talInstDesc), "instruction",
-				      TCL_EXACT, &tblind) != TCL_OK) {
-	    goto cleanup;
+#ifdef TCL_COMPILE_DEBUG
+	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
+		printf("  Assembling: ");
+		TclPrintSource(stdout, parsePtr->commandStart,
+			       TclMin(instLen, 55));
+		printf("\n");
+	    }
+#endif
+	    if (AssembleOneLine(assemEnvPtr) != TCL_OK) {
+		if (flags & TCL_EVAL_DIRECT) {
+		    Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, 
+				       instLen);
+		}
+		Tcl_FreeParse(parsePtr);
+		FreeAssembleEnv(assemEnvPtr);
+		return TCL_ERROR;
+	    }
 	}
 
-	/* Vector on the type of instruction being processed */
+	/* Advance to the next line of code */
 
-	instType = talInstructionTable[tblind].instType;
-	instCode = talInstructionTable[tblind].tclInstCode;
-	switch (instType) {
+	nextPtr = parsePtr->commandStart + parsePtr->commandSize;
+	bytesLeft -= (nextPtr - instPtr);
+	instPtr = nextPtr;
+	TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart, instPtr);
+	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
+				instPtr - envPtr->source);
+	Tcl_FreeParse(parsePtr);
+    } while (bytesLeft > 0);
 
-	case ASSEM_LABEL:
+    /* Done with parsing the code */
 
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "name");
-		goto cleanup;
-	    }
-	    /* Add the (label_name, address) pair to the hash table */
-	    if (DefineLabel(interp, envPtr, operand1, &labelHash) != TCL_OK) {
-		goto cleanup;
-	    }
-                    
-	    /* End the current basic block and start a new one */ 
+    status = FinishAssembly(assemEnvPtr);
+    FreeAssembleEnv(assemEnvPtr);
+    return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * NewAssembleEnv --
+ *
+ *	Creates an environment for the assembler to run in.
+ *
+ * Results:
+ *	Allocates, initialises and returns an assembler environment
+ *
+ *-----------------------------------------------------------------------------
+ */
 
-	    curr_bb = StartBasicBlock(envPtr, &BBHash, curr_bb, 1, ind, NULL);
+static AssembleEnv*
+NewAssembleEnv(CompileEnv* envPtr,
+				/* Compilation environment being used
+				 * for code generation*/
+	       int flags)	/* Compilation flags (TCL_EVAL_DIRECT) */
+{
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    AssembleEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssembleEnv));
+				/* Assembler environment under construction */
+    Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+				/* Parse of one line of assembly code */
 
-	    /* Attach the label to the new basic block */
+    assemEnvPtr->envPtr = envPtr;
+    assemEnvPtr->parsePtr = parsePtr;
+    assemEnvPtr->cmdLine = envPtr->line;
+    assemEnvPtr->clNext = envPtr->clNext;
 
-	    entry = Tcl_CreateHashEntry(&BBHash, operand1, &opnd);
-	    Tcl_SetHashValue(entry, curr_bb);
-                    
-	    break;
-                
-	case ASSEM_1BYTE:
-	    if (bcSize != 1) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "");
-		goto cleanup;
-	    }
-	    BBEmitOpcode(envPtr, curr_bb, tblind, 0);
-	    break;
+    /* Make the hashtables that store symbol resolution */
 
-	case ASSEM_INVOKE:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "count");
-		goto cleanup;
-	    }
-	    if (Tcl_GetIntFromObj(interp, bcArgs[1], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    BBEmitInst1or4(envPtr, curr_bb, tblind, opnd, opnd);
-	    break;
-		 
-	case ASSEM_JUMP: 
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "label");
-		goto cleanup;
-	    }
-	    entry = Tcl_CreateHashEntry(&labelHash, operand1, &isNew);
-	    if (isNew) {
-		l = (label *) ckalloc(sizeof(label));
-		l -> isDefined = 0;
-		l -> offset = -1;
-		Tcl_SetHashValue(entry, l);
-	    } else {
-		l = Tcl_GetHashValue(entry);
-	    }
-	    if (l -> isDefined) {
-		BBEmitInst1or4(envPtr, curr_bb, tblind, 
-			       l->offset + envPtr->codeStart
-			       - envPtr->codeNext, 0);
-	    } else {
-		int here = envPtr->codeNext - envPtr->codeStart;
-		BBEmitInstInt4(envPtr, curr_bb, tblind,
-			       l->offset, 0);
-#if 0
-		fprintf(stderr, "forward ref to %s, prev at %d, link %d\n",
-			operand1, l->offset, here);
-#endif
-		l->offset = here;
-	    }   
-                    
-	    /* Start a new basic block at the instruction following the jump */
+    Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&assemEnvPtr->BBHash, TCL_STRING_KEYS);
 
-	    curr_bb = 
-		StartBasicBlock(envPtr, &BBHash, curr_bb,
-				talInstructionTable[tblind].operandsConsumed,
-				ind+1, operand1);
+    /* Start the first basic block */
 
-	    break;
-                             
-	case ASSEM_LVT:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "varname");
-		goto cleanup;
-	    }
-	    if (CheckNamespaceQualifiers(interp, operand1)) {
-		goto cleanup;
-	    }
-	    localVar = TclFindCompiledLocal(operand1, operand1Len, 1, envPtr);
-	    if (localVar == -1) {
-		Tcl_SetObjResult(interp,
-				 Tcl_NewStringObj("cannot use this instruction"
-						  " in non-proc context", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
-		goto cleanup;
-	    }
-	    fprintf(stderr, "operand %s in slot %d\n", operand1, localVar);
-	    BBEmitInst1or4(envPtr, curr_bb, tblind, localVar, 0);
-	    break;
-
-	case ASSEM_LVT1:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "varname");
-		goto cleanup;
-	    }
-	    if (CheckNamespaceQualifiers(interp, operand1)) {
-		goto cleanup;
-	    }
-	    localVar = TclFindCompiledLocal(operand1, operand1Len, 1, envPtr);
-	    if (localVar == -1) {
-		Tcl_SetObjResult(interp,
-				 Tcl_NewStringObj("cannot use this instruction"
-						  " in non-proc context", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
-		goto cleanup;
-	    }
-	    if (CheckOneByte(interp, localVar)) {
-		goto cleanup;
-	    }
-	    BBEmitInstInt1(envPtr, curr_bb, tblind, localVar, 0);
-	    break;
+    assemEnvPtr->head_bb = AllocBB(assemEnvPtr);
+    assemEnvPtr->curr_bb = assemEnvPtr->head_bb;
 
-	case ASSEM_LVT4:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "varname");
-		goto cleanup;
-	    }
-	    if (CheckNamespaceQualifiers(interp, operand1)) {
-		goto cleanup;
-	    }
-	    localVar = TclFindCompiledLocal(operand1, operand1Len, 1, envPtr);
-	    if (localVar == -1) {
-		Tcl_SetObjResult(interp,
-				 Tcl_NewStringObj("cannot use this instruction"
-						  " in non-proc context", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
-		goto cleanup;
-	    }
-	    BBEmitInstInt4(envPtr, curr_bb, tblind, localVar, 0);
-	    break;
+    /* Stash compilation flags */
 
-	case ASSEM_BOOL:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "boolean");
-		goto cleanup;
-	    }
-	    if (Tcl_GetBooleanFromObj(interp, bcArgs[1], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    BBEmitInstInt1(envPtr, curr_bb, tblind, opnd, 0);
-	    break;
+    assemEnvPtr->flags = flags;
 
-	case ASSEM_BOOL_LVT4:
-	    if (bcSize != 3) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "boolean varName");
-		goto cleanup;
-	    }
-	    if (Tcl_GetBooleanFromObj(interp, bcArgs[1], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    operand1 = Tcl_GetStringFromObj(bcArgs[2], &operand1Len);
-	    if (CheckNamespaceQualifiers(interp, operand1)) {
-		goto cleanup;
-	    }
-	    localVar = TclFindCompiledLocal(operand1, operand1Len, 1, envPtr);
-	    if (localVar == -1) {
-		Tcl_SetObjResult(interp,
-				 Tcl_NewStringObj("cannot use this instruction"
-						  " in non-proc context", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
-		goto cleanup;
-	    }
-	    BBEmitInstInt1(envPtr, curr_bb, tblind, opnd, 0);
-	    TclEmitInt4(localVar, envPtr);
-	    break;
-
-        case ASSEM_LVT1_SINT1:
-	    if (bcSize != 3) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "varName imm8");
-		goto cleanup;
-	    }
-	    if (CheckNamespaceQualifiers(interp, operand1)) {
-		goto cleanup;
-	    }
-	    localVar = TclFindCompiledLocal(operand1, operand1Len, 1, envPtr);
-	    if (localVar == -1) {
-		Tcl_SetObjResult(interp,
-				 Tcl_NewStringObj("cannot use this instruction"
-						  " in non-proc context", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
-		goto cleanup;
-	    }
-	    if (CheckOneByte(interp, localVar)) {
-		goto cleanup;
-	    }
-	    if (Tcl_GetIntFromObj(interp, bcArgs[2], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    if (CheckSignedOneByte(interp, opnd)) {
-		goto cleanup;
-	    }
-	    BBEmitInstInt1(envPtr, curr_bb, tblind, localVar, 0);
-	    TclEmitInt1(opnd, envPtr);
-	    break;
-
-	case ASSEM_OVER:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "count");
-		goto cleanup;
-	    }
-	    if (Tcl_GetIntFromObj(interp, bcArgs[1], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    BBEmitInstInt4(envPtr, curr_bb, tblind, opnd, opnd+1);
-	    break;
+    return assemEnvPtr;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FreeAssembleEnv --
+ *
+ *	Cleans up the assembler environment when assembly is complete.
+ *
+ *-----------------------------------------------------------------------------
+ */
 
-	case ASSEM_PUSH:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "value");
-		goto cleanup;
-	    }
-	    litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
-	    BBEmitInst1or4(envPtr, curr_bb, tblind, litIndex, 0);
-	    break;
+static void
+FreeAssembleEnv(AssembleEnv* assemEnvPtr)
+				/* Environment to free */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment being used
+				 * for code generation */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
 
-	case ASSEM_REVERSE:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "count");
-		goto cleanup;
-	    }
-	    if (Tcl_GetIntFromObj(interp, bcArgs[1], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    BBEmitInstInt4(envPtr, curr_bb, tblind, opnd, opnd);
-	    break;
-		 
-        case ASSEM_SINT1:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "imm8");
-		goto cleanup;
-	    }
-	    if (Tcl_GetIntFromObj(interp, bcArgs[1], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    if (CheckSignedOneByte(interp, opnd)) {
-		goto cleanup;
-	    }
-	    BBEmitInstInt1(envPtr, curr_bb, tblind, opnd, 0);
-	    break;
+    BasicBlock* thisBB;		/* Pointer to a basic block being deleted */
+    BasicBlock* nextBB;		/* Pointer to a deleted basic block's 
+				 * successor */
+    Tcl_HashEntry* hashEntry;
+    Tcl_HashSearch hashSearch;
+    label* labelPtr;
+
+    /* Free the basic block hash index and all the basic block structures */
+    Tcl_DeleteHashTable(&assemEnvPtr->BBHash);
+    for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
+	nextBB = thisBB->successor1;
+	ckfree((char*)thisBB);
+    }
 
-        case ASSEM_CONCAT1:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "imm8");
-		goto cleanup;
-	    }
-	    if (Tcl_GetIntFromObj(interp, bcArgs[1], &opnd) != TCL_OK) {
-		goto cleanup;
-	    }
-	    if (CheckOneByte(interp, opnd)) {
-		goto cleanup;
-	    }
-	    BBEmitInstInt1(envPtr, curr_bb, tblind, opnd, opnd);
-	    break;
+    /* Free all the labels */
+    while ((hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash,
+					    &hashSearch)) != NULL) {
+	labelPtr = (label*) Tcl_GetHashValue(hashEntry);
+	ckfree((char*) labelPtr);
+	Tcl_DeleteHashEntry(hashEntry);
+    }
+    Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
 
-	case ASSEM_EVAL:
-	    if (bcSize != 2) {
-		Tcl_WrongNumArgs(interp, 1, bcArgs, "script");
-		goto cleanup;
-	    }
-	    fprintf(stderr, "compiling: %s\n", operand1); fflush(stderr);
-	    savedMaxStackDepth = envPtr->maxStackDepth;
-	    savedCurrStackDepth = envPtr->currStackDepth;
-	    envPtr->maxStackDepth = 0;
+    TclStackFree(interp, assemEnvPtr->parsePtr);
+    TclStackFree(interp, assemEnvPtr);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * AssembleOneLine --
+ *
+ *	Assembles a single command from an assembly language source.
+ *
+ * Results:
+ *	Returns TCL_ERROR with an appropriate error message if the
+ *	assembly fails. Returns TCL_OK if the assembly succeeds. Updates
+ *	the assembly environment with the state of the assembly.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+AssembleOneLine(AssembleEnv* assemEnvPtr)
+				/* State of the assembly */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment being used for
+				 * code gen */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
+				/* Parse of the line of code */
+    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 
+				 * 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 */
+    int operand1Len;		/* String length of the operand  */
+    Tcl_HashEntry* entry;	/* Hash entry from label and basic
+				 * block operations */
+    int isNew;		    	/* Flag indicating that a new hash entry
+				 * has been created */
+    label* l;		        /* Structure descibing a label in the
+				 * assembly code */
+    int opnd;			/* Integer representation of an operand */
+    int litIndex;		/* Literal pool index of a constant */
+    int localVar;		/* LVT index of a local variable */
+    int status = TCL_ERROR;	/* Return value from this function */
+    
+    /* Make sure that the instruction name is known at compile time. */
+
+    tokenPtr = parsePtr->tokenPtr;
+    instNameObj = Tcl_NewObj();
+    Tcl_IncrRefCount(instNameObj);
+    if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Look up the instruction name */
+    
+    if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
+				  &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;
+    switch (instType) {
+
+    case ASSEM_PUSH:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
+	    goto cleanup;
+	}
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+	    goto cleanup;
+	}
+	operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
+	litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+	BBEmitInst1or4(assemEnvPtr, tblind, litIndex, 0);
+	break;
+
+    case ASSEM_1BYTE:
+	if (parsePtr->numWords != 1) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
+	    goto cleanup;
+	}
+	BBEmitOpcode(assemEnvPtr, tblind, 0);
+	break;
+
+    case ASSEM_BOOL:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
+	    goto cleanup;
+	}
+	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
+	break;
+
+    case ASSEM_BOOL_LVT4:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
+	    goto cleanup;
+	}
+	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
+	TclEmitInt4(localVar, envPtr);
+	break;
+
+    case ASSEM_CONCAT1:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
+	    goto cleanup;
+	}
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, operand1Obj, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	if (CheckOneByte(interp, opnd)) {
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblind, opnd, opnd);
+	break;
+
+    case ASSEM_EVAL:
+	/* TODO - Refactor this stuff into a subroutine
+	 * that takes the inst code, the message ("script" or "expression")
+	 * and an evaluator callback that calls TclCompileScript or
+	 * TclCompileExpr. 
+	 */
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, 
+			     ((talInstructionTable[tblind].tclInstCode
+			       == INST_EVAL_STK) ? "script" : "expression"));
+	    goto cleanup;
+	}
+	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    /*
+	     * The expression or script is not only known at compile time,
+	     * but actually a "simple word". It can be compiled inline by
+	     * invoking the compiler recursively.
+	     */
+	    int savedStackDepth = envPtr->currStackDepth;
+	    int savedMaxStackDepth = envPtr->maxStackDepth;
 	    envPtr->currStackDepth = 0;
-	    TclCompileScript(interp, operand1, operand1Len, envPtr);
-	    if (curr_bb->finalStackDepth + envPtr->maxStackDepth
-		> curr_bb->maxStackDepth) {
-		curr_bb->maxStackDepth =
-		    curr_bb->finalStackDepth + envPtr->maxStackDepth;
+	    envPtr->maxStackDepth = 0;
+	    switch(talInstructionTable[tblind].tclInstCode) {
+	    case INST_EVAL_STK:
+		TclCompileScript(interp, tokenPtr[1].start,
+				 tokenPtr[1].size, envPtr);
+		break;
+	    case INST_EXPR_STK:
+		TclCompileExpr(interp, tokenPtr[1].start,
+			       tokenPtr[1].size, envPtr, 1);
+		break;
+	    default:
+		Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen",
+			  talInstructionTable[tblind].name,
+			  talInstructionTable[tblind].tclInstCode);
 	    }
-	    curr_bb->finalStackDepth += envPtr->currStackDepth;
+	    SyncStackDepth(assemEnvPtr);
+	    envPtr->currStackDepth = savedStackDepth;
 	    envPtr->maxStackDepth = savedMaxStackDepth;
-	    envPtr->currStackDepth = savedCurrStackDepth;
-	    fprintf(stderr, "compilation returns\n"); fflush(stderr);
-	    break;
+	} else if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj)
+		   != TCL_OK) {
+	    goto cleanup;
+	} else {
+	    operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
+	    litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+	    /* Assumes that PUSH is the first slot! */
+	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
+	    BBEmitOpcode(assemEnvPtr, tblind, 0);
+	}
+	break;
 
-	default:
-	    Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
-		      instName);
+    case ASSEM_INVOKE:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
 	}
-            
-    }
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK
+	    || Tcl_GetIntFromObj(interp, operand1Obj, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInst1or4(assemEnvPtr, tblind, opnd, opnd);
+	break;
+		 
+    case ASSEM_JUMP: 
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
+	    goto cleanup;
+	}
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+	    goto cleanup;
+	}
+	entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash,
+				    Tcl_GetString(operand1Obj), &isNew);
+	if (isNew) {
+	    l = (label *) ckalloc(sizeof(label));
+	    l -> isDefined = 0;
+	    l -> offset = -1;
+	    Tcl_SetHashValue(entry, l);
+	} else {
+	    l = Tcl_GetHashValue(entry);
+	}
+	if (l -> isDefined) {
+	    BBEmitInst1or4(assemEnvPtr, tblind, 
+			   (l->offset + envPtr->codeStart
+			    - envPtr->codeNext), 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 */
 
-    /* Tie off the last basic block */
+	StartBasicBlock(assemEnvPtr,
+			talInstructionTable[tblind].operandsConsumed,
+			Tcl_GetString(operand1Obj));
 
-    curr_bb->may_fall_thru = 0;
-    curr_bb->jumpTargetLabelHashEntry = NULL;
-    result = CheckStack(interp, envPtr, head_bb, bcList);
-    if (result != TCL_OK) {
-	goto cleanup;
-    }
-    if (curr_bb->visited) {
-	int depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
-	if (depth == 0) {
-	    /* Emit a 'push' of the empty literal */
-	    litIndex = TclRegisterNewLiteral(envPtr, "", 0);
-	    /* Assumes that 'push' is at slot 0 in talInstructionTable */
-	    BBEmitInst1or4(envPtr, curr_bb, 0, litIndex, 0);
-	    ++depth;
+	break;
+                             
+    case ASSEM_LABEL:
+
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "name");
+	    goto cleanup;
 	}
-	if (depth != 1) {
-	    Tcl_Obj* depthObj = Tcl_NewIntObj(depth);
-	    Tcl_IncrRefCount(depthObj);
-	    resultObj = Tcl_NewStringObj("stack is unbalanced on exit "
-					 "from the code (depth=", -1);
-	    Tcl_AppendObjToObj(resultObj, depthObj);
-	    Tcl_DecrRefCount(depthObj);
-	    Tcl_AppendToObj(resultObj, ")", -1);
-	    Tcl_SetObjResult(interp, resultObj);
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
 	    goto cleanup;
 	}
-#if 0
-	fprintf(stderr, "before: stackDepth %d\n", envPtr->currStackDepth);
-#endif
-	envPtr->currStackDepth += depth;
-#if 0
-	fprintf(stderr, "after: stackDepth %d\n", envPtr->currStackDepth);
-#endif
-	fflush(stderr);
-    }
+	/* Add the (label_name, address) pair to the hash table */
+	if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
+	    goto cleanup;
+	}
+	StartBasicBlock(assemEnvPtr, 1, NULL);
 
-    Tcl_DeleteHashTable(&labelHash); // Actually, we need to free each label as well.
+	/* Attach the label to the new basic block */
 
-    return result;
+	/* 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:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
+	    goto cleanup;
+	}
+	if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+	    goto cleanup;
+	}
+	BBEmitInst1or4(assemEnvPtr, tblind, localVar, 0);
+	break;
 
+    case ASSEM_LVT1:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
+	    goto cleanup;
+	}
+	if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
+	    || CheckOneByte(interp, localVar)) {
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblind, localVar, 0);
+	break;
+
+    case ASSEM_LVT1_SINT1:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
+	    goto cleanup;
+	}
+	if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
+	    || CheckOneByte(interp, localVar)
+	    || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckSignedOneByte(interp, opnd)) {
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblind, localVar, 0);
+	TclEmitInt1(opnd, envPtr);
+	break;
+
+    case ASSEM_LVT4:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
+	    goto cleanup;
+	}
+	if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, localVar, 0);
+	break;
+
+    case ASSEM_OVER:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+	break;
+
+    case ASSEM_REVERSE:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+	break;
+		 
+    case ASSEM_SINT1:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckSignedOneByte(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
+	break;
+
+    default:
+	Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
+		  Tcl_GetString(instNameObj));
+    }
+
+    status = TCL_OK;
  cleanup:
+    if (instNameObj) {
+	Tcl_DecrRefCount(instNameObj);
+    }
+    if (operand1Obj) {
+	Tcl_DecrRefCount(operand1Obj);
+    }
+    return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetNextOperand --
+ *
+ *	Retrieves the next operand in sequence from an assembly
+ *	instruction, and makes sure that its value is known at
+ *	compile time.
+ *
+ * Results:
+ *	If successful, returns TCL_OK and leaves a Tcl_Obj with
+ *	the operand text in *operandObjPtr. In case of failure,
+ *	returns TCL_ERROR and leaves *operandObjPtr untouched.
+ *
+ * Side effects:
+ *	Advances *tokenPtrPtr around the token just processed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetNextOperand(AssembleEnv* assemEnvPtr,
+				/* Assembler environment */
+	       Tcl_Token** tokenPtrPtr,
+				/* INPUT/OUTPUT: Pointer to the token
+				 * holding the operand */
+	       Tcl_Obj** operandObjPtr)
+				/* OUTPUT: Tcl object holding the
+				 * operand text with \-substitutions 
+				 * done. */
+{
+    Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr;
+    Tcl_Obj* operandObj = Tcl_NewObj();
+    if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
+	Tcl_DecrRefCount(operandObj);
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj("assembly code may not "
+					      "contain substitutions", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
+	}
+	return TCL_ERROR;
+    }
+    *tokenPtrPtr = TokenAfter(*tokenPtrPtr);
+    Tcl_IncrRefCount(operandObj);
+    *operandObjPtr = operandObj;
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetBooleanOperand --
+ *
+ *	Retrieves a Boolean operand from the input stream and advances
+ *	the token pointer.
+ *
+ * Results:
+ *	Returns a standard Tcl result (with an error message in the
+ *	interpreter on failure).
+ *
+ * Side effects:
+ *	Stores the Boolean value in (*result) and advances (*tokenPtrPtr)
+ *	to the next token.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetBooleanOperand(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
+		  Tcl_Token** tokenPtrPtr,
+				/* Current token from the parser */
+		  int* result)
+				/* OUTPUT: Integer extracted from the token */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    Tcl_Token* tokenPtr = *tokenPtrPtr;
+				/* INOUT: Pointer to the next token
+				 * in the source code */
+    Tcl_Obj* intObj = Tcl_NewObj();
+				/* Integer from the source code */
+    int status;			/* Tcl status return */
+
+    /* Extract the next token as a string */
+
+    Tcl_IncrRefCount(intObj);
+    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
+	Tcl_DecrRefCount(intObj);
+	return TCL_ERROR;
+    }
     
-    /* FIXME: Need to make sure that allocated memory gets freed. */
+    /* Convert to an integer, advance to the next token and return */
+
+    status = Tcl_GetBooleanFromObj(interp, intObj, result);
+    Tcl_DecrRefCount(intObj);
+    *tokenPtrPtr = TokenAfter(tokenPtr);
+    return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetIntegerOperand --
+ *
+ *	Retrieves an integer operand from the input stream and advances
+ *	the token pointer.
+ *
+ * Results:
+ *	Returns a standard Tcl result (with an error message in the
+ *	interpreter on failure).
+ *
+ * Side effects:
+ *	Stores the integer value in (*result) and advances (*tokenPtrPtr)
+ *	to the next token.
+ *
+ *-----------------------------------------------------------------------------
+ */
 
-    if (ind >= 0 && ind < bcSize) {
-	Tcl_AddErrorInfo(interp, "\n    processing ");
-	AddInstructionToErrorInfo(interp, bcList, ind);
+static int
+GetIntegerOperand(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
+		  Tcl_Token** tokenPtrPtr,
+				/* Current token from the parser */
+		  int* result)
+				/* OUTPUT: Integer extracted from the token */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    Tcl_Token* tokenPtr = *tokenPtrPtr;
+				/* INOUT: Pointer to the next token
+				 * in the source code */
+    Tcl_Obj* intObj = Tcl_NewObj();
+				/* Integer from the source code */
+    int status;			/* Tcl status return */
+
+    /* Extract the next token as a string */
+
+    Tcl_IncrRefCount(intObj);
+    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
+	Tcl_DecrRefCount(intObj);
+	return TCL_ERROR;
     }
+    
+    /* Convert to an integer, advance to the next token and return */
+
+    status = Tcl_GetIntFromObj(interp, intObj, result);
+    Tcl_DecrRefCount(intObj);
+    *tokenPtrPtr = TokenAfter(tokenPtr);
+    return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FindLocalVar --
+ *
+ *	Gets the name of a local variable from the input stream and advances
+ *	the token pointer.
+ *
+ * Results:
+ *	Returns the LVT index of the local variable.  Returns -1 if
+ *	the variable is non-local, not known at compile time, or
+ *	cannot be installed in the LVT (leaving an error message in
+ *	the interpreter result if necessary).
+ *
+ * Side effects:
+ *	Advances the token pointer.  May define a new LVT slot if the
+ *	variable has not yet been seen and the execution context allows
+ *	for it.
+ *
+ *-----------------------------------------------------------------------------
+ */
 
-    /* TODO: If ind != -1, add error info indicating where in the
-     * instruction stream things went wrong */
+static int
+FindLocalVar(AssembleEnv* assemEnvPtr,
+	     Tcl_Token** tokenPtrPtr)
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    Tcl_Token* tokenPtr = *tokenPtrPtr;
+				/* INOUT: Pointer to the next token
+				 * in the source code */
+    Tcl_Obj* varNameObj = Tcl_NewObj();
+				/* Name of the variable */
+    const char* varNameStr;
+    int varNameLen;
+    int localVar;		/* Index of the variable in the LVT */
+
+    Tcl_IncrRefCount(varNameObj);
+    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
+	Tcl_DecrRefCount(varNameObj);
+	return -1;
+    }
+    varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
+    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
+	return -1;
+    }
+    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
+    Tcl_DecrRefCount(varNameObj);
+    if (localVar == -1) {
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj("cannot use this instruction"
+					      " in non-proc context", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
+	}
+	return -1;
+    }
+    *tokenPtrPtr = TokenAfter(tokenPtr);
+    return localVar;
+}
+
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * SyncStackDepth --
+ *
+ *	Copies the stack depth from the compile environment to a basic
+ *	block.
+ *
+ * Side effects:
+ *	Current and max stack depth in the current basic block are
+ *	adjusted.
+ *
+ * This procedure is called on return from invoking the compiler for
+ * the 'eval' and 'expr' operations. It adjusts the stack depth of the
+ * current basic block to reflect the stack required by the just-compiled
+ * code.
+ *
+ *-----------------------------------------------------------------------------
+ */
 
-    return TCL_ERROR;
+static void
+SyncStackDepth(AssembleEnv* assemEnvPtr)
+				/* Assembly environment */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
+				/* Current basic block */
+    int maxStackDepth = curr_bb->finalStackDepth + envPtr->maxStackDepth;
+				/* Max stack depth in the basic block */
 
+    if (maxStackDepth > curr_bb->maxStackDepth) {
+	curr_bb->maxStackDepth = maxStackDepth;
+    }
+    curr_bb->finalStackDepth += envPtr->currStackDepth;
 }
 
 /*
@@ -1118,12 +1522,14 @@ TclAssembleCode(Tcl_Interp *interp,
 static int
 CheckNamespaceQualifiers(Tcl_Interp* interp,
 				/* Tcl interpreter for error reporting */
-			 const char* name)
+			 const char* name,
 				/* Variable name to check */
+			 int nameLen)
+				/* Length of the variable */
 {
     Tcl_Obj* result;		/* Error message */
     const char* p;
-    for (p = name; *p;  p++) {      
+    for (p = name; p+2 < name+nameLen;  p++) {      
 	if ((*p == ':') && (p[1] == ':')) {
 	    result = Tcl_NewStringObj("variable \"", -1);
 	    Tcl_AppendToObj(result, name, -1);
@@ -1220,11 +1626,13 @@ CheckSignedOneByte(Tcl_Interp* interp,
  */
 
 static int
-DefineLabel(Tcl_Interp* interp, 	/* Tcl interpreter */
-	    CompileEnv* envPtr,		/* Compilation environment */
-	    const char* labelName,	/* Label being defined */
-	    Tcl_HashTable* labelHash)	/* Symbol table */
+DefineLabel(AssembleEnv* assemEnvPtr,	/* Assembly environment */
+	    const char* labelName)	/* Label being defined */
 {
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
     Tcl_HashEntry* entry;	/* Label's entry in the symbol table */
     int isNew;			/* Flag == 1 iff the label was previously
 				 * undefined */
@@ -1233,7 +1641,7 @@ DefineLabel(Tcl_Interp* interp, 	/* Tcl interpreter */
 
     /* Look up the newly-defined label in the symbol table */
 
-    entry = Tcl_CreateHashEntry(labelHash, labelName, &isNew);
+    entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
     if (isNew) {
 
 	/* This is the first appearance of the label in the code */
@@ -1294,25 +1702,21 @@ DefineLabel(Tcl_Interp* interp, 	/* Tcl interpreter */
  */
 
 static BasicBlock*
-StartBasicBlock(CompileEnv* envPtr, 
-				/* Compilation environment */
-		Tcl_HashTable* BBHashPtr,
-				/* Hash table where basic blocks are recorded */
-		BasicBlock* currBB,
-				/* Pointer to the BasicBlock structure
-				 * of the block being closed. */
+StartBasicBlock(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
 		int fallsThrough,
 				/* 1 if execution falls through into
 				 * the following block, 0 otherwise */
-		int bcIndex,	/* Index of the current insn in the
-				 * assembly stream */
 		const char* jumpLabel)
 				/* Label of the location that the
 				 * block jumps to, or NULL if the block
 				 * does not jump */
 {
-    int isNew;		 /* Unused return from Tcl_CreateHashEntry */
-    BasicBlock* newBB;	 /* BasicBlock structure for the new basic block */
+    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 */
 
@@ -1322,13 +1726,13 @@ StartBasicBlock(CompileEnv* envPtr,
 
     /* Make the new basic block */
 
-    newBB = AllocBB(envPtr, bcIndex);
+    newBB = AllocBB(assemEnvPtr);
 
     /* Record the jump target if there is one. */
 
     if (jumpLabel) {
 	currBB->jumpTargetLabelHashEntry =
-	    Tcl_CreateHashEntry(BBHashPtr, jumpLabel, &isNew);
+	    Tcl_CreateHashEntry(&assemEnvPtr->BBHash, jumpLabel, &isNew);
     } else {
 	currBB->jumpTargetLabelHashEntry = NULL;
     }
@@ -1340,6 +1744,7 @@ StartBasicBlock(CompileEnv* envPtr,
     /* Record the successor block */
 
     currBB->successor1 = newBB;
+    assemEnvPtr->curr_bb = newBB;
     return newBB;
 }
 
@@ -1358,15 +1763,14 @@ StartBasicBlock(CompileEnv* envPtr,
  */
 
 static BasicBlock * 
-AllocBB(CompileEnv* envPtr,	/* Compile environment containing the
-				 * current instruction pointer */
-	int bcIndex)		/* Current index in the list of
-				 * assembly instructions */
+AllocBB(AssembleEnv* assemEnvPtr)
+				/* Assembly environment */
 {
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
     BasicBlock * bb = (BasicBlock *) ckalloc(sizeof(BasicBlock));
 
     bb->start = envPtr->codeNext;
-    bb->bcIndex = bcIndex;
+    bb->startLine = assemEnvPtr->cmdLine;
     bb->initialStackDepth = 0;
     bb->minStackDepth = 0;
     bb->maxStackDepth = 0;
@@ -1380,89 +1784,291 @@ AllocBB(CompileEnv* envPtr,	/* Compile environment containing the
 
     return bb;
 }
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FinishAssembly --
+ *
+ *	Postprocessing after all bytecode has been generated for a block
+ *	of assembly code.
+ *
+ * Results:
+ *	Returns a standard Tcl result, with an error message left in the
+ *	interpreter if appropriate.
+ *
+ * Side effects:
+ *	The program is checked to see if any undefined labels remain.
+ *	The initial stack depth of all the basic blocks in the flow graph
+ *	is calculated and saved.  The stack balance on exit is computed,
+ *	checked and saved.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int 
+FinishAssembly(AssembleEnv* assemEnvPtr)
+				/* Assembly environment */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
+				/* Last basic block in the program */
+    Tcl_Obj* depthObj;		/* Depth of the stack on exit */
+    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;
+
+    /* Compute stack balance throughout the program */
+
+    if (CheckStack(assemEnvPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* TODO - Check for unreachable code */
+
+    /* If the exit is reachable, make sure that the program exits with
+     * 1 operand on the stack. */
+
+    if (curr_bb->visited) {
+
+	/* Exit with no operands; push an empty one. */
+
+	int depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
+	if (depth == 0) {
+	    /* Emit a 'push' of the empty literal */
+	    litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+	    /* Assumes that 'push' is at slot 0 in talInstructionTable */
+	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
+	    ++depth;
+	}
+
+	/* Exit with unbalanced stack */
+
+	if (depth != 1) {
+	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+		depthObj = Tcl_NewIntObj(depth);
+		Tcl_IncrRefCount(depthObj);
+		resultObj = Tcl_NewStringObj("stack is unbalanced on exit "
+					     "from the code (depth=", -1);
+		Tcl_AppendObjToObj(resultObj, depthObj);
+		Tcl_DecrRefCount(depthObj);
+		Tcl_AppendToObj(resultObj, ")", -1);
+		Tcl_SetObjResult(interp, resultObj);
+		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+	    }
+	    return TCL_ERROR;
+	}
+
+	/* Record stack usage */
+
+	envPtr->currStackDepth += depth;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckStack --
+ *
+ *	Audit stack usage in a block of assembly code.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Updates stack depth on entry for all basic blocks in the flowgraph.
+ *	Calculates the max stack depth used in the program, and updates the
+ *	compilation environment to reflect it.
+ *
+ *-----------------------------------------------------------------------------
+ */
 
 static int
-CheckStack(Tcl_Interp* interp,
-	   CompileEnv* envPtr,
-	   BasicBlock * head,
-	   Tcl_Obj* bcList) {
-    StackCheckerState st;
-    st.interp = interp;
-    st.maxDepth = 0;
-    st.envPtr = envPtr;
-    st.bcList = bcList;
-    if(StackCheckBasicBlock(&st, head, NULL, 0) == TCL_ERROR) {
+CheckStack(AssembleEnv* assemEnvPtr)
+				/* Assembly environment */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    int maxDepth;		/* Maximum stack depth overall */
+
+    /* Checking the head block will check all the other blocks  recursively. */
+
+    assemEnvPtr->maxDepth = 0;
+    if(StackCheckBasicBlock(assemEnvPtr,
+			    assemEnvPtr->head_bb, NULL, 0) == TCL_ERROR) {
         return TCL_ERROR;
     }
-#if 0
-    fprintf(stderr, "Max stack anywhere is %d\n", st->maxDepth);
-#endif
-    if (st.maxDepth + envPtr->currStackDepth > envPtr->maxStackDepth) {
-	envPtr->maxStackDepth = st.maxDepth + envPtr->currStackDepth;
+
+    /* Post the max stack depth back to the compilation environment */
+
+    maxDepth = assemEnvPtr->maxDepth + envPtr->currStackDepth;
+    if (maxDepth > envPtr->maxStackDepth) {
+	envPtr->maxStackDepth = maxDepth;
     }
+
     return TCL_OK;
 }
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StackCheckBasicBlock --
+ *
+ *	Checks stack consumption for a basic block (and recursively for
+ *	its successors).
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Updates initial stack depth for the basic block and its
+ *	successors. (Final and maximum stack depth are relative to
+ *	initial, and are not touched).
+ *
+ * This procedure eventually checks, for the entire flow graph, whether
+ * stack balance is consistent.  It is an error for a given basic block
+ * to be reachable along multiple flow paths with different stack depths.
+ *
+ *-----------------------------------------------------------------------------
+ */
 
 static int
-StackCheckBasicBlock(StackCheckerState *st, BasicBlock * blockPtr, BasicBlock * predecessor, int initialStackDepth) { 
-#if 0
-    CompileEnv* envPtr = st->envPtr;
-    fprintf(stderr, "stack check basic block %p at depth %d\n", 
-	    blockPtr, initialStackDepth);
-    fprintf(stderr, "  start %d may_fall_thru %d visited %d\n",
-	    blockPtr->start - envPtr->codeStart,
-	    blockPtr->may_fall_thru, blockPtr->visited);
-    fprintf(stderr, "  predecessor %p successor1 %p\n", 
-	    blockPtr->predecessor, blockPtr->successor1);
-    fprintf(stderr, "  stack: init %d min %d max %d final %d\n",
-	    blockPtr->initialStackDepth, blockPtr->minStackDepth,
-	    blockPtr->maxStackDepth, blockPtr->finalStackDepth);
-    fflush(stderr);
-#endif    
+StackCheckBasicBlock(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
+		     BasicBlock* blockPtr,
+				/* Pointer to the basic block being checked */
+		     BasicBlock* predecessor,
+				/* Pointer to the block that passed control
+				 * to this one. */
+		     int initialStackDepth) 
+				/* Stack depth on entry to the block */
+{ 
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    int stackDepth;		/* Current stack depth */
+    int maxDepth;		/* Maximum stack depth so far */
+    int result;			/* Tcl status return */
+
     if (blockPtr->visited) {
+
+	/* 
+	 * If the block is already visited, check stack depth for consistency
+	 * among the paths that reach it.
+	 */
         if (blockPtr->initialStackDepth != initialStackDepth) {
-	    Tcl_SetObjResult(st->interp, Tcl_NewStringObj("inconsistent stack depths on two execution paths", -1));
-            /* Trace the offending BasicBlock */
-	    Tcl_AddErrorInfo(st->interp, "\n    to ");
-	    AddInstructionToErrorInfo(st->interp, st->bcList, 
-				      blockPtr->bcIndex);
-	    /* TODO - add execution trace of both paths */
+	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+		Tcl_SetObjResult(interp,
+				 Tcl_NewStringObj("inconsistent stack depths "
+						  "on two execution paths",
+						  -1));
+		/* TODO - add execution trace of both paths */
+		Tcl_SetErrorLine(interp, blockPtr->startLine);
+		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+	    }
             return TCL_ERROR;
         } else {
             return TCL_OK;
         }
-    } else {
+    }
 
-        blockPtr->visited = 1;
-        blockPtr->predecessor = predecessor;
-        blockPtr->initialStackDepth = initialStackDepth;
-        if (initialStackDepth + blockPtr->minStackDepth < 0) {
-	    Tcl_SetObjResult(st->interp,
+    /*
+     * If the block is not already visited, set the 'predecessor'
+     * link to indicate how control got to it. Set the initial stack
+     * depth to the current stack depth in the flow of control.
+     * Calculate max and min stack depth, flag an error if the
+     * block underflows the stack, and update max stack depth in the
+     * assembly environment.
+     */
+    blockPtr->visited = 1;
+    blockPtr->predecessor = predecessor;
+    blockPtr->initialStackDepth = initialStackDepth;
+    if (initialStackDepth + blockPtr->minStackDepth < 0) {
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp,
 			     Tcl_NewStringObj("stack underflow", -1));
-	    AddBasicBlockRangeToErrorInfo(st->interp, st->bcList, blockPtr);
-            return TCL_ERROR;
-        }
-        if (initialStackDepth + blockPtr->maxStackDepth > st->maxDepth) {
-            st->maxDepth = initialStackDepth + blockPtr->maxStackDepth;
-        }
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+	    Tcl_SetErrorLine(interp, blockPtr->startLine);
+	}
+	return TCL_ERROR;
     }
-    int stackDepth = initialStackDepth + blockPtr->finalStackDepth;
-    int result = TCL_OK;
-#if 0
-    fprintf(stderr, "on exit from block, depth will be %d\n", stackDepth);
-    fflush(stderr);
-#endif
+    maxDepth = initialStackDepth + blockPtr->maxStackDepth;
+    if (maxDepth > assemEnvPtr->maxDepth) {
+	assemEnvPtr->maxDepth = maxDepth;
+    }
+    
+    /*
+     * Calculate stack depth on exit from the block, and invoke this
+     * procedure recursively to check successor blocks
+     */
+
+    stackDepth = initialStackDepth + blockPtr->finalStackDepth;
+    result = TCL_OK;
     if (blockPtr->may_fall_thru) {
-        result = StackCheckBasicBlock(st, blockPtr->successor1, blockPtr, stackDepth);        
+        result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1,
+				      blockPtr, stackDepth);        
         
     }
-    /* FIXME Have we checked for undefined labels yet ? */
     if (result == TCL_OK && blockPtr->jumpTargetLabelHashEntry != NULL) {
-        BasicBlock * targetBlock = (BasicBlock *) Tcl_GetHashValue(blockPtr->jumpTargetLabelHashEntry);
-        result = StackCheckBasicBlock(st, targetBlock, blockPtr, stackDepth);
+        BasicBlock * targetBlock = (BasicBlock *)
+	    Tcl_GetHashValue(blockPtr->jumpTargetLabelHashEntry);
+        result = StackCheckBasicBlock(assemEnvPtr, targetBlock, blockPtr,
+				      stackDepth);
     }
     return result;
-    
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * AddBasicBlockRangeToErrorInfo --
+ *
+ *	Updates the error info of the Tcl interpreter to show a given
+ *	basic block in the code.
+ *
+ * This procedure is used to label the callstack with source location
+ * information when reporting an error in stack checking.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+AddBasicBlockRangeToErrorInfo(AssembleEnv* assemEnvPtr,
+				/* Assembly environment */
+			      BasicBlock* bbPtr)
+				/* Basic block in which the error is
+				 * found */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    Tcl_Obj* lineNo;		/* Line number in the source */
+
+    Tcl_AddErrorInfo(interp, "\n    in assembly code between lines ");
+    lineNo = Tcl_NewIntObj(bbPtr->startLine);
+    Tcl_IncrRefCount(lineNo);
+    Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+    Tcl_AddErrorInfo(interp, " and ");
+    if (bbPtr->successor1 != NULL) {
+	Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
+	Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
+    } else {
+	Tcl_AddErrorInfo(interp, "end of assembly code");
+    }
+    Tcl_DecrRefCount(lineNo);
 }
 
 /*
@@ -1496,42 +2102,4 @@ FreeAssembleCodeInternalRep(
     objPtr->typePtr = NULL;
     objPtr->internalRep.otherValuePtr = NULL;
 }
-
-static void
-AddBasicBlockRangeToErrorInfo(Tcl_Interp* interp,
-			      Tcl_Obj* bcList,
-			      BasicBlock* bbPtr)
-{
-    Tcl_AddErrorInfo(interp, "\n    between ");
-    AddInstructionToErrorInfo(interp, bcList, bbPtr->bcIndex);
-    Tcl_AddErrorInfo(interp, "\n    and ");
-    if (bbPtr->successor1 != NULL) {
-	AddInstructionToErrorInfo(interp, bcList,
-				  bbPtr->successor1->bcIndex);
-    } else {
-	Tcl_AddErrorInfo(interp, "end of assembly code");
-    }
-}
-
-static void
-AddInstructionToErrorInfo(Tcl_Interp* interp,
-			  Tcl_Obj* bcList,
-			  int bcIndex)
-{
-    Tcl_Obj* msgObj;
-    int msgLen;
-    const char* msgPtr;
-
-    Tcl_AddErrorInfo(interp, "source instruction at list index ");
-    msgObj = Tcl_NewIntObj(bcIndex);
-    Tcl_IncrRefCount(msgObj);
-    msgPtr = Tcl_GetStringFromObj(msgObj, &msgLen);
-    Tcl_AddObjErrorInfo(interp, msgPtr, msgLen);
-    Tcl_DecrRefCount(msgObj);
-    Tcl_AddErrorInfo(interp, " (\"");
-    Tcl_ListObjIndex(NULL, bcList, bcIndex, &msgObj);
-    msgPtr = Tcl_GetStringFromObj(msgObj, &msgLen);
-    Tcl_AddObjErrorInfo(interp, msgPtr, msgLen);
-    Tcl_AddErrorInfo(interp, "\")");
-}