<verbatim>

* generic/tclAssembly.c (new file):
* generic/tclBasic.c (Tcl_CreateInterp):
* generic/tclInt.h:
* tests/assemble.test (new file):
* unix/Makefile.in:
* win/Makefile.in:
* win/makefile.vc:  Merged dogeen-assembler-branch into HEAD.
   Since all functional changes are in the tcl::unsupported namespace,
   there's no reason to sequester this code on a separate branch.
</verbatim>

9 files changed, 7895 insertions, 8 deletions

diff --git a/ChangeLog b/ChangeLog
index 7c6a50c..b00a325 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,12 +1,24 @@
+2011-03-05  Kevin B. Kenny  <kennykb@acm.org>
+
+	* generic/tclAssembly.c (new file):
+	* generic/tclBasic.c (Tcl_CreateInterp):
+	* generic/tclInt.h:
+	* tests/assemble.test (new file):
+	* unix/Makefile.in:
+	* win/Makefile.in:
+	* win/makefile.vc:  Merged dogeen-assembler-branch into HEAD.
+	Since all functional changes are in the tcl::unsupported namespace,
+	there's no reason to sequester this code on a separate branch.
+
 2011-03-05  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclExecute.c: cleaner mem management for TEBCdata
 
 	* generic/tclExecute.c:
 	* tests/nre.test: Renamed BottomData to TEBCdata, so that the name
-	refers to what it is rather than to its storage location. 
-	
-	* generic/tclBasic.c:     Renamed struct TEOV_callback to 
+	refers to what it is rather than to its storage location.
+
+	* generic/tclBasic.c:     Renamed struct TEOV_callback to
 	* generic/tclCompExpr.c:  the more descriptive NRE_callback.
 	* generic/tclCompile.c:
 	* generic/tclExecute.c:
@@ -37,9 +49,9 @@
 
 2011-03-01  Miguel Sofer  <msofer@users.sf.net>
 
-	* generic/tclCompCmdsSZ.c (TclCompileThrowCmd, TclCompileUnsetCmd): 
+	* generic/tclCompCmdsSZ.c (TclCompileThrowCmd, TclCompileUnsetCmd):
 	fix leaks
-	
+
 	* generic/tclBasic.c:       This is [Patch 3168398],
 	* generic/tclCompCmdsSZ.c:  Joe Mistachkin's optimisation
 	* generic/tclExecute.c:     of Tip #285
@@ -55,8 +67,8 @@
 
 	* generic/tclExecute.c (TEBCresume): store local var array and
 	constants in automatic vars to reduce indirection, slight perf
-	increase 
-	
+	increase
+
 	* generic/tclOOCall.c (TclOODeleteContext): added missing '*' so
 	that trunk compiles.
 
@@ -238,6 +250,16 @@
 	* generic/tclPanic.c:  [Patch 3124554]: Move WishPanic from Tk to Tcl
 	* win/tclWinFile.c:    Better communication with debugger, if present.
 
+2010-12-15  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* tclAssembly.c:
+	* assemble.test: 	Reworked beginCatch/endCatch handling to
+	enforce the more severe (but more correct) restrictions on catch
+	handling that appeared in the discussion of [Bug 3098302] and in
+	tcl-core traffic beginning about 2010-10-29.
+
 2010-12-15  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclPanic.c:    Restore abort() as it was before.
@@ -599,6 +621,12 @@
 	* generic/tclTimer.c:	[Bug 2905784]: Stop small [after]s from
 				wasting CPU while keeping accuracy.
 
+2010-10-28  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+	* generic/tclAssembly.c:
+	* tests/assembly.test (assemble-31.*): Added jump tables.
+
 2010-10-28  Don Porter  <dgp@users.sourceforge.net>
 
 	* tests/http.test:	[Bug 3097490]: Make http-4.15 pass in
@@ -626,6 +654,23 @@
 	[fconfigure -sockname] and [fconfigure -peername] from doing
 	reverse DNS queries.
 
+2010-10-24  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+	* generic/tclAssembly.c:
+	* tests/assembly.test (assemble-17.15): Reworked branch handling so that
+	forward branches can use jump1 (jumpTrue1, jumpFalse1). Added test
+	cases that the forward branches will expand to jump4, jumpTrue4,
+	jumpFalse4 when needed.
+
+2010-10-23  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+	* generic/tclAssembly.h (removed):
+				Removed file that was included in only one
+				source file.
+	* generictclAssembly.c:	Inlined tclAssembly.h.
+
 2010-10-17  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
 
 	* doc/info.n:            [Patch 2995655]:
@@ -741,6 +786,23 @@
 	* generic/tclCompile.c:	[Bug 3081065]: Prevent writing to the intrep
 	* tests/subst.test:	fields of a freed Tcl_Obj.
 
+2010-10-06  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* generic/tclAssembly.c:
+	* generic/tclAssembly.h:
+	* tests/assemble.test: Added catches. Still needs a lot of testing.
+
+2010-10-02  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* generic/tclAssembly.c:
+	* generic/tclAssembly.h:
+	* tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
+	dictSet, dictUnset, nop, regexp, nsupvar, upvar, and variable.
+
 2010-10-02  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclExecute.c (TEBCresume): [Bug 3079830]: Added invalidation
@@ -765,6 +827,31 @@
 	More purging of strcpy() from locations where we already know the
 	length of the data being copied.
 
+2010-10-01  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* tests/assemble.test:
+	* generic/tclAssemble.h:
+	* generic/tclAssemble.c:  Added listIn, listNotIn, and dictGet.
+
+2010-09-30  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* tests/assemble.test:   Added tryCvtToNumeric and several more list
+	* generic/tclAssemble.c: operations.
+	* generic/tclAssemble.h:
+
+2010-09-29  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* tests/assemble.test:   Completed conversion of tests to a
+	* generic/tclAssemble.c: "white box" structure that follows the
+	C code. Added missing safety checks on the operands of 'over' and
+	'reverse' so that negative operand counts don't smash the stack.
+
 2010-09-29  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* unix/configure:	Re-generate with autoconf-2.59
@@ -800,6 +887,35 @@
 				tests running in parallel or other services on
 				the machine.
 
+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]
+
+	* tests/assemble.test: Added more "white box" tests.
+	* generic/tclAssembly.c: Fixed bugs exposed by the new tests.
+	(a) [eval] and [expr] had incorrect stack balance computed if
+	the arg was not a simple word. (b) [concat] accepted a negative
+	operand count. (c) [invoke] accepted a zero or negative operand
+	count. (d) more misspelt error messages.
+	Also replaced a funky NRCallTEBC with the new call
+	TclNRExecuteByteCode, necessitated by a merge with changes on the
+	HEAD.
+
 2010-09-26  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclBasic.c:    [Patch 3072080] (minus the itcl
@@ -823,6 +939,31 @@
 	duplication, let the runtime var resolver call the compiled var
 	resolver.
 
+2010-09-26  Kevin B. Kenny  <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* tests/assemble.test:	Added many new tests moving toward a more
+	comprehensive test suite for the assembler.
+	* generic/tclAssembly.c:	Fixed bugs exposed by the new tests:
+	(a) [bitnot] and [not] had incorrect operand counts. (b)
+	INST_CONCAT cannot concatenate zero objects. (c) misspelt error
+	messages. (d) the "assembly code" internal representation lacked
+	a duplicator, which caused double-frees of the Bytecode object
+	if assembly code ever was duplicated.
+
+2010-09-25  Kevin B. Kenny   <kennykb@acm.org>
+
+	[dogeen-assembler-branch]
+
+	* generic/tclAssembly.c:	Massive refactoring of the assembler
+	* generic/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.
+
 2010-09-24  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* tests/stringComp.test: improved string eq/cmp test coverage
@@ -884,6 +1025,22 @@
 	* generic/tclResult.c (TclMergeReturnOptions): Use memcmp where
 	applicable as possible speedup on some libc variants.
 
+2010-09-21  Kevin B. Kenny  <kennykb@acm.org>
+
+	[BRANCH: dogeen-assembler-branch]
+
+	* generic/tclAssembly.c (new file): 
+	* generic/tclAssembly.h:
+	* generic/tclBasic.c (builtInCmds, Tcl_CreateInterp):
+	* generic/tclInt.h:
+	* tests/assemble.test (new file):
+	* tests/assemble1.bench (new file):
+	* unix/Makefile.in:
+	* win/Makefile.in:
+	* win/Makefile.vc:
+		Initial commit of Ozgur Dogan Ugurlu's (SF user: dogeen)
+		assembler for the Tcl bytecode language.
+
 2010-09-21  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tclWinFile.c:   Fix declaration after statement.
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
new file mode 100644
index 0000000..26372c6
--- /dev/null
+++ b/generic/tclAssembly.c
@@ -0,0 +1,4176 @@
+/*
+ * tclAssembly,c --
+ *
+ *	Assembler for Tcl bytecodes.
+ *
+ * This file contains the procedures that convert Tcl Assembly Language
+ * (TAL) to a sequence of bytecode instructions for the Tcl execution engine.
+ *
+ * Copyright (c) 2010 by Ozgur Dogan Ugurlu.
+ * Copyright (c) 2010 by Kevin B. Kenny.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclAssembly.c,v 1.1.2.18 2010/12/16 01:40:42 kennykb Exp $
+ */
+
+/*-
+ *- THINGS TO DO:
+ *- More instructions:
+ *-   done - alternate exit point (affects stack and exception range checking)
+ *-   break and continue - if exception ranges can be sorted out.
+ *-   foreach_start4, foreach_step4
+ *-   returnImm, returnStk
+ *-   expandStart, expandStkTop, invokeExpanded
+ *-   dictFirst, dictNext, dictDone
+ *-   dictUpdateStart, dictUpdateEnd
+ *-   jumpTable testing
+ *-   syntax (?)
+ *-   returnCodeBranch
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include "tclOOInt.h"
+
+/* Structure that represents a range of instructions in the bytecode */
+
+typedef struct CodeRange {
+    int startOffset;		/* Start offset in the bytecode array */
+    int endOffset;		/* End offset in the bytecode array */
+} CodeRange;
+
+/* State identified for a basic block's catch context */
+
+typedef enum BasicBlockCatchState {
+    BBCS_UNKNOWN = 0,		/* Catch context has not yet been identified */
+    BBCS_NONE,			/* Block is outside of any catch */
+    BBCS_INCATCH,		/* Block is within a catch context */
+    BBCS_CAUGHT,		/* Block is within a catch context and
+				 * may be executed after an exception fires */
+} BasicBlockCatchState;
+
+/* 
+ * Structure that defines a basic block - a linear sequence of bytecode
+ * instructions with no jumps in or out (including not changing the
+ * state of any exception range).
+ */
+
+typedef struct BasicBlock {
+
+    int originalStartOffset;	/* Instruction offset before JUMP1s
+				 * were substituted with JUMP4's */
+    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 jumpOffset;	        /* Bytecode offset of the 'jump' instruction
+				 * that ends the block, or -1 if there is no
+				 * jump. */
+    int jumpLine;	        /* Line number in the input script of the
+				 * 'jump' instruction that ends the block,
+				 * or -1 if there is no jump */
+    struct BasicBlock* prevPtr;	/* Immediate predecessor of this block */
+    struct BasicBlock* predecessor;	
+				/* Predecessor of this block in the
+				 * spanning tree */
+    struct BasicBlock * successor1;
+				/* BasicBlock structure of the following 
+				 * block:  NULL at the end of the bytecode 
+				 * sequence. */
+    Tcl_Obj * jumpTarget;	/* Jump target label if the jump target 
+				 * is unresolved */
+    
+    int initialStackDepth;	/* Absolute stack depth on entry */
+    int minStackDepth;		/* Low-water relative stack depth */
+    int maxStackDepth; 		/* High-water relative stack depth */
+    int finalStackDepth;	/* Relative stack depth on exit */
+
+    enum BasicBlockCatchState catchState;
+				/* State of the block for 'catch' analysis */
+    int catchDepth;		/* Number of nested catches in which the
+				 * basic block appears */
+    struct BasicBlock* enclosingCatch;
+				/* BasicBlock structure of the last
+				 * startCatch executed on a path to this 
+				 * block, or NULL if there is no
+				 * enclosing catch */
+
+    int foreignExceptionBase;	/* Base index of foreign exceptions */
+    int foreignExceptionCount;	/* Count of foreign exceptions */
+    ExceptionRange* foreignExceptions;
+				/* ExceptionRange structures for
+				 * exception ranges belonging to embedded
+				 * scripts and expressions in this block */
+
+    JumptableInfo* jtPtr;	/* Jump table at the end of this basic block */
+
+    int flags;			/* Boolean flags */
+
+} BasicBlock;
+
+/* Flags that pertain to a basic block */
+
+enum BasicBlockFlags {
+    BB_VISITED = (1 << 0),	/* Block has been visited in the current
+				 * traversal */
+    BB_FALLTHRU = (1 << 1),	/* Control may pass from this block to
+				 * a successor */
+    BB_JUMP1 = (1 << 2),	/* Basic block ends with a 1-byte-offset
+				 * jump and may need expansion */
+    BB_JUMPTABLE = (1 << 3),	/* Basic block ends with a jump table */
+    BB_BEGINCATCH = (1 << 4),	/* Block ends with a 'beginCatch' instruction,
+				 * marking it as the start of a 'catch' 
+				 * sequence. The 'jumpTarget' is the exception
+				 * exit from the catch block. */
+    BB_ENDCATCH = (1 << 5),	/* Block ends with an 'endCatch' instruction,
+				 * unwinding the catch from the exception 
+				 * stack. */
+};
+
+/* Source instruction type recognized by the assembler */
+
+typedef enum TalInstType {
+
+    ASSEM_1BYTE,    /* Fixed arity, 1-byte instruction */
+    ASSEM_BEGIN_CATCH,
+		    /* Begin catch: one 4-byte jump offset to be converted
+		     * to appropriate exception ranges */
+    ASSEM_BOOL,	    /* One Boolean operand */
+    ASSEM_BOOL_LVT4,/* One Boolean, one 4-byte LVT ref. */
+    ASSEM_CONCAT1,  /* 1-byte unsigned-integer operand count, must be 
+		     * strictly positive, consumes N, produces 1 */
+    ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1 operands,
+		     * produces 1, N > 0 */
+    ASSEM_DICT_SET, /* specifies key count and LVT index, consumes N+1 operands,
+		     * produces 1, N > 0 */
+    ASSEM_DICT_UNSET,
+		    /* specifies key count and LVT index, consumes N operands,
+		     * produces 1, N > 0 */
+    ASSEM_END_CATCH,/* End catch. No args. Exception range popped from stack
+		     * and stack pointer restored. */
+    ASSEM_EVAL,	    /* 'eval' - evaluate a constant script (by compiling it
+		     * in line with the assembly code! I love Tcl!) */
+    ASSEM_INDEX,    /* 4 byte operand, integer or end-integer */
+    ASSEM_INVOKE,   /* 1- or 4-byte operand count, must be strictly positive,
+		     * consumes N, produces 1. */
+    ASSEM_JUMP,	    /* Jump instructions */
+    ASSEM_JUMP4,    /* Jump instructions forcing a 4-byte offset */
+    ASSEM_JUMPTABLE,/* Jumptable (switch -exact) */
+    ASSEM_LABEL,    /* The assembly directive that defines a label */
+    ASSEM_LINDEX_MULTI,
+		    /* 4-byte operand count, must be strictly positive,
+		     * consumes N, produces 1 */
+    ASSEM_LIST,     /* 4-byte operand count, must be nonnegative, consumses N,
+		     * produces 1 */
+    ASSEM_LSET_FLAT,/* 4-byte operand count, must be >= 3, consumes N,
+		     * produces 1 */
+    ASSEM_LVT,      /* One operand that references a local variable */
+    ASSEM_LVT1,     /* One 1-byte operand that references a local variable */
+    ASSEM_LVT1_SINT1,
+		    /* One 1-byte operand that references a local variable,
+		     * one signed-integer 1-byte operand */
+    ASSEM_LVT4,     /* One 4-byte operand that references a local variable */
+    ASSEM_OVER,	    /* OVER: 4-byte operand count, consumes N+1, produces N+2 */
+    ASSEM_PUSH,     /* one literal operand */
+    ASSEM_REGEXP,   /* One Boolean operand, but weird mapping to call flags */
+    ASSEM_REVERSE,  /* REVERSE: 4-byte operand count, consumes N, produces N */
+    ASSEM_SINT1,    /* One 1-byte signed-integer operand (INCR_STK_IMM) */
+    ASSEM_SINT4_LVT4,
+                    /* Signed 4-byte integer operand followed by LVT entry. 
+		     * Fixed arity */
+} TalInstType;
+
+/* 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;		/* 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;
+
+/* Structure that holds the state of the assembler while generating code */
+
+typedef struct AssemblyEnv {
+    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] */
+
+    BasicBlock* head_bb;	/* First basic block in the code */
+    BasicBlock* curr_bb;	/* Current basic block */
+
+    int maxDepth;	     	/* Maximum stack depth encountered */
+
+    int curCatchDepth;		/* Current depth of catches */
+    int maxCatchDepth;		/* Maximum depth of catches encountered */
+
+    int flags;			/* Compilation flags (TCL_EVAL_DIRECT) */
+} AssemblyEnv;
+
+/* Static functions defined in this file */
+
+static void AddBasicBlockRangeToErrorInfo(AssemblyEnv*, BasicBlock*);
+static BasicBlock * AllocBB(AssemblyEnv*); 
+static int AssembleOneLine(AssemblyEnv* envPtr);
+static void BBAdjustStackDepth(BasicBlock* bbPtr, int consumed, int produced);
+static void BBUpdateStackReqs(BasicBlock* bbPtr, int tblind, int count);
+static void BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblind,
+			   unsigned char opnd, int count);
+static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblind, int opnd,
+			   int count);
+static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblind, int param,
+			   int count);
+static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblind, int count);
+static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
+static int CalculateJumpRelocations(AssemblyEnv*, int*);
+static int CheckForUnclosedCatches(AssemblyEnv*);
+static int CheckForThrowInWrongContext(AssemblyEnv*);
+static int CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
+static int BytecodeMightThrow(unsigned char);
+static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*);
+static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int);
+static int CheckNonNegative(Tcl_Interp*, int);
+static int CheckOneByte(Tcl_Interp*, int);
+static int CheckSignedOneByte(Tcl_Interp*, int);
+static int CheckStack(AssemblyEnv*);
+static int CheckStrictlyPositive(Tcl_Interp*, int);
+static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, TalInstDesc*);
+static int DefineLabel(AssemblyEnv* envPtr, const char* label);
+static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
+static void DupAssembleCodeInternalRep(Tcl_Obj* src, Tcl_Obj* dest);
+static void FillInJumpOffsets(AssemblyEnv*);
+static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_Obj* jumpTable);
+static int FindLocalVar(AssemblyEnv* envPtr, Tcl_Token** tokenPtrPtr);
+static int FinishAssembly(AssemblyEnv*);
+static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
+static void FreeAssemblyEnv(AssemblyEnv*);
+static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**);
+static void LookForFreshCatches(BasicBlock*, BasicBlock**);
+static void MoveCodeForJumps(AssemblyEnv*, int);
+static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int, int);
+static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int);
+static int ProcessCatches(AssemblyEnv*);
+static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*, BasicBlock*,
+				      enum BasicBlockCatchState, int);
+static void ResetVisitedBasicBlocks(AssemblyEnv*);
+static void ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*);
+static void ReportUndefinedLabel(AssemblyEnv*, BasicBlock*, Tcl_Obj*);
+static void RestoreEmbeddedExceptionRanges(AssemblyEnv*);
+static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *, BasicBlock *, int);
+static BasicBlock* StartBasicBlock(AssemblyEnv*, int fallthrough,
+				   Tcl_Obj* jumpLabel);
+/* static int AdvanceIp(const unsigned char *pc); */
+static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *, BasicBlock *, int);
+static int StackCheckExit(AssemblyEnv*);
+static void StackFreshCatches(AssemblyEnv*, BasicBlock*, int, BasicBlock**,
+			      int*);
+static void SyncStackDepth(AssemblyEnv*);
+static int TclAssembleCode(CompileEnv* envPtr, const char* code, int codeLen,
+			   int flags);
+static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int, 
+				  BasicBlock**, int*);
+
+/* Tcl_ObjType that describes bytecode emitted by the assembler */
+
+static const Tcl_ObjType assembleCodeType = {
+    "assemblecode",
+    FreeAssembleCodeInternalRep, /* freeIntRepProc */
+    DupAssembleCodeInternalRep,	 /* dupIntRepProc */
+    NULL,			 /* updateStringProc */
+    NULL			 /* setFromAnyProc */
+};
+
+/*
+ * 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,
+ * i.e. move, the array. This is also the reason to save the nuloc now, it may
+ * change during the course of the function.
+ *
+ * Macro to encapsulate the variable definition and setup.
+ */
+
+#define DefineLineInformation \
+    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
+    int eclIndex = mapPtr->nuloc - 1
+
+#define SetLineInformation(word) \
+    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
+    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
+
+/*
+ * Flags bits used by PushVarName.
+ */
+
+#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
+
+/*
+ * Source instructions recognized in the Tcl Assembly Language (TAL)
+ */
+
+TalInstDesc TalInstructionTable[] = {
+
+    /* PUSH must be first, see the code near the end of TclAssembleCode */
+
+    {"push",    	ASSEM_PUSH  ,   (INST_PUSH1<<8
+				         | INST_PUSH4), 	0   ,   1},
+
+    {"add",		ASSEM_1BYTE ,   INST_ADD    ,   	2   ,   1},
+    {"append",  	ASSEM_LVT,	(INST_APPEND_SCALAR1<<8
+	    				 | INST_APPEND_SCALAR4),1,      1},
+    {"appendArray",     ASSEM_LVT,	(INST_APPEND_ARRAY1<<8
+	    			 	 | INST_APPEND_ARRAY4),	2,      1},
+    {"appendArrayStk",	ASSEM_1BYTE,    INST_APPEND_ARRAY_STK,	3,      1}, 
+    {"appendStk", 	ASSEM_1BYTE,    INST_APPEND_STK,      	2,      1}, 
+    {"beginCatch",	ASSEM_BEGIN_CATCH,
+     					INST_BEGIN_CATCH4,	0,	0},
+    {"bitand",  	ASSEM_1BYTE ,   INST_BITAND ,   	2   ,   1},
+    {"bitnot",		ASSEM_1BYTE,    INST_BITNOT,    	1,      1},
+    {"bitor",   	ASSEM_1BYTE ,   INST_BITOR  ,   	2   ,   1},
+    {"bitxor",  	ASSEM_1BYTE ,   INST_BITXOR ,   	2   ,   1},
+    {"concat",		ASSEM_CONCAT1,	INST_CONCAT1,		INT_MIN,1},
+    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,      1},
+    {"dictGet", 	ASSEM_DICT_GET, INST_DICT_GET,  	INT_MIN,1},
+    {"dictIncrImm",    	ASSEM_SINT4_LVT4,
+     					INST_DICT_INCR_IMM,	1,	1},
+    {"dictLappend",	ASSEM_LVT4,	INST_DICT_LAPPEND,	2,      1},
+    {"dictSet", 	ASSEM_DICT_SET, INST_DICT_SET,		INT_MIN,1},
+    {"dictUnset",	ASSEM_DICT_UNSET,
+     					INST_DICT_UNSET,	INT_MIN,1},
+    {"div",     	ASSEM_1BYTE,    INST_DIV,       	2,      1},
+    {"dup",     	ASSEM_1BYTE ,   INST_DUP    ,   	1   ,   2}, 
+    {"endCatch",	ASSEM_END_CATCH,INST_END_CATCH, 	0,	0},
+    {"eq",      	ASSEM_1BYTE ,   INST_EQ     ,   	2   ,   1},
+    {"eval",		ASSEM_EVAL,	INST_EVAL_STK,		1,	1},
+    {"evalStk",		ASSEM_1BYTE,	INST_EVAL_STK,		1,	1},
+    {"exist",		ASSEM_LVT4,	INST_EXIST_SCALAR,      0,      1},
+    {"existArray",	ASSEM_LVT4,	INST_EXIST_ARRAY,       1,      1},
+    {"existArrayStk",	ASSEM_1BYTE,	INST_EXIST_ARRAY_STK,	2,	1},
+    {"existStk",	ASSEM_1BYTE,	INST_EXIST_STK,		1,	1},
+    {"expon",   	ASSEM_1BYTE,    INST_EXPON,     	2,      1},
+    {"expr",		ASSEM_EVAL,	INST_EXPR_STK,		1,	1},
+    {"exprStk", 	ASSEM_1BYTE,	INST_EXPR_STK,		1,	1},
+    {"ge",      	ASSEM_1BYTE ,   INST_GE     ,   	2   ,   1},
+    {"gt",      	ASSEM_1BYTE ,   INST_GT     ,   	2   ,   1},
+    {"incr",    	ASSEM_LVT1,     INST_INCR_SCALAR1,      1,      1},
+    {"incrArray",	ASSEM_LVT1,     INST_INCR_ARRAY1,       2,      1},
+    {"incrArrayImm", 	ASSEM_LVT1_SINT1,
+                        	        INST_INCR_ARRAY1_IMM,   1,      1},
+    {"incrArrayStk", 	ASSEM_1BYTE,	INST_INCR_ARRAY_STK,	3,      1},
+    {"incrArrayStkImm", ASSEM_SINT1,    INST_INCR_ARRAY_STK_IMM,2,      1},    
+    {"incrImm", 	ASSEM_LVT1_SINT1,
+                        	        INST_INCR_SCALAR1_IMM, 	0,      1},
+    {"incrStk", 	ASSEM_1BYTE,    INST_INCR_SCALAR_STK,   2,      1},
+    {"incrStkImm", 	ASSEM_SINT1,    INST_INCR_SCALAR_STK_IMM, 
+                        	                        	1,      1},
+    {"invokeStk",	ASSEM_INVOKE,   (INST_INVOKE_STK1 << 8
+		        	         | INST_INVOKE_STK4),   INT_MIN,1},
+    {"jump",    	ASSEM_JUMP,     INST_JUMP1,	 	0,      0},
+    {"jump4",    	ASSEM_JUMP4,    INST_JUMP4,	 	0,      0},
+    {"jumpFalse",       ASSEM_JUMP,     INST_JUMP_FALSE1,	1,      0},
+    {"jumpFalse4",      ASSEM_JUMP4,    INST_JUMP_FALSE4,	1,      0},
+    {"jumpTable",	ASSEM_JUMPTABLE,INST_JUMP_TABLE,	1,	0},
+    {"jumpTrue",	ASSEM_JUMP,     INST_JUMP_TRUE1, 	1,      0},
+    {"jumpTrue4",	ASSEM_JUMP4,    INST_JUMP_TRUE4, 	1,      0},
+    {"label",   	ASSEM_LABEL,    0, 			0,	0}, 
+    {"land",    	ASSEM_1BYTE ,   INST_LAND   ,   	2   ,   1},
+    {"lappend",  	ASSEM_LVT,	(INST_LAPPEND_SCALAR1<<8
+	    				 | INST_LAPPEND_SCALAR4),
+                                	                	1,      1},
+    {"lappendArray",    ASSEM_LVT,	(INST_LAPPEND_ARRAY1<<8
+	    				 | INST_LAPPEND_ARRAY4),2,      1},
+    {"lappendArrayStk", ASSEM_1BYTE,    INST_LAPPEND_ARRAY_STK,	3,      1}, 
+    {"lappendStk", 	ASSEM_1BYTE,    INST_LAPPEND_STK, 	2,      1}, 
+    {"le",      	ASSEM_1BYTE ,   INST_LE     ,   	2   ,   1},
+    {"lindexMulti",	ASSEM_LINDEX_MULTI,
+     					INST_LIST_INDEX_MULTI,	INT_MIN,1},
+    {"list",		ASSEM_LIST,	INST_LIST,		INT_MIN,1},
+    {"listIn",		ASSEM_1BYTE,	INST_LIST_IN,		2,	1},
+    {"listIndex", 	ASSEM_1BYTE,    INST_LIST_INDEX,	2,      1},
+    {"listIndexImm",	ASSEM_INDEX,	INST_LIST_INDEX_IMM,	1,	1},
+    {"listLength",	ASSEM_1BYTE,    INST_LIST_LENGTH,	1,      1},
+    {"listNotIn",	ASSEM_1BYTE,	INST_LIST_NOT_IN,	2,	1},
+    {"load",    	ASSEM_LVT,      (INST_LOAD_SCALAR1 << 8
+	                	         | INST_LOAD_SCALAR4), 	0,      1}, 
+    {"loadArray",       ASSEM_LVT,      (INST_LOAD_ARRAY1<<8
+				         | INST_LOAD_ARRAY4),	1,      1},
+    {"loadArrayStk",    ASSEM_1BYTE,    INST_LOAD_ARRAY_STK,	2,      1},
+    {"loadStk", 	ASSEM_1BYTE,    INST_LOAD_SCALAR_STK,	1,      1},
+    {"lor",     	ASSEM_1BYTE ,   INST_LOR    ,   	2   ,   1},
+    {"lsetFlat",	ASSEM_LSET_FLAT,INST_LSET_FLAT,		INT_MIN,1},
+    {"lsetList", 	ASSEM_1BYTE,    INST_LSET_LIST, 	3,      1},
+    {"lshift",  	ASSEM_1BYTE ,   INST_LSHIFT ,   	2   ,   1},
+    {"lt",      	ASSEM_1BYTE ,   INST_LT     ,   	2   ,   1},
+    {"mod",     	ASSEM_1BYTE,    INST_MOD,       	2,      1},
+    {"mult",    	ASSEM_1BYTE ,   INST_MULT   ,   	2   ,   1},
+    {"neq",     	ASSEM_1BYTE ,   INST_NEQ    ,   	2   ,   1},
+    {"nop",		ASSEM_1BYTE,	INST_NOP,		0,	0},
+    {"not",     	ASSEM_1BYTE,    INST_LNOT,      	1,      1},
+    {"nsupvar",		ASSEM_LVT4,	INST_NSUPVAR,		2,	1},
+    {"over",    	ASSEM_OVER,     INST_OVER,      	INT_MIN,-1-1},
+    {"pop",     	ASSEM_1BYTE ,   INST_POP    ,   	1   ,   0},
+    {"pushReturnCode",	ASSEM_1BYTE,	INST_PUSH_RETURN_CODE,	0,	1},
+    {"pushReturnOpts",	ASSEM_1BYTE,	INST_PUSH_RETURN_OPTIONS,
+     								0,	1},
+    {"pushResult",	ASSEM_1BYTE,	INST_PUSH_RESULT,	0,	1},
+    {"regexp",		ASSEM_REGEXP,	INST_REGEXP,		2,	1},
+    {"reverse", 	ASSEM_REVERSE,  INST_REVERSE,   	INT_MIN,-1-0},
+    {"rshift",  	ASSEM_1BYTE ,   INST_RSHIFT ,   	2   ,   1},
+    {"store",   	ASSEM_LVT,      (INST_STORE_SCALAR1<<8
+					 | INST_STORE_SCALAR4),	1,      1}, 
+    {"storeArray", 	ASSEM_LVT,      (INST_STORE_ARRAY1<<8
+                        	         | INST_STORE_ARRAY4),	2,      1}, 
+    {"storeArrayStk", 	ASSEM_1BYTE,    INST_STORE_ARRAY_STK,	3,      1}, 
+    {"storeStk", 	ASSEM_1BYTE,    INST_STORE_SCALAR_STK, 	2,      1}, 
+    {"strcmp",  	ASSEM_1BYTE,    INST_STR_CMP,   	2,      1},
+    {"streq",   	ASSEM_1BYTE,    INST_STR_EQ,    	2,      1},
+    {"strindex", 	ASSEM_1BYTE,    INST_STR_INDEX, 	2,      1},
+    {"strlen",  	ASSEM_1BYTE,    INST_STR_LEN,   	1,      1},
+    {"strmatch",	ASSEM_BOOL,     INST_STR_MATCH, 	2,      1},
+    {"strneq",  	ASSEM_1BYTE,    INST_STR_NEQ,   	2,      1},
+    {"sub",     	ASSEM_1BYTE ,   INST_SUB    ,   	2   ,   1},
+    {"tryCvtToNumeric",	ASSEM_1BYTE,    INST_TRY_CVT_TO_NUMERIC,1,      1},
+    {"uminus",  	ASSEM_1BYTE,    INST_UMINUS,    	1,      1},
+    {"unset",		ASSEM_BOOL_LVT4,INST_UNSET_SCALAR,	0,      0},
+    {"unsetArray",	ASSEM_BOOL_LVT4,INST_UNSET_ARRAY,	1,      0},
+    {"unsetArrayStk",	ASSEM_BOOL,	INST_UNSET_ARRAY_STK,	2,	0},
+    {"unsetStk",	ASSEM_BOOL,	INST_UNSET_STK,		1,	0},
+    {"uplus",   	ASSEM_1BYTE,    INST_UPLUS,     	1,      1},
+    {"upvar",		ASSEM_LVT4,	INST_UPVAR,		2,	1},
+    {"variable",	ASSEM_LVT4,	INST_VARIABLE,		1,	0},
+    {NULL, 		0,		0,			0,	0}
+};
+
+/*
+ * List of instructions that cannot throw an exception under any circumstances.
+ * These instructions are the ones that are permissible after an exception
+ * is caught but before the corresponding exception range is popped from
+ * the stack.
+ * The instructions must be in ascending order by numeric operation code.
+ */
+
+static unsigned char NonThrowingByteCodes[] = {
+    INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP,			/* 1-4 */
+    INST_JUMP1, INST_JUMP4,					/* 34-35 */
+    INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,	/* 70-72 */
+    INST_OVER,							/* 95 */
+    INST_PUSH_RETURN_OPTIONS,					/* 108 */
+    INST_REVERSE,						/* 126 */
+    INST_NOP							/* 132 */
+};
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBAdjustStackDepth --
+ *
+ *	When an opcode is emitted, adjusts the stack information in the
+ *	basic block to reflect the number of operands produced and consumed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Updates minimum, maximum and final stack requirements in the
+ *	basic block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBAdjustStackDepth(BasicBlock* bbPtr,
+				/* Structure describing the basic block */
+		   int consumed,
+				/* Count of operands consumed by the 
+				 * operation */
+		   int produced)
+				/* Count of operands produced by the
+				 * operation */
+{
+    int depth = bbPtr->finalStackDepth;
+    depth -= consumed;
+    if (depth < bbPtr->minStackDepth) {
+	bbPtr->minStackDepth = depth;
+    }
+    depth += produced;
+    if (depth > bbPtr->maxStackDepth) {
+	bbPtr->maxStackDepth = depth;
+    }
+    bbPtr->finalStackDepth = depth;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBUpdateStackReqs --
+ *
+ *	Updates the stack requirements of a basic block, given the opcode
+ *	being emitted and an operand count.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Updates min, max and final stack requirements in the basic block.
+ *
+ * Notes:
+ *	This function must not be called for instructions such as REVERSE
+ *	and OVER that are variadic but do not consume all their operands.
+ *	Instead, BBAdjustStackDepth should be called directly.
+ *
+ *	count should be provided only for variadic operations. For
+ *	operations with known arity, count should be 0.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBUpdateStackReqs(BasicBlock* bbPtr,
+				/* Structure describing the basic block */
+		  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;
+    if (consumed == INT_MIN) {
+	/* The instruction is variadic; it consumes 'count' operands. */
+	consumed = count;
+    }
+    if (produced < 0) {
+	/* The instruction leaves some of its variadic operands on the stack,
+	 * with net stack effect of '-1-produced' */
+	produced = consumed - produced - 1;
+    }
+    BBAdjustStackDepth(bbPtr, consumed, produced);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBEmitOpcode, BBEmitInstInt1, BBEmitInstInt4 --
+ *
+ *	Emit the opcode part of an instruction, or the entirety of an
+ *      instruction with a 1- or 4-byte operand, and adjust stack requirements.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores instruction and operand in the operand stream, and
+ *	adjusts the stack.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBEmitOpcode(AssemblyEnv* 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 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);
+}
+static void
+BBEmitInstInt1(AssemblyEnv* assemEnvPtr,
+				/* Assembly environment */
+	       int tblind,	/* Index in TalInstructionTable of op */
+	       unsigned char opnd,
+				/* 1-byte operand */
+	       int count)	/* Operand count for variadic ops */
+{
+    BBEmitOpcode(assemEnvPtr, tblind, count);
+    TclEmitInt1(opnd, assemEnvPtr->envPtr);
+}
+static void
+BBEmitInstInt4(AssemblyEnv* assemEnvPtr,
+				/* Assembly environment */
+	       int tblind,	/* Index in TalInstructionTable of op */
+	       int opnd,	/* 4-byte operand */
+	       int count)	/* Operand count for variadic ops */
+{
+    BBEmitOpcode(assemEnvPtr, tblind, count);
+    TclEmitInt4(opnd, assemEnvPtr->envPtr);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BBEmitInst1or4 --
+ *
+ *	Emits a 1- or 4-byte operation according to the magnitude of the
+ *	operand
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+BBEmitInst1or4(AssemblyEnv* 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) {
+	op >>= 8;
+    } else {
+	op &= 0xff;
+    }
+    TclEmitInt1(op, envPtr);
+    if (param <= 0xff) {
+	TclEmitInt1(param, envPtr);
+    } else {
+	TclEmitInt4(param, envPtr);
+    }
+    envPtr->atCmdStart = ((op) == INST_START_CMD);
+    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. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    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. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    ByteCode *codePtr;		/* Pointer to the bytecode to execute */
+    Tcl_Obj* backtrace;		/* Object where extra error information
+				 * is constructed. */
+
+    /* Check args */
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList");
+	return TCL_ERROR;
+    }
+
+    /* 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;
+    }
+
+    /* Use NRE to evaluate the bytecode from the trampoline */
+
+    /*
+    Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
+	    NULL, NULL);
+    return TCL_OK;
+    */
+    return TclNRExecuteByteCode(interp, codePtr);
+
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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 interpreter */
+    Tcl_Obj *objPtr)		/* Source code to assemble */
+{
+    Interp *iPtr = (Interp *) interp;
+				/* Internals of the interpreter */
+    CompileEnv compEnv;		/* Compilation environment structure */
+    register ByteCode *codePtr = NULL;
+				/* 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
+     * is valid in the current context.
+     */
+     
+    if (objPtr->typePtr == &assembleCodeType) {
+	namespacePtr = iPtr->varFramePtr->nsPtr;
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	if (((Interp *) *codePtr->interpHandle != iPtr)
+	    || (codePtr->compileEpoch != iPtr->compileEpoch)
+	    || (codePtr->nsPtr != namespacePtr)
+	    || (codePtr->nsEpoch != namespacePtr->resolverEpoch)
+	    || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
+		    
+	    FreeAssembleCodeInternalRep(objPtr);
+	}
+    }
+    if (objPtr->typePtr != &assembleCodeType) {
+
+	/* 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) {
+
+	    /* Assembly failed. Clean up and report the error */
+
+	    TclFreeCompileEnv(&compEnv);
+	    return NULL;
+	}
+
+	/*
+	 * Add a "done" instruction as the last instruction and change the
+	 * object into a ByteCode object. Ownership of the literal objects and
+	 * aux data items is given to the ByteCode object.
+	 */
+
+	TclEmitOpcode(INST_DONE, &compEnv);
+	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);
+	    fflush(stdout);
+	}
+#endif /* TCL_COMPILE_DEBUG */
+    }
+    return codePtr;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclCompileAssembleCmd --
+ *
+ *	Compilation procedure for the '::tcl::unsupported::assemble' command.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Puts the result of assembling the code into the bytecode stream
+ *	in 'compileEnv'.
+ *
+ * This procedure makes sure that the command has a single arg, which is
+ * constant. If that condition is met, the procedure calls TclAssembleCode
+ * to produce bytecode for the given assembly code, and returns any error
+ * resulting from the assembly.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+int TclCompileAssembleCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{ 
+    Tcl_Token *tokenPtr;	/* Token in the input script */
+    int status;			/* Status return from assembling the code */
+
+    /* Make sure that the command has a single arg */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+
+    /* Make sure that the arg is a simple word */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+
+    /* Compile the code and return any error from the compilation */
+
+    status = TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
+    return status;
+
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclAssembleCode --
+ *
+ *	Take a list of instructions in a Tcl_Obj, and assemble them to
+ *	Tcl bytecodes
+ *
+ * Results:
+ *	Returns TCL_OK on success, TCL_ERROR on failure.
+ *	If 'flags' includes TCL_EVAL_DIRECT, places an error message
+ *	in the interpreter result.
+ *
+ * Side effects:
+ *	Adds byte codes to the compile environment, and updates the
+ *	environment's stack depth.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+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.
+     */
+
+    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 */
+
+    AssemblyEnv* assemEnvPtr = NewAssemblyEnv(envPtr, flags);
+    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
+
+    do {
+
+	/* Parse out one command line from the assembly script */
+
+	status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
+	instLen = parsePtr->commandSize;
+	if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
+	    --instLen;
+	}
+
+	/* Report errors in the parse */
+
+	if (status != TCL_OK) {
+	    if (flags & TCL_EVAL_DIRECT) {
+		Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, 
+				   instLen);
+	    }
+	    FreeAssemblyEnv(assemEnvPtr);
+	    return TCL_ERROR;
+	}
+
+	/* Advance the pointers around any leading commentary */
+
+	TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr, parsePtr->commandStart);
+	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, 
+				parsePtr->commandStart - envPtr->source);
+
+	/* Process the line of code  */
+
+	if (parsePtr->numWords > 0) {
+
+	    /* If tracing, show each line assembled as it happens */
+
+#ifdef TCL_COMPILE_DEBUG
+	    if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) {
+		printf("  %4d Assembling: ",
+		       envPtr->codeNext - envPtr->codeStart);
+		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);
+		FreeAssemblyEnv(assemEnvPtr);
+		return TCL_ERROR;
+	    }
+	}
+
+	/* Advance to the next line of code */
+
+	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);
+
+    /* Done with parsing the code */
+
+    status = FinishAssembly(assemEnvPtr);
+    FreeAssemblyEnv(assemEnvPtr);
+    return status;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * NewAssemblyEnv --
+ *
+ *	Creates an environment for the assembler to run in.
+ *
+ * Results:
+ *	Allocates, initialises and returns an assembler environment
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static AssemblyEnv*
+NewAssemblyEnv(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 */
+    AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv));
+				/* Assembler environment under construction */
+    Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+				/* Parse of one line of assembly code */
+
+    assemEnvPtr->envPtr = envPtr;
+    assemEnvPtr->parsePtr = parsePtr;
+    assemEnvPtr->cmdLine = envPtr->line;
+    assemEnvPtr->clNext = envPtr->clNext;
+
+    /* Make the hashtables that store symbol resolution */
+
+    Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS);
+
+    /* Start the first basic block */
+
+    assemEnvPtr->curr_bb = NULL;
+    assemEnvPtr->head_bb = AllocBB(assemEnvPtr);
+    assemEnvPtr->curr_bb = assemEnvPtr->head_bb;
+    assemEnvPtr->head_bb->startLine = 1;
+
+    /* Stash compilation flags */
+
+    assemEnvPtr->flags = flags;
+
+    return assemEnvPtr;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FreeAssemblyEnv --
+ *
+ *	Cleans up the assembler environment when assembly is complete.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+FreeAssemblyEnv(AssemblyEnv* assemEnvPtr)
+				/* Environment to free */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment being used
+				 * for code generation */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+
+    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;
+
+    /* Free all the basic block structures */
+    for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
+	if (thisBB->jumpTarget != NULL) {
+	    Tcl_DecrRefCount(thisBB->jumpTarget);
+	}
+	if (thisBB->foreignExceptions != NULL) {
+	    ckfree((char*)(thisBB->foreignExceptions));
+	}
+	nextBB = thisBB->successor1;
+	if (thisBB->jtPtr != NULL) {
+	    DeleteMirrorJumpTable(thisBB->jtPtr);
+	    thisBB->jtPtr = NULL;
+	}
+	ckfree((char*)thisBB);
+    }
+
+    /* Free the label hash */
+    while ((hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash,
+					    &hashSearch)) != NULL) {
+	Tcl_DeleteHashEntry(hashEntry);
+    }
+
+    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(AssemblyEnv* 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  */
+    int opnd;			/* Integer representation of an operand */
+    int litIndex;		/* Literal pool index of a constant */
+    int localVar;		/* LVT index of a local variable */
+    int flags;			/* Flags for a basic block */
+    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
+    int infoIndex;		/* Index of the jumptable in auxdata */
+    int status = TCL_ERROR;	/* Return value from this function */
+    
+    /* Make sure that the instruction name is known at compile time. */
+
+    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_BEGIN_CATCH:
+	/* 
+	 * Emit the BEGIN_CATCH instruction with the code offset of the
+	 * exception branch target instead of the exception range index.
+	 * The correct index will be generated and inserted later, when
+	 * catches are being resolved.
+	 */
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
+	    goto cleanup;
+	}
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+	    goto cleanup;
+	}
+	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
+	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart;
+	BBEmitInstInt4(assemEnvPtr, tblind, 0, 0);
+	assemEnvPtr->curr_bb->flags |= BB_BEGINCATCH;
+	StartBasicBlock(assemEnvPtr, BB_FALLTHRU, operand1Obj);
+	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 (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckOneByte(interp, opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt1(assemEnvPtr, tblind, opnd, opnd);
+	break;
+
+    case ASSEM_DICT_GET:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+	break;
+
+    case ASSEM_DICT_SET:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK
+	    || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+	TclEmitInt4(localVar, envPtr);
+	break;
+
+    case ASSEM_DICT_UNSET:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK
+	    || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+	TclEmitInt4(localVar, envPtr);
+	break;
+
+    case ASSEM_END_CATCH:
+	if (parsePtr->numWords != 1) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
+	    goto cleanup;
+	}
+	assemEnvPtr->curr_bb->flags |= BB_ENDCATCH;
+	BBEmitOpcode(assemEnvPtr, tblind, 0);
+	StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+	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) {
+	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1, 
+				  TalInstructionTable+tblind);
+	} 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;
+
+    case ASSEM_INVOKE:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	
+	BBEmitInst1or4(assemEnvPtr, tblind, opnd, opnd);
+	break;
+		 
+    case ASSEM_JUMP: 
+    case ASSEM_JUMP4:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
+	    goto cleanup;
+	}
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+	    goto cleanup;
+	}
+	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart;
+	if (instType == ASSEM_JUMP) {
+	    flags = BB_JUMP1;
+	    BBEmitInstInt1(assemEnvPtr, tblind, 0, 0);
+	} else {
+	    flags = 0;
+	    BBEmitInstInt4(assemEnvPtr, tblind, 0, 0);
+	}
+                    
+	/* Start a new basic block at the instruction following the jump */
+
+	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
+	if (TalInstructionTable[tblind].operandsConsumed != 0) {
+	    flags |= BB_FALLTHRU;
+	}
+	StartBasicBlock(assemEnvPtr, flags, operand1Obj);
+
+	break;
+                             
+    case ASSEM_JUMPTABLE:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
+	    goto cleanup;
+	}
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+	    goto cleanup;
+	}
+	jtPtr = (JumptableInfo*) ckalloc(sizeof(JumptableInfo));
+	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
+	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
+	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart;
+	/*fprintf(stderr, "bb %p jumpLine %d jumpOffset %d\n",
+		assemEnvPtr->curr_bb, assemEnvPtr->cmdLine,
+		envPtr->codeNext - envPtr->codeStart); fflush(stderr); */
+	infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
+	/* fprintf(stderr, "auxdata index=%d\n", infoIndex); */
+	BBEmitInstInt4(assemEnvPtr, tblind, infoIndex, 0);
+	if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) {
+	    goto cleanup;
+	}
+	StartBasicBlock(assemEnvPtr, BB_JUMPTABLE|BB_FALLTHRU, NULL);
+	break;
+
+    case ASSEM_LABEL:
+
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "name");
+	    goto cleanup;
+	}
+	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
+	    goto cleanup;
+	}
+	/* Add the (label_name, address) pair to the hash table */
+	if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
+	    goto cleanup;
+	}
+	break;
+
+    case ASSEM_LINDEX_MULTI:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+	break;
+		 
+    case ASSEM_LIST:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckNonNegative(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+	break;
+		 
+    case ASSEM_INDEX:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+	break;
+
+    case ASSEM_LSET_FLAT:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	if (opnd < 2) {
+	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+		Tcl_SetObjResult(interp,
+				 Tcl_NewStringObj("operand must be >=2", -1));
+		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
+	    }
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+	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
+	    || CheckNonNegative(interp, opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+	break;
+
+    case ASSEM_REGEXP:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
+	    goto cleanup;
+	}
+	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+	    goto cleanup;
+	}
+	{
+	    int flags = TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0);
+	    BBEmitInstInt1(assemEnvPtr, tblind, flags, 0);
+	}
+	break;
+
+    case ASSEM_REVERSE:
+	if (parsePtr->numWords != 2) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || CheckNonNegative(interp, 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;
+
+    case ASSEM_SINT4_LVT4:
+	if (parsePtr->numWords != 3) {
+	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+	    goto cleanup;
+	}
+	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+	    || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+	    goto cleanup;
+	}
+	BBEmitInstInt4(assemEnvPtr, tblind, opnd, 0);
+	TclEmitInt4(localVar, envPtr);
+	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;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CompileEmbeddedScript --
+ *
+ *	Compile an embedded 'eval' or 'expr' that appears in assembly code.
+ *
+ * This procedure is called when the 'eval' or 'expr' assembly directive
+ * is encountered, and the argument to the directive is a simple word that
+ * requires no substitution. The appropriate compiler (TclCompileScript or
+ * TclCompileExpr) is invoked recursively, and emits bytecode.
+ *
+ * Before the compiler is invoked, the compilation environment's stack
+ * consumption is reset to zero. Upon return from the compilation, the
+ * net stack effect of the compilation is in the compiler env, and this
+ * stack effect is posted to the assembler environment. The compile
+ * environment's stack consumption is then restored to what it was
+ * before (which is actually the state of the stack on entry to the block
+ * of assembly code).
+ *
+ * Any exception ranges pushed by the compilation are copied to the basic
+ * block and removed from the compiler environment. They will be rebuilt at
+ * the end of assembly, when the exception stack depth is actually known.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+CompileEmbeddedScript(AssemblyEnv* assemEnvPtr,
+				/* Assembler environment */
+		      Tcl_Token* tokenPtr,
+				/* Tcl_Token containing the script */
+		      TalInstDesc* instPtr)
+				/* Instruction that determines whether
+				 * the script is 'expr' or 'eval' */
+{
+    /*
+     * 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.
+     */
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+
+    /* 
+     * Save away the stack depth and reset it before compiling the script.
+     * We'll record the stack usage of the script in the BasicBlock, and
+     * accumulate it together with the stack usage of the enclosing assembly
+     * code.
+     */
+
+    int savedStackDepth = envPtr->currStackDepth;
+    int savedMaxStackDepth = envPtr->maxStackDepth;
+    int savedCodeIndex = envPtr->codeNext - envPtr->codeStart;
+    int savedExceptArrayNext = envPtr->exceptArrayNext;
+
+    envPtr->currStackDepth = 0;
+    envPtr->maxStackDepth = 0;
+
+    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+    switch(instPtr->tclInstCode) {
+    case INST_EVAL_STK:
+	TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
+	break;
+    case INST_EXPR_STK:
+	TclCompileExpr(interp, tokenPtr->start, tokenPtr->size, envPtr, 1);
+	break;
+    default:
+	Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen",
+		  instPtr->name, instPtr->tclInstCode);
+    }
+
+    /* 
+     * Roll up the stack usage of the embedded block into the assembler
+     * environment.
+     */
+    SyncStackDepth(assemEnvPtr);
+    envPtr->currStackDepth = savedStackDepth;
+    envPtr->maxStackDepth = savedMaxStackDepth;
+
+    /* 
+     * Save any exception ranges that were pushed by the compiler, They
+     * will need to be fixed up once the stack depth is known.
+     */
+
+    MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex, 
+				    savedExceptArrayNext);
+
+    /* Flush the current basic block */
+
+    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+SyncStackDepth(AssemblyEnv* 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;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * MoveExceptionRangesToBasicBlock --
+ *
+ *	Removes exception ranges that were created by compiling an embedded
+ *	script from the CompileEnv, and stores them in the BasicBlock. They
+ *	will be reinstalled, at the correct stack depth, after control flow
+ *	analysis is complete on the assembly code.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+MoveExceptionRangesToBasicBlock(AssemblyEnv* assemEnvPtr,
+				/* Assembler environment */
+				int savedCodeIndex,
+				/* Start of the embedded code */
+				int savedExceptArrayNext)
+				/* Saved index of the end of the exception
+				 * range array */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
+				/* Current basic block */
+    int exceptionCount = envPtr->exceptArrayNext - savedExceptArrayNext;
+				/* Number of ranges that must be moved */
+    int i;
+
+    if (exceptionCount == 0) {
+	/* Nothing to do */
+	return;
+    }
+
+    /* 
+     * Save the exception ranges in the basic block. They will be re-added
+     * at the conclusion of assembly; at this time, the INST_BEGIN_CATCH
+     * instructions in the block will be adjusted from whatever range
+     * indices they have [savedExceptArrayNext .. envPtr->exceptArrayNext)
+     * to the indices that the exceptions acquire. The saved exception ranges
+     * are converted to a relative nesting depth. The depth will be recomputed
+     * once flow analysis has determined the actual stack depth of the block.
+     */
+
+    /*fprintf(stderr, "basic block %p has %d exceptions starting at %d\n",
+      curr_bb, exceptionCount, savedExceptArrayNext); */
+    curr_bb->foreignExceptionBase = savedExceptArrayNext;
+    curr_bb->foreignExceptionCount = exceptionCount;
+    curr_bb->foreignExceptions = (ExceptionRange*)
+	ckalloc(exceptionCount * sizeof(ExceptionRange));
+    memcpy(curr_bb->foreignExceptions,
+	   envPtr->exceptArrayPtr + savedExceptArrayNext,
+	   exceptionCount * sizeof(ExceptionRange));
+    for (i = 0; i < exceptionCount; ++i) {
+	curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth;
+    }
+    envPtr->exceptArrayNext = savedExceptArrayNext;
+    
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ * 
+ * CreateMirrorJumpTable --
+ *
+ *	Makes a jump table with comparison values and assembly code labels.
+ *
+ * Results:
+ *	Returns a standard Tcl status, with an error message in the interpreter
+ *	on error.
+ *
+ * Side effects:
+ *	Initializes the jump table pointer in the current basic block to
+ *	a JumptableInfo. The keys in the JumptableInfo are the comparison
+ *	strings. The values, instead of being jump displacements, are
+ *	Tcl_Obj's with the code labels.
+ */
+
+static int
+CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
+				/* Assembly environment */
+		      Tcl_Obj* jumps)
+				/* List of alternating keywords and labels */
+{
+    int objc;			/* Number of elements in the 'jumps' list */
+    Tcl_Obj** objv;		/* Pointers to the elements in the list */
+
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
+				/* Current basic block */
+    JumptableInfo* jtPtr;
+    Tcl_HashTable* jtHashPtr;	/* Hashtable in the JumptableInfo */
+    Tcl_HashEntry* hashEntry;	/* Entry for a key in the hashtable */
+    int isNew;			/* Flag==1 if the key is not yet in the table */
+    Tcl_Obj* result;		/* Error message */
+    int i;
+
+    if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (objc % 2 != 0) {
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj("jump table must have an "
+					      "even number of list "
+					      "elements", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
+	}
+	return TCL_ERROR;
+    }
+    
+    /* Allocate the jumptable */
+
+    jtPtr = (JumptableInfo*) ckalloc(sizeof(JumptableInfo));
+    jtHashPtr = &(jtPtr->hashTable);
+    Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);
+
+    /* Fill the keys and labels into the table */
+
+    /* fprintf(stderr, "jump table {\n"); */
+    for (i = 0; i < objc; i+=2) {
+	/* fprintf(stderr, "  %s -> %s\n", Tcl_GetString(objv[i]),
+	   Tcl_GetString(objv[i+1])); fflush(stderr); */
+	hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]),
+				       &isNew);
+	if (!isNew) {
+	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+		result = Tcl_NewStringObj("duplicate entry in jump table for "
+					  "\"", -1);
+		Tcl_AppendObjToObj(result, objv[i]);
+		Tcl_AppendToObj(result, "\"", -1);
+		Tcl_SetObjResult(interp, result);
+		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
+		DeleteMirrorJumpTable(jtPtr);
+		return TCL_ERROR;
+	    }
+	}
+	Tcl_SetHashValue(hashEntry, (ClientData) objv[i+1]);
+	Tcl_IncrRefCount(objv[i+1]);
+    }
+    /* fprintf(stderr, "}\n"); fflush(stderr); */
+	    
+
+    /* Put the mirror jumptable in the basic block struct */
+
+    bbPtr->jtPtr = jtPtr;
+
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DeleteMirrorJumpTable --
+ *
+ *	Cleans up a jump table when the basic block is deleted.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+DeleteMirrorJumpTable(JumptableInfo* jtPtr)
+{
+    Tcl_HashTable* jtHashPtr = &jtPtr->hashTable;
+				/* Hash table pointer */
+    Tcl_HashSearch search;	/* Hash search control */
+    Tcl_HashEntry* entry;	/* Hash table entry containing a jump label */
+    Tcl_Obj* label;		/* Jump label from the hash table */
+
+    for (entry = Tcl_FirstHashEntry(jtHashPtr, &search);
+	 entry != NULL;
+	 entry = Tcl_NextHashEntry(&search)) {
+	label = (Tcl_Obj*) Tcl_GetHashValue(entry);
+	Tcl_DecrRefCount(label);
+	Tcl_SetHashValue(entry, NULL);
+    }
+    Tcl_DeleteHashTable(jtHashPtr);
+    ckfree((char*)jtPtr);
+}
+				    
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetNextOperand --
+ *
+ *	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(AssemblyEnv* 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(AssemblyEnv* 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_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.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetIntegerOperand(AssemblyEnv* 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;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * GetListIndexOperand --
+ *
+ *	Gets the value of an operand intended to serve as a list index.
+ *
+ * Results:
+ *	Returns a standard Tcl result: TCL_OK if the parse is successful
+ *	and TCL_ERROR (with an appropriate error message) if the parse fails.
+ *
+ * Side effects:
+ *	Stores the list index at '*index'. Values between -1 and 0x7fffffff
+ *	have their natural meaning; values between -2 and -0x80000000
+ *	represent 'end-2-N'.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+GetListIndexOperand(
+		    AssemblyEnv* 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 = TclGetIntForIndex(interp, intObj, -2, 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.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+FindLocalVar(AssemblyEnv* 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"
+					      " to create a variable"
+					      " in a non-proc context", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
+	}
+	return -1;
+    }
+    *tokenPtrPtr = TokenAfter(tokenPtr);
+    return localVar;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckNamespaceQualifiers --
+ *
+ *	Verify that a variable name has no namespace qualifiers before
+ *	attempting to install it in the LVT.
+ *
+ * Results:
+ *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
+ *	stores an error message in the interpreter result.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckNamespaceQualifiers(Tcl_Interp* interp,
+				/* Tcl interpreter for error reporting */
+			 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+2 < name+nameLen;  p++) {      
+	if ((*p == ':') && (p[1] == ':')) {
+	    result = Tcl_NewStringObj("variable \"", -1);
+	    Tcl_AppendToObj(result, name, -1);
+	    Tcl_AppendToObj(result, "\" is not local", -1);
+	    Tcl_SetObjResult(interp, result);
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name,
+			     NULL);
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckOneByte --
+ *
+ *	Verify that a constant fits in a single byte in the instruction stream.
+ *
+ * Results:
+ *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
+ *	stores an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_SCALAR1
+ * are possible on a given local variable. The fact that there is no
+ * INCR_SCALAR4 is puzzling.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckOneByte(Tcl_Interp* interp,
+				/* Tcl interpreter for error reporting */
+	     int value)		/* Value to check */
+{
+    Tcl_Obj* result;		/* Error message */
+    if (value < 0 || value > 0xff) {
+	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
+	Tcl_SetObjResult(interp, result);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckSignedOneByte --
+ *
+ *	Verify that a constant fits in a single signed byte in the instruction
+ *      stream.
+ *
+ * Results:
+ *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
+ *	stores an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_SCALAR1
+ * are possible on a given local variable. The fact that there is no
+ * INCR_SCALAR4 is puzzling.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckSignedOneByte(Tcl_Interp* interp,
+				/* Tcl interpreter for error reporting */
+	           int value)	/* Value to check */
+{
+    Tcl_Obj* result;		/* Error message */
+    if (value > 0x7f || value < -0x80) {
+	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
+	Tcl_SetObjResult(interp, result);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckNonNegative --
+ *
+ *	Verify that a constant is nonnegative
+ *
+ * Results:
+ *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
+ *	stores an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_INVOKE
+ * are consuming a positive number of operands
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckNonNegative(Tcl_Interp* interp,
+				/* Tcl interpreter for error reporting */
+		 int value)	/* Value to check */
+{
+    Tcl_Obj* result;		/* Error message */
+    if (value < 0) {
+	result = Tcl_NewStringObj("operand must be nonnegative", -1);
+	Tcl_SetObjResult(interp, result);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckStrictlyPositive --
+ *
+ *	Verify that a constant is positive
+ *
+ * Results:
+ *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
+ *	stores an error message in the interpreter result.
+ *
+ * This code is here primarily to verify that instructions like INCR_INVOKE
+ * are consuming a positive number of operands
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckStrictlyPositive(Tcl_Interp* interp,
+				/* Tcl interpreter for error reporting */
+		      int value)	/* Value to check */
+{
+    Tcl_Obj* result;		/* Error message */
+    if (value <= 0) {
+	result = Tcl_NewStringObj("operand must be positive", -1);
+	Tcl_SetObjResult(interp, result);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DefineLabel --
+ *
+ *	Defines a label appearing in the assembly sequence.
+ *
+ * Results:
+ *	Returns a standard Tcl result. Returns TCL_OK and an empty result
+ *	if the definition succeeds; returns TCL_ERROR and an appropriate
+ *	message if a duplicate definition is found.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+DefineLabel(AssemblyEnv* 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 */
+    Tcl_Obj* result;		/* Error message */
+
+    /* TODO - This can now be simplified! */
+
+    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
+
+    /* Look up the newly-defined label in the symbol table */
+
+    entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
+    if (isNew) {
+
+	/* This is the first appearance of the label in the code */
+
+	Tcl_SetHashValue(entry, assemEnvPtr->curr_bb);
+
+    } else {
+
+	/* This is a duplicate label */
+
+	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;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StartBasicBlock --
+ *
+ *	Starts a new basic block when a label or jump is encountered.
+ *
+ * Results:
+ *	Returns a pointer to the BasicBlock structure of the new
+ *	basic block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static BasicBlock*
+StartBasicBlock(AssemblyEnv* assemEnvPtr,
+				/* Assembly environment */
+		int flags,	/* Flags to apply to the basic block
+				 * being closed, if there is one. */
+		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 */
+    BasicBlock* newBB;	 	/* BasicBlock structure for the new block */
+    BasicBlock* currBB = assemEnvPtr->curr_bb;
+
+    /* Coalesce zero-length blocks */
+
+    if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) {
+	currBB->startLine = assemEnvPtr->cmdLine;
+	return currBB;
+    }
+
+    /* Make the new basic block */
+
+    newBB = AllocBB(assemEnvPtr);
+
+    /* Record the jump target if there is one. */
+
+    if ((currBB->jumpTarget = jumpLabel) != NULL) { 
+	Tcl_IncrRefCount(currBB->jumpTarget);
+    }
+
+    /* Record the fallthrough if there is one. */
+
+    currBB->flags |= flags;
+
+    /* Record the successor block */
+
+    currBB->successor1 = newBB;
+    assemEnvPtr->curr_bb = newBB;
+    return newBB;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * AllocBB --
+ *
+ *	Allocates a new basic block
+ *
+ * Results:
+ *	Returns a pointer to the newly allocated block, which is initialized
+ *	to contain no code and begin at the current instruction pointer.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static BasicBlock * 
+AllocBB(AssemblyEnv* assemEnvPtr)
+				/* Assembly environment */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+    BasicBlock * bb = (BasicBlock *) ckalloc(sizeof(BasicBlock));
+
+    bb->originalStartOffset =
+	bb->startOffset = envPtr->codeNext - envPtr->codeStart;
+    bb->startLine = assemEnvPtr->cmdLine + 1;
+    bb->jumpOffset = -1;
+    bb->jumpLine = -1;
+    bb->prevPtr = assemEnvPtr->curr_bb;
+    bb->predecessor = NULL;
+    bb->successor1 = NULL;
+    bb->jumpTarget = NULL;
+    bb->initialStackDepth = 0;
+    bb->minStackDepth = 0;
+    bb->maxStackDepth = 0;
+    bb->finalStackDepth = 0;
+    bb->enclosingCatch = NULL;
+    bb->foreignExceptionBase = -1;
+    bb->foreignExceptionCount = 0;
+    bb->foreignExceptions = NULL;
+    bb->jtPtr = NULL;
+    bb->flags = 0;
+
+    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(AssemblyEnv* assemEnvPtr)
+				/* Assembly environment */
+{
+
+    int mustMove;		/* Amount by which the code needs to be
+				 * grown because of expanding jumps */
+
+    /* 
+     * Resolve the targets of all jumps and determine whether code needs
+     * to be moved around.
+     */
+
+    if (CalculateJumpRelocations(assemEnvPtr, &mustMove)) {
+	return TCL_ERROR;
+    }
+
+    /* Move the code if necessary */
+
+    if (mustMove) {
+	MoveCodeForJumps(assemEnvPtr, mustMove);
+    }
+
+    /* Resolve jump target labels to bytecode offsets */
+
+    FillInJumpOffsets(assemEnvPtr);
+
+    /* Label each basic block with its catch context. Quit on inconsistency */
+
+    if (ProcessCatches(assemEnvPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that no block accessible from a catch's error exit that hasn't
+     * popped the exception stack can throw an exception.
+     */
+
+    if (CheckForThrowInWrongContext(assemEnvPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Compute stack balance throughout the program */
+
+    if (CheckStack(assemEnvPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* TODO - Check for unreachable code */
+    /* Maybe not - unreachable code is Mostly Harmless. */
+
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CalculateJumpRelocations --
+ *
+ *	Calculate any movement that has to be done in the assembly code to
+ *	expand JUMP1 instructions to JUMP4 (because they jump more than
+ *	a 1-byte range).
+ *
+ * Results:
+ *	Returns a standard Tcl result, with an appropriate error message
+ *	if anything fails.
+ *
+ * Side effects:
+ *	Sets the 'startOffset' pointer in every basic block to the new
+ *	origin of the block, and turns off JUMP1 flags on instructions that
+ *	must be expanded (and adjusts them to the corresponding JUMP4's)
+ *	Does *not* store the jump offsets at this point.
+ *
+ *	Sets *mustMove to 1 if and only if at least one instruction changed
+ *	size so the code must be moved.
+ *	
+ *	As a side effect, also checks for undefined labels
+ *	and reports them.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CalculateJumpRelocations(AssemblyEnv* assemEnvPtr,
+				/* Assembler environment */
+			 int* mustMove)
+				/* OUTPUT: Number of bytes that have been
+				 * added to the code */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
+    Tcl_HashEntry* entry;	/* Exit label's entry in the symbol table */
+    BasicBlock* jumpTarget;	/* Basic block where the jump goes */
+    int motion;		        /* Amount by which the code has expanded */
+    int offset;			/* Offset in the bytecode from a jump
+				 * instruction to its target */
+    unsigned opcode;		/* Opcode in the bytecode being adjusted */
+
+    /* Iterate through basic blocks as long as a change results in
+     * code expansion */
+
+    *mustMove = 0;
+    do {
+	motion = 0;
+	for (bbPtr = assemEnvPtr->head_bb;
+	     bbPtr != NULL;
+	     bbPtr=bbPtr->successor1) {
+
+	    /* 
+	     * Advance the basic block start offset by however many bytes
+	     * we have inserted in the code up to this point
+	     */
+	    bbPtr->startOffset += motion;
+
+	    /* 
+	     * If the basic block references a label (and hence performs
+	     * a jump), find the location of the label. Report an error if
+	     * the label is missing.
+	     */
+	    if (bbPtr->jumpTarget != NULL) {
+		entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, 
+					  Tcl_GetString(bbPtr->jumpTarget));
+		if (entry == NULL) {
+		    ReportUndefinedLabel(assemEnvPtr, bbPtr,
+					 bbPtr->jumpTarget);
+		    return TCL_ERROR;
+		}
+
+		/* 
+		 * If the instruction is a JUMP1, turn it into a JUMP4 if its
+		 * target is out of range.
+		 */
+		jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+		if (bbPtr->flags & BB_JUMP1) {
+		    offset = jumpTarget->startOffset
+			- (bbPtr->jumpOffset + motion);
+		    if (offset < -0x80 || offset > 0x7f) {
+			opcode = TclGetUInt1AtPtr(envPtr->codeStart
+						  + bbPtr->jumpOffset);
+			++opcode;
+			TclStoreInt1AtPtr(opcode, 
+					  envPtr->codeStart
+					  + bbPtr->jumpOffset);
+			motion += 3;
+			bbPtr->flags &= ~BB_JUMP1;
+		    }
+		}
+	    }
+
+	    /*
+	     * If the basic block references a jump table, that doesn't
+	     * affect the code locations, but resolve the labels now, and
+	     * store basic block pointers in the jumptable hash.
+	     */
+
+	    if (bbPtr->flags & BB_JUMPTABLE) {
+		if (CheckJumpTableLabels(assemEnvPtr, bbPtr) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
+	}
+	*mustMove += motion;
+    } while (motion != 0);
+
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckJumpTableLabels --
+ *
+ *	Make sure that all the labels in a jump table are defined.
+ *
+ * Results:
+ *	Returns TCL_OK if they are, TCL_ERROR if they aren't.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckJumpTableLabels(AssemblyEnv* assemEnvPtr,
+				/* Assembly environment */
+		     BasicBlock* bbPtr)
+				/* Basic block that ends in a jump table */
+{
+    Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
+				/* Hash table with the symbols */
+    Tcl_HashSearch search;	/* Hash table iterator */
+    Tcl_HashEntry* symEntryPtr;	/* Hash entry for the symbols */
+    Tcl_Obj* symbolObj;		/* Jump target */
+    Tcl_HashEntry* valEntryPtr;	/* Hash entry for the resolutions */
+
+    /* Look up every jump target in the jump hash */
+
+    /* fprintf(stderr, "check jump table labels %p {\n", bbPtr); */
+    for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
+	 symEntryPtr != NULL;
+	 symEntryPtr = Tcl_NextHashEntry(&search)) {
+	symbolObj = (Tcl_Obj*) Tcl_GetHashValue(symEntryPtr);
+	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, 
+					Tcl_GetString(symbolObj));
+	/* fprintf(stderr, "  %s -> %s (%d)\n",
+		(char*)Tcl_GetHashKey(symHash, symEntryPtr),
+		Tcl_GetString(symbolObj),
+		(valEntryPtr != NULL)); fflush(stderr); */
+	if (valEntryPtr == NULL) {
+	    ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
+	    return TCL_ERROR;
+	}
+    }
+    /* fprintf(stderr, "}\n"); fflush(stderr); */
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ReportUndefinedLabel --
+ *
+ *	Report that a basic block refers to an undefined jump label
+ *
+ * Side effects:
+ *	Stores an error message, error code, and line number information in
+ *	the assembler's Tcl interpreter.
+ *
+ *-----------------------------------------------------------------------------
+ */
+static void
+ReportUndefinedLabel(AssemblyEnv* assemEnvPtr,
+				/* Assembler environment */
+		     BasicBlock* bbPtr,
+				/* Basic block that contains the
+				 * undefined label */
+		     Tcl_Obj* jumpTarget)
+				/* Label of a jump target */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    Tcl_Obj* result;		/* Error message */
+
+    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	result = Tcl_NewStringObj("undefined label \"", -1);
+	Tcl_AppendObjToObj(result, jumpTarget);
+	Tcl_AppendToObj(result, "\"", -1);
+	Tcl_SetObjResult(interp, result);
+	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
+			 Tcl_GetString(jumpTarget),  NULL);
+	Tcl_SetErrorLine(interp, bbPtr->jumpLine);
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * MoveCodeForJumps --
+ *
+ *	Move bytecodes in memory to accommodate JUMP1 instructions that have
+ *	expanded to become JUMP4's.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+MoveCodeForJumps(AssemblyEnv* assemEnvPtr,
+				/* Assembler environment */
+		 int mustMove)	/* Number of bytes of added code */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
+    int topOffset;		/* Bytecode offset of the following
+				 * basic block before code motion */
+
+    /* 
+     * Make sure that there is enough space in the bytecode array to accommodate
+     * the expanded code.
+     */
+
+    while (envPtr->codeEnd < envPtr->codeNext + mustMove) {
+	TclExpandCodeArray(envPtr);
+    }
+
+    /* 
+     * Iterate through the bytecodes in reverse order, and move them
+     * upward to their new homes.
+     */
+
+    topOffset = envPtr->codeNext - envPtr->codeStart;
+    for (bbPtr = assemEnvPtr->curr_bb; bbPtr != NULL; bbPtr = bbPtr->prevPtr) {
+	/* fprintf(stderr, "move code from %d to %d\n",
+		bbPtr->originalStartOffset, bbPtr->startOffset); fflush(stderr);
+	*/
+	memmove(envPtr->codeStart + bbPtr->startOffset,
+		envPtr->codeStart + bbPtr->originalStartOffset,
+		topOffset - bbPtr->originalStartOffset);
+	topOffset = bbPtr->originalStartOffset;
+	bbPtr->jumpOffset += (bbPtr->startOffset - bbPtr->originalStartOffset);
+    }
+    envPtr->codeNext += mustMove;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FillInJumpOffsets --
+ *
+ *	Fill in the final offsets of all jump instructions once bytecode
+ *	locations have been completely determined.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+FillInJumpOffsets(AssemblyEnv* assemEnvPtr)
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
+    Tcl_HashEntry* entry;	/* Hashtable entry for a jump target label */
+    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
+    int fromOffset;		/* Bytecode location of a jump instruction */
+    int targetOffset;		/* Bytecode location of a jump instruction's
+				 * target */
+
+    for (bbPtr = assemEnvPtr->head_bb;
+	 bbPtr != NULL;
+	 bbPtr = bbPtr->successor1) {
+	if (bbPtr->jumpTarget != NULL) {
+	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, 
+				      Tcl_GetString(bbPtr->jumpTarget));
+	    jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+	    fromOffset = bbPtr->jumpOffset;
+	    targetOffset = jumpTarget->startOffset;
+	    if (bbPtr->flags & BB_JUMP1) {
+		TclStoreInt1AtPtr(targetOffset - fromOffset,
+				  envPtr->codeStart + fromOffset + 1);
+	    } else {
+		TclStoreInt4AtPtr(targetOffset - fromOffset,
+				  envPtr->codeStart + fromOffset + 1);
+	    }
+	}
+	if (bbPtr->flags & BB_JUMPTABLE) {
+	    ResolveJumpTableTargets(assemEnvPtr, bbPtr);
+	}
+    }
+
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ResolveJumpTableTargets --
+ *
+ *	Puts bytecode addresses for the targets of a jumptable into the
+ *	table
+ *
+ * Results:
+ *	Returns TCL_OK if they are, TCL_ERROR if they aren't.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr,
+				/* Assembly environment */
+			BasicBlock* bbPtr)
+				/* Basic block that ends in a jump table */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;;
+				/* Compilation environment */
+    Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
+				/* Hash table with the symbols */
+    Tcl_HashSearch search;	/* Hash table iterator */
+    Tcl_HashEntry* symEntryPtr;	/* Hash entry for the symbols */
+    Tcl_Obj* symbolObj;		/* Jump target */
+    Tcl_HashEntry* valEntryPtr;	/* Hash entry for the resolutions */
+    int auxDataIndex;		/* Index of the auxdata */
+    JumptableInfo* realJumpTablePtr;
+				/* Jump table in the actual code */
+    Tcl_HashTable* realJumpHashPtr;
+				/* Jump table hash in the actual code */
+    Tcl_HashEntry* realJumpEntryPtr;
+				/* Entry in the jump table hash in 
+				 * the actual code */
+    BasicBlock* jumpTargetBBPtr;
+				/* Basic block that the jump proceeds to */
+    int junk;
+    
+    auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
+    /* fprintf(stderr, "bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", 
+       bbPtr, bbPtr->jumpOffset, auxDataIndex); */
+    realJumpTablePtr = (JumptableInfo*)
+	envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+    realJumpHashPtr = &(realJumpTablePtr->hashTable);
+
+    /* Look up every jump target in the jump hash */
+
+    /* fprintf(stderr, "resolve jump table {\n"); fflush(stderr); */
+    for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
+	 symEntryPtr != NULL;
+	 symEntryPtr = Tcl_NextHashEntry(&search)) {
+	symbolObj = (Tcl_Obj*) Tcl_GetHashValue(symEntryPtr);
+	/* fprintf(stderr, "     symbol %s\n", Tcl_GetString(symbolObj)); */
+	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+					Tcl_GetString(symbolObj));
+	jumpTargetBBPtr = (BasicBlock*) Tcl_GetHashValue(valEntryPtr);
+	realJumpEntryPtr =
+	    Tcl_CreateHashEntry(realJumpHashPtr,
+				Tcl_GetHashKey(symHash, symEntryPtr),
+				&junk);
+	/* fprintf(stderr, "  %s -> %s -> bb %p (pc %d)    hash entry %p\n",
+		(char*)Tcl_GetHashKey(symHash, symEntryPtr),
+		Tcl_GetString(symbolObj), jumpTargetBBPtr,
+		jumpTargetBBPtr->startOffset, realJumpEntryPtr);
+	   fflush(stderr); */
+	Tcl_SetHashValue(realJumpEntryPtr,
+			 (ClientData) (jumpTargetBBPtr->startOffset
+				       - bbPtr->jumpOffset));
+    }
+    /* fprintf(stderr, "}\n"); fflush(stderr); */
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckForThrowInWrongContext --
+ *
+ *	Verify that no beginCatch/endCatch sequence can throw an exception
+ *	after an original exception is caught and before its exception
+ *	context is removed from the stack.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	Stores an appropriate error message in the interpreter as needed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckForThrowInWrongContext(AssemblyEnv* assemEnvPtr)
+				/* Assembler environment */
+{
+    BasicBlock* blockPtr;	/* Current basic block */
+
+    /* 
+     * Walk through the basic blocks in turn, checking all the ones
+     * that have caught an exception and not disposed of it properly.
+     */
+
+    for (blockPtr = assemEnvPtr->head_bb;
+	 blockPtr != NULL;
+	 blockPtr = blockPtr->successor1) {
+
+	if (blockPtr->catchState == BBCS_CAUGHT) {
+
+	    /* Walk through the instructions in the basic block */
+
+	    if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckNonThrowingBlock --
+ *
+ *	Check that a basic block cannot throw an exception.
+ *
+ * Results:
+ *	Returns TCL_ERROR if the block cannot be proven to be nonthrowing.
+ *
+ * Side effects:
+ *	Stashes an error message in the interpreter result.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr,
+				/* Assembler environment */
+		      BasicBlock* blockPtr)
+				/* Basic block where exceptions are
+				 * not allowed */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    BasicBlock* nextPtr;	/* Pointer to the succeeding basic block */
+    int offset;			/* Bytecode offset of the current instruction */
+    int bound;			/* Bytecode offset following the last
+				 * instruction of the block. */
+    unsigned char opcode;	/* Current bytecode instruction */
+    Tcl_Obj* retval;		/* Error message */
+
+    /* Determine where in the code array the basic block ends */
+    
+    nextPtr = blockPtr->successor1;
+    if (nextPtr == NULL) {
+	bound = envPtr->codeNext - envPtr->codeStart;
+    } else {
+	bound = nextPtr->startOffset;
+    }
+
+    /* Walk through the instructions of the block */
+
+    offset = blockPtr->startOffset;
+    while (offset < bound) {
+
+	/* Determine whether an instruction is nonthrowing */
+	
+	opcode = (envPtr->codeStart)[offset];
+
+	if (BytecodeMightThrow(opcode)) {
+
+	    /* Report an error for a throw in the wrong context */
+
+	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+		retval = Tcl_NewStringObj("\"", -1);
+		Tcl_AppendToObj(retval, tclInstructionTable[opcode].name,
+				-1);
+		Tcl_AppendToObj(retval, "\" instruction may not appear in "
+				"a context where an exception has been "
+				"caught and not disposed of.", -1);
+		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
+		Tcl_SetObjResult(interp, retval);
+		AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+	    }
+	    return TCL_ERROR;
+	}
+	offset += tclInstructionTable[opcode].numBytes;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BytecodeMightThrow --
+ *
+ *	Tests if a given bytecode instruction might throw an exception.
+ *
+ * Results:
+ *	Returns 1 if the bytecode might throw an exception, 0 if the
+ *	instruction is known never to throw.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+BytecodeMightThrow(unsigned char opcode)
+{
+
+    /* Binary search on the non-throwing bytecode list */
+
+    int min = 0;
+    int max = sizeof(NonThrowingByteCodes)-1;
+    int mid;
+    unsigned char c;
+    while (max >= min) {
+	mid = (min + max) / 2;
+	c = NonThrowingByteCodes[mid];
+	if (opcode < c) {
+	    max = mid-1;
+	} else if (opcode > c) {
+	    min = mid+1;
+	} else {
+
+	    /* Opcode is nonthrowing */
+
+	    return 0;
+	}
+    }
+
+    return 1;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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(AssemblyEnv* 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;
+    }
+
+    /* Post the max stack depth back to the compilation environment */
+
+    maxDepth = assemEnvPtr->maxDepth + envPtr->currStackDepth;
+    if (maxDepth > envPtr->maxStackDepth) {
+	envPtr->maxStackDepth = maxDepth;
+    }
+
+    /* If the exit is reachable, make sure that the program exits with
+     * 1 operand on the stack. */
+
+    if (StackCheckExit(assemEnvPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Reset the visited state on all basic blocks */
+
+    ResetVisitedBasicBlocks(assemEnvPtr);
+
+    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(AssemblyEnv* 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 */
+    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
+    int stackDepth;		/* Current stack depth */
+    int maxDepth;		/* Maximum stack depth so far */
+    int result;			/* Tcl status return */
+    Tcl_HashSearch jtSearch;	/* Search structure for the jump table */
+    Tcl_HashEntry* jtEntry;	/* Hash entry in the jump table */
+    Tcl_Obj* targetLabel;	/* Target label from the jump table */
+    Tcl_HashEntry* entry;	/* Hash entry in the label table */
+
+    if (blockPtr->flags & BB_VISITED) {
+
+	/* 
+	 * If the block is already visited, check stack depth for consistency
+	 * among the paths that reach it.
+	 */
+        if (blockPtr->initialStackDepth != initialStackDepth) {
+	    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;
+        }
+    }
+
+    /*
+     * 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.
+     */
+    blockPtr->flags |= BB_VISITED;
+    blockPtr->predecessor = predecessor;
+    blockPtr->initialStackDepth = initialStackDepth;
+
+    /* 
+     * Calculate minimum stack depth, and flag an error if the block
+     * underflows the stack.
+     */
+    if (initialStackDepth + blockPtr->minStackDepth < 0) {
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj("stack underflow", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+	    Tcl_SetErrorLine(interp, blockPtr->startLine);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make sure that the block doesn't try to pop below the stack level
+     * of an enclosing catch.
+     */
+    if (blockPtr->enclosingCatch != 0
+	&& initialStackDepth + blockPtr->minStackDepth
+	< (blockPtr->enclosingCatch->initialStackDepth
+	   + blockPtr->enclosingCatch->finalStackDepth)) {
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj("code pops stack below level of"
+					      " enclosing catch", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1);
+	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+	    Tcl_SetErrorLine(interp, blockPtr->startLine);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * Update maximum stgack depth.
+     */
+    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->flags & BB_FALLTHRU) {
+        result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1,
+				      blockPtr, stackDepth);        
+        
+    }
+    if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
+	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+				  Tcl_GetString(blockPtr->jumpTarget));
+	jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+        result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
+				      blockPtr, stackDepth);
+    }
+
+    /* All blocks referenced in a jump table are successors */
+
+    if (blockPtr->flags & BB_JUMPTABLE) {
+	for (jtEntry = Tcl_FirstHashEntry(&(blockPtr->jtPtr->hashTable),
+					  &jtSearch);
+	     result == TCL_OK && jtEntry != NULL;
+	     jtEntry = Tcl_NextHashEntry(&jtSearch)) {
+	    targetLabel = (Tcl_Obj*) Tcl_GetHashValue(jtEntry);
+	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+				      Tcl_GetString(targetLabel));
+	    jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+	    result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
+					  blockPtr, stackDepth);
+	}
+    }
+	    
+    return result;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * StackCheckExit --
+ *
+ *	Makes sure that the net stack effect of an entire assembly language
+ *	script is to push 1 result.
+ *
+ * Results:
+ *	Returns a standard Tcl result, with an error message in the interpreter
+ *	result if the stack is wrong.
+ *
+ * Side effects:
+ *	If the assembly code had a net stack effect of zero, emits code
+ *	to the concluding block to push a null result. In any case, 
+ *	updates the stack depth in the compile environment to reflect
+ * 	the net effect of the assembly code.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+StackCheckExit(AssemblyEnv* assemEnvPtr)
+				/* Assembler environment */
+{
+
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    int depth;			/* Net stack effect */
+    int litIndex;		/* Index in the literal pool of the empty 
+				 * string */
+    Tcl_Obj* depthObj;		/* Net stack effect for an error message */
+    Tcl_Obj* resultObj;		/* Error message from this procedure */
+    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
+				/* Final basic block in the assembly */
+
+    /* 
+     * Don't perform these checks if execution doesn't reach the
+     * exit (either because of an infinite loop or because the only
+     * return is from the middle. 
+     */
+
+    if (curr_bb->flags & BB_VISITED) {
+
+    	/* Exit with no operands; push an empty one. */
+
+    	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;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ProcessCatches --
+ *
+ *	First pass of 'catch' processing. 
+ *
+ * Results:
+ *	Returns a standard Tcl result, with an appropriate error message
+ *	if the result is TCL_ERROR.
+ *
+ * Side effects:
+ *	Labels all basic blocks with their enclosing catches.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+ProcessCatches(AssemblyEnv* assemEnvPtr)
+				/* Assembler environment */
+{
+    BasicBlock* blockPtr;	/* Pointer to a basic block */
+
+    /*
+     * Clear the catch state of all basic blocks
+     */
+
+    for (blockPtr = assemEnvPtr->head_bb;
+	 blockPtr != NULL;
+	 blockPtr = blockPtr->successor1) {
+	blockPtr->catchState = BBCS_UNKNOWN;
+	blockPtr->enclosingCatch = NULL;
+    }
+
+    /* 
+     * Start the check recursively from the first basic block, which
+     * is outside any exception context 
+     */
+
+    if (ProcessCatchesInBasicBlock(assemEnvPtr, assemEnvPtr->head_bb,
+				   NULL, BBCS_NONE, 0) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Check for unclosed catch on exit */
+
+    if (CheckForUnclosedCatches(assemEnvPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Now there's enough information to build the exception ranges. */
+
+    if (BuildExceptionRanges(assemEnvPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Finally, restore any exception ranges from embedded scripts */
+
+    RestoreEmbeddedExceptionRanges(assemEnvPtr);
+
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ProcessCatchesInBasicBlock --
+ *
+ *	First-pass catch processing for one basic block.
+ *
+ * Results:
+ *	Returns a standard Tcl result, with error message in the interpreter
+ *	result if an error occurs.
+ *
+ * This procedure checks consistency of the exception context through the
+ * assembler program, and records the enclosing 'catch' for every basic
+ * block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
+				/* Assembler environment */
+			   BasicBlock* bbPtr,
+				/* Basic block being processed */
+			   BasicBlock* enclosing,
+				/* Start basic block of the enclosing catch */
+			   enum BasicBlockCatchState state,
+				/* BBCS_NONE, BBCS_INCATCH, or BBCS_CAUGHT */
+			   int catchDepth)
+				/* Depth of nesting of catches */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+    int result;			/* Return value from this procedure */
+    BasicBlock* fallThruEnclosing;
+				/* Enclosing catch if execution falls thru */
+    enum BasicBlockCatchState fallThruState;
+				/* Catch state of the successor block */
+    BasicBlock* jumpEnclosing;
+				/* Enclosing catch if execution goes to
+				 * jump target */
+    enum BasicBlockCatchState jumpState;
+				/* Catch state of the jump target */
+    int changed = 0;		/* Flag == 1 iff successor blocks need
+				 * to be checked because the state of this
+				 * block has changed. */
+    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
+    Tcl_HashSearch jtSearch;	/* Hash search control for a jumptable */
+    Tcl_HashEntry* jtEntry;	/* Entry in a jumptable */
+    Tcl_Obj* targetLabel;	/* Target label from a jumptable */
+    Tcl_HashEntry* entry;	/* Entry from the label table */
+
+    /* 
+     * Update the state of the current block, checking for consistency.
+     * Set 'changed' to 1 if the state changes and successor blocks
+     * need to be rechecked.
+     */
+
+    if (bbPtr->catchState == BBCS_UNKNOWN) {
+	bbPtr->enclosingCatch = enclosing;
+    } else if (bbPtr->enclosingCatch != enclosing) {
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj("execution reaches an "
+					      "instruction in "
+					      "inconsistent exception contexts",
+					      -1));
+	    Tcl_SetErrorLine(interp, bbPtr->startLine);
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
+	}
+	return TCL_ERROR;
+    } 
+    if (state > bbPtr->catchState) {
+	bbPtr->catchState = state;
+	changed = 1;
+    }
+
+    /* 
+     * If this block has been visited before, and its state hasn't
+     * changed, we're done with it for now.
+     */
+
+    if (!changed) {
+	return TCL_OK;
+    }
+    bbPtr->catchDepth = catchDepth;
+
+    /*
+     * Determine enclosing catch and 'caught' state for the fallthrough
+     * and the jump target. Default for both is the state of the current block.
+     */
+
+    fallThruEnclosing = enclosing;
+    fallThruState = state;
+    jumpEnclosing = enclosing;
+    jumpState = state;
+
+    /* TODO: Make sure that the test cases include validating
+     *       that a natural loop can't include 'beginCatch' or 'endCatch' */
+
+    if (bbPtr->flags & BB_BEGINCATCH) {
+	/* 
+	 * If the block begins a catch, the state for the successor is
+	 * 'in catch'. The jump target is the exception exit, and the state
+	 * of the jump target is 'caught.'
+	 */
+	fallThruEnclosing = bbPtr;
+	fallThruState = BBCS_INCATCH;
+	jumpEnclosing = bbPtr;
+	jumpState = BBCS_CAUGHT;
+	++catchDepth;
+    } 
+
+    if (bbPtr->flags & BB_ENDCATCH) {
+	/*
+	 * If the block ends a catch, the state for the successor is
+	 * whatever the state was on entry to the catch.
+	 */
+	if (enclosing == NULL) {
+	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+		Tcl_SetObjResult(interp,
+				 Tcl_NewStringObj("endCatch without a "
+						  "corresponding beginCatch",
+						  -1));
+		Tcl_SetErrorLine(interp, bbPtr->startLine);
+		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
+	    }
+	    return TCL_ERROR;
+	}
+	fallThruEnclosing = enclosing->enclosingCatch;
+	fallThruState = enclosing->catchState;
+	--catchDepth;
+    }
+
+    /*
+     * Visit any successor blocks with the appropriate exception context
+     */
+
+    result = TCL_OK;
+    if (bbPtr->flags & BB_FALLTHRU) {
+        result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1,
+					    fallThruEnclosing, fallThruState,
+					    catchDepth);        
+    }
+    if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
+	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+				  Tcl_GetString(bbPtr->jumpTarget));
+	jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+        result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
+					    jumpEnclosing, jumpState,
+					    catchDepth);
+    }
+    
+    /* All blocks referenced in a jump table are successors */
+
+    if (bbPtr->flags & BB_JUMPTABLE) {
+	for (jtEntry = Tcl_FirstHashEntry(&(bbPtr->jtPtr->hashTable),
+					  &jtSearch);
+	     result == TCL_OK && jtEntry != NULL;
+	     jtEntry = Tcl_NextHashEntry(&jtSearch)) {
+	    targetLabel = (Tcl_Obj*) Tcl_GetHashValue(jtEntry);
+	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+				      Tcl_GetString(targetLabel));
+	    jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+	    result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
+						jumpEnclosing, jumpState,
+						catchDepth);
+	}
+    }
+	    
+    return result;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckForUnclosedCatches -- 
+ *
+ *	Checks that a sequence of assembly code has no unclosed catches
+ *	on exit.
+ *
+ * Results:
+ *	Returns a standard Tcl result, with an error message for unclosed
+ *	catches.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr)
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+				/* Tcl interpreter */
+
+    if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) {
+	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("catch still active on "
+						      "exit from assembly "
+						      "code", -1));
+	    Tcl_SetErrorLine(interp,
+			     assemEnvPtr->curr_bb->enclosingCatch->startLine);
+	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BuildExceptionRanges --
+ *
+ *	Walks through the assembly code and builds exception ranges for
+ *	the catches embedded therein.
+ *
+ * Results:
+ *	Returns a standard Tcl result with an error message in the interpreter
+ *	if anything is unsuccessful.
+ *
+ * Side effects:
+ *	Each contiguous block of code with a given catch exit is assigned
+ *	an exception range at the appropriate level.
+ *	Exception ranges in embedded blocks have their levels corrected
+ *	and collated into the table.
+ *	Blocks that end with 'beginCatch' are associated with the innermost
+ *	exception range of the following block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+BuildExceptionRanges(AssemblyEnv* assemEnvPtr)
+				/* Assembler environment */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* bbPtr;		/* Current basic block */
+    BasicBlock* prevPtr = NULL;	/* Previous basic block */
+    int catchDepth = 0;		/* Current catch depth */
+    int maxCatchDepth= 0;	/* Maximum catch depth in the program */
+    BasicBlock** catches;	/* Stack of catches in progress */
+    int* catchIndices;		/* Indices of the exception ranges
+				 * of catches in progress */
+    int i;
+
+    /* 
+     * Determine the max catch depth for the entire assembly script
+     * (excluding embedded eval's and expr's, which will be handled later).
+     */
+    for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
+	if (bbPtr->catchDepth > maxCatchDepth) {
+	    maxCatchDepth = bbPtr->catchDepth;
+	}
+    }
+
+    /* Allocate memory for a stack of active catches */
+
+    catches = (BasicBlock**) ckalloc(maxCatchDepth * sizeof(BasicBlock*));
+    catchIndices = (int*) ckalloc(maxCatchDepth * sizeof(int));
+    for (i = 0; i < maxCatchDepth; ++i) {
+	catches[i] = NULL;
+	catchIndices[i] = -1;
+    }
+
+    /* Walk through the basic blocks and manage exception ranges. */
+
+    for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
+
+	UnstackExpiredCatches(envPtr, bbPtr, catchDepth,
+			      catches, catchIndices);
+	LookForFreshCatches(bbPtr, catches);
+	StackFreshCatches(assemEnvPtr, bbPtr, catchDepth,
+			  catches, catchIndices);
+
+	/* If the last block was a 'begin catch', fill in the exception range */
+
+	catchDepth = bbPtr->catchDepth;
+	if (prevPtr != NULL
+	    && (prevPtr->flags & BB_BEGINCATCH)) {
+	    TclStoreInt4AtPtr(catchIndices[catchDepth-1],
+			      envPtr->codeStart + bbPtr->startOffset - 4);
+	}
+
+	prevPtr = bbPtr;
+    }
+
+    if (catchDepth != 0) {
+	Tcl_Panic("unclosed catch at end of code in "
+		  "tclAssembly.c:BuildExceptionRanges, can't happen");
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * UnstackExpiredCatches --
+ *
+ *	Unstacks and closes the exception ranges for any catch contexts that
+ *	were active in the previous basic block but are inactive in the
+ *	current one.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+UnstackExpiredCatches(CompileEnv* envPtr,
+				/* Compilation environment */
+		      BasicBlock* bbPtr,
+				/* Basic block being processed */
+		      int catchDepth,
+				/* Depth of nesting of catches prior to
+				 * entry to this block */
+		      BasicBlock** catches,
+				/* Array of catch contexts */
+		      int* catchIndices)
+				/* Indices of the exception ranges 
+				 * corresponding to the catch contexts */
+{
+
+    ExceptionRange* range;	/* Exception range for a specific catch */
+    BasicBlock* catch;		/* Catch block being examined */
+    BasicBlockCatchState catchState;
+				/* State of the code relative to
+				 * the catch block being examined 
+				 * ("in catch" or "caught") */
+
+    /* 
+     * Unstack any catches that are deeper than the nesting level of
+     * the basic block being entered.
+     */
+    
+    while (catchDepth > bbPtr->catchDepth) {
+	--catchDepth;
+	range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+	range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+	catches[catchDepth] = NULL;
+	catchIndices[catchDepth] = -1;
+    }
+
+    /* 
+     * Unstack any catches that don't match the basic block being entered,
+     * either because they are no longer part of the context, or because
+     * the context has changed from INCATCH to CAUGHT.
+     */
+    
+    catchState = bbPtr->catchState;
+    catch = bbPtr->enclosingCatch;
+    while (catchDepth > 0) {
+	--catchDepth;
+	if (catches[catchDepth] != NULL) {
+	    if (catches[catchDepth] != catch
+		|| catchState >= BBCS_CAUGHT) {
+		range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+		range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+		catches[catchDepth] = NULL;
+		catchIndices[catchDepth] = -1;
+	    }
+	    catchState = catch->catchState;
+	    catch = catch->enclosingCatch;
+	}
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * LookForFreshCatches --
+ *
+ *	Determines whether a basic block being entered needs any exception
+ *	ranges that are not already stacked.
+ *
+ * Does not create the ranges: this procedure iterates from the innermost
+ * catch outward, but exception ranges must be created from the outermost
+ * catch inward.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+LookForFreshCatches(BasicBlock* bbPtr,
+				/* Basic block being entered */
+		    BasicBlock** catches)
+				/* Array of catch contexts that are
+				 * already entered */
+{
+    BasicBlockCatchState catchState;
+				/* State ("in catch" or "caught" of
+				 * the current catch. */
+    BasicBlock* catch;		/* Current enclosing catch */
+    int catchDepth;		/* Nesting depth of the current catch */
+
+    catchState = bbPtr->catchState;
+    catch = bbPtr->enclosingCatch;
+    catchDepth = bbPtr->catchDepth;
+    while (catchDepth > 0) {
+	--catchDepth;
+	if (catches[catchDepth] != catch && catchState < BBCS_CAUGHT) {
+	    catches[catchDepth] = catch;
+	}
+	catchState = catch->catchState;
+	catch = catch->enclosingCatch;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------\ *
+ * StackFreshCatches --
+ *
+ *	Make ExceptionRange records for any catches that are in the
+ *	basic block being entered and were not in the previous basic block.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+StackFreshCatches(AssemblyEnv* assemEnvPtr,
+				/* Assembly environment */
+		  BasicBlock* bbPtr,
+				/* Basic block being processed */
+		  int catchDepth,
+				/* Depth of nesting of catches prior to
+				 * entry to this block */
+		  BasicBlock** catches,
+				/* Array of catch contexts */
+		  int* catchIndices)
+				/* Indices of the exception ranges 
+				 * corresponding to the catch contexts */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    ExceptionRange* range;	/* Exception range for a specific catch */
+    BasicBlock* catch;		/* Catch block being examined */
+    BasicBlock* errorExit;	/* Error exit from the catch block */
+    Tcl_HashEntry* entryPtr;
+
+    catchDepth = 0;
+
+    /*
+     * Iterate through the enclosing catch blocks from the outside in,
+     * looking for ones that don't have exception ranges (and are uncaught)
+     */
+
+    for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) {
+	if (catchIndices[catchDepth] == -1  && catches[catchDepth] != NULL) {
+
+	    /* Create an exception range for a block that needs one. */
+
+	    catch = catches[catchDepth];
+	    catchIndices[catchDepth] =
+		TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	    range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+	    range->nestingLevel = envPtr->exceptDepth + catchDepth;
+	    envPtr->maxExceptDepth =
+		TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth);
+	    range->codeOffset = bbPtr->startOffset;
+	    
+	    if ((entryPtr =
+		 Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+				   Tcl_GetString(catch->jumpTarget)))
+		== NULL) {
+		Tcl_Panic("undefined label in tclAssembly.c:"
+			  "BuildExceptionRanges, can't happen");
+	    } else {
+		errorExit = (BasicBlock*) Tcl_GetHashValue(entryPtr);
+		range->catchOffset = errorExit->startOffset;
+	    }
+	}
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * RestoreEmbeddedExceptionRanges --
+ *
+ *	Processes an assembly script, replacing any exception ranges that
+ *	were present in embedded code.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr)
+				/* Assembler environment */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* bbPtr;		/* Current basic block */
+    int rangeBase;		/* Base of the foreign exception ranges
+				 * when they are reinstalled */
+    int rangeIndex;		/* Index of the current foreign exception
+				 * range as reinstalled */
+    ExceptionRange* range;      /* Current foreign exception range */
+    unsigned char opcode;	/* Current instruction's opcode */
+    unsigned int catchIndex;	/* Index of the exception range to which
+				 * the current instruction refers */
+    int i;
+
+    /* Walk the basic blocks looking for exceptions in embedded scripts */
+
+    for (bbPtr = assemEnvPtr->head_bb;
+	 bbPtr != NULL;
+	 bbPtr = bbPtr->successor1) {
+	if (bbPtr->foreignExceptionCount != 0) {
+	    /* 
+	     * Reinstall the embedded exceptions and track their 
+	     * nesting level 
+	     */
+	    rangeBase = envPtr->exceptArrayNext;
+	    for (i = 0; i < bbPtr->foreignExceptionCount; ++i) {
+		range = bbPtr->foreignExceptions + i;
+		rangeIndex = TclCreateExceptRange(range->type, envPtr);
+		range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth;
+		memcpy(envPtr->exceptArrayPtr + rangeIndex, range,
+		       sizeof(ExceptionRange));
+		if (range->nestingLevel >= envPtr->maxExceptDepth) {
+		    envPtr->maxExceptDepth = range->nestingLevel + 1;
+		}
+	    }
+
+	    /*
+	     * Walk through the bytecode of the basic block, and relocate
+	     * INST_BEGIN_CATCH4 instructions to the new locations
+	     */
+	    i = bbPtr->startOffset;
+	    while (i < bbPtr->successor1->startOffset) {
+		opcode = envPtr->codeStart[i];
+		if (opcode == INST_BEGIN_CATCH4) {
+		    catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1);
+		    if (catchIndex >= bbPtr->foreignExceptionBase
+			&& catchIndex < (bbPtr->foreignExceptionBase +
+					 bbPtr->foreignExceptionCount)) {
+			catchIndex -= bbPtr->foreignExceptionBase;
+			catchIndex += rangeBase;
+			TclStoreInt4AtPtr(catchIndex,
+					  envPtr->codeStart + i + 1);
+		    }
+		}
+		i += tclInstructionTable[opcode].numBytes;
+	    }
+	}
+    }
+
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * ResetVisitedBasicBlocks --
+ *
+ *	Turns off the 'visited' flag in all basic blocks at the conclusion
+ *	of a pass.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+ResetVisitedBasicBlocks(AssemblyEnv* assemEnvPtr)
+{
+    BasicBlock* block;
+    for (block = assemEnvPtr->head_bb; block != NULL; 
+	 block = block->successor1) {
+	block->flags &= ~BB_VISITED;
+    }
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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(AssemblyEnv* 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);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * DupAssembleCodeInternalRep --
+ *
+ *	Part of the Tcl object type implementation for Tcl assembly language
+ *	bytecode. We do not copy the bytecode intrep. Instead, we return
+ *	without setting copyPtr->typePtr, so the copy is a plain string copy
+ *	of the assembly source, and if it is to be used as a compiled
+ *	expression, it will need to be reprocessed.
+ *
+ *	This makes sense, because with Tcl's copy-on-write practices, the
+ *	usual (only?) time Tcl_DuplicateObj() will be called is when the copy
+ *	is about to be modified, which would invalidate any copied bytecode
+ *	anyway. The only reason it might make sense to copy the bytecode is if
+ *	we had some modifying routines that operated directly on the intrep,
+ *	as we do for lists and dicts.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+  
+static void
+DupAssembleCodeInternalRep(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *copyPtr)
+{
+    return;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * FreeAssembleCodeInternalRep --
+ *
+ *	Part of the Tcl object type implementation for Tcl expression
+ *	bytecode. Frees the storage allocated to hold the internal rep, unless
+ *	ref counts indicate bytecode execution is still in progress.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May free allocated memory. Leaves objPtr untyped.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static void
+FreeAssembleCodeInternalRep(
+    Tcl_Obj *objPtr)
+{
+    ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+
+    codePtr->refCount--;
+    if (codePtr->refCount <= 0) {
+	TclCleanupByteCode(codePtr);
+    }
+    objPtr->typePtr = NULL;
+    objPtr->internalRep.otherValuePtr = NULL;
+}
+	    
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ce5be25..b07a55d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -824,6 +824,13 @@ Tcl_CreateInterp(void)
     Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
 	    Tcl_RepresentationCmd, NULL, NULL);
 
+    /* Adding the bytecode assembler command */
+    cmdPtr = (Command*)
+        Tcl_NRCreateCommand(interp, "::tcl::unsupported::assemble",
+                            Tcl_AssembleObjCmd, TclNRAssembleObjCmd,
+                            NULL, NULL);
+    cmdPtr->compileProc = &TclCompileAssembleCmd;
+
     Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldTo", NULL,
 	    TclNRYieldToObjCmd, NULL, NULL);
     Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldm", NULL,
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a804969..ca87530 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3210,6 +3210,15 @@ MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+			    
+/* Assemble command function */			    
+MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);			    
+MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);			    
+			    
 MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3702,6 +3711,10 @@ MODULE_SCOPE int	TclStreqOpCmd(ClientData clientData,
 MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+			    
+MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 
 /*
  * Functions defined in generic/tclVar.c and currenttly exported only for use
diff --git a/tests/assemble.test b/tests/assemble.test
new file mode 100644
index 0000000..b9178ec
--- /dev/null
+++ b/tests/assemble.test
@@ -0,0 +1,3441 @@
+# assemble.test --
+#
+#	Test suite for the 'tcl::unsupported::assemble' command
+#
+# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
+# Copyright (c) 2010 by Kevin B. Kenny.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: assemble.test,v 1.1.2.16 2010/12/16 01:40:42 kennykb Exp $
+#-----------------------------------------------------------------------------
+
+# Commands covered: assemble
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.2
+    namespace import -force ::tcltest::*
+}
+namespace eval tcl::unsupported {namespace export assemble}
+namespace import tcl::unsupported::assemble
+
+# Procedure to make code that fills the literal and local variable tables,
+# to force instructions to spill to four bytes.
+
+proc fillTables {} {
+    set s {}
+    set sep {}
+    for {set i 0} {$i < 256} {incr i} {
+	append s $sep [list set v$i literal$i]
+	set sep \n
+    }
+    return $s
+}
+
+# assemble-1 - TclNRAssembleObjCmd
+
+test assemble-1.1 {wrong # args, direct eval} {
+    -body {
+	eval [list assemble]
+    }
+    -returnCodes error
+    -result {wrong # args*}
+    -match glob
+}
+
+test assemble-1.2 {wrong # args, direct eval} {
+    -body {
+	eval [list assemble too many]
+    }
+    -returnCodes error
+    -result {wrong # args*}
+    -match glob
+}
+
+test assemble-1.3 {error reporting, direct eval} {
+    -body {
+	list [catch {
+	    eval [list assemble {
+		# bad opcode
+		rubbish
+	    }]
+	} result] $result $errorInfo
+    }
+    -match glob
+    -result {1 {bad instruction "rubbish":*} {bad instruction "rubbish":*
+    while executing
+"rubbish"
+    ("assemble" body, line 3)*}}
+    -cleanup {unset result}
+}
+
+test assemble-1.4 {simple direct eval} {
+    -body {
+	eval [list assemble {push {this is a test}}]
+    }
+    -result {this is a test}
+}
+
+# assemble-2 - CompileAssembleObj
+
+test assemble-2.1 {bytecode reuse, direct eval} {
+    -body {
+	set x {push "this is a test"}
+	list [eval [list assemble $x]] \
+	    [eval [list assemble $x]]
+    }
+    -result {{this is a test} {this is a test}}
+}
+
+test assemble-2.2 {bytecode discard, direct eval} {
+    -body {
+	set x {load value}
+	proc p1 {x} {
+	    set value value1
+	    assemble $x
+	}
+	proc p2 {x} {
+	    set a b
+	    set value value2
+	    assemble $x
+	}
+	list [p1 $x] [p2 $x]
+    }
+    -result {value1 value2}
+    -cleanup {
+	unset x
+	rename p1 {}
+	rename p2 {}
+    }
+}
+
+test assemble-2.3 {null script, direct eval} {
+    -body {
+	set x {}
+	assemble $x
+    }
+    -result {}
+    -cleanup {unset x}
+}
+
+# assemble-3 - TclCompileAssembleCmd
+
+test assemble-3.1 {wrong # args, compiled path} {
+    -body {
+	proc x {} {
+	    assemble
+	}
+	x
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args:*}
+}
+
+test assemble-3.2 {wrong # args, compiled path} {
+    -body {
+	proc x {} {
+	    assemble too many
+	}
+	x
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args:*}
+    -cleanup {
+	rename x {}
+    }
+}
+
+# assemble-4 - TclAssembleCode mainline
+
+test assemble-4.1 {syntax error} {
+    -body {
+	proc x {} {
+	    assemble {
+		{}extra
+	    }
+	}
+	list [catch x result] $result $::errorInfo
+    }
+    -cleanup {
+	rename x {}
+	unset result
+    }
+    -match glob
+    -result {1 {extra characters after close-brace} {extra characters after close-brace
+    while executing
+"{}extra
+	    "
+    ("assemble" body, line 2)*}}
+}
+
+test assemble-4.2 {null command} {
+    -body {
+	proc x {} {
+	    assemble {
+		push hello; pop;;push goodbye
+	    }
+	}
+	x
+    }
+    -result goodbye
+    -cleanup {
+	rename x {}
+    }
+}
+
+# assemble-5 - GetNextOperand off-nominal cases
+
+test assemble-5.1 {unsupported expansion} {
+    -body {
+	proc x {y} {
+	    assemble {
+		{*}$y
+	    }
+	}
+	list [catch {x {push hello}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+    -cleanup {
+	rename x {}
+	unset result
+    }
+}
+
+test assemble-5.2 {unsupported substitution} {
+    -body {
+	proc x {y} {
+	    assemble {
+		$y
+	    }
+	}
+	list [catch {x {nop}} result] $result $::errorCode
+    }
+    -cleanup {
+	rename x {}
+	unset result
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+
+test assemble-5.3 {unsupported substitution} {
+    -body {
+	proc x {} {
+	    assemble {
+		[x]
+	    }
+	}
+	list [catch {x} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+
+test assemble-5.4 {backslash substitution} {
+    -body {
+	proc x {} {
+	    assemble {
+		p\x75sh\
+		    hello\ world
+	    }
+	}
+	x
+    }
+    -cleanup {
+	rename x {}
+    }
+    -result {hello world}
+}
+
+# assemble-6 - ASSEM_PUSH
+
+test assemble-6.1 {push, wrong # args} {
+    -body {
+	assemble push
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-6.2 {push, wrong # args} {
+    -body {
+	assemble {push too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+
+test assemble-6.3 {push} {
+    -body {
+	eval [list assemble {push hello}]
+    }
+    -result hello
+}
+
+test assemble-6.4 {push4} {
+    -body {
+	proc x {} "
+            [fillTables]
+            assemble {push hello}
+        "
+        x
+    }
+    -cleanup {
+	rename x {}
+    }
+    -result hello
+}
+
+# assemble-7 - ASSEM_1BYTE
+
+test assemble-7.1 {add, wrong # args} {
+    -body {
+	assemble {add excess}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-7.2 {add} {
+    -body { 
+	assemble {
+	    push 2
+	    push 2
+	    add
+	} 
+    }
+    -result {4}
+}
+
+test assemble-7.3 {appendArrayStk} {
+    -body {
+	set a(b) {hello, }
+	assemble {
+	    push a
+	    push b
+	    push world
+	    appendArrayStk
+	}
+	set a(b)
+    }
+    -result {hello, world}
+    -cleanup {unset a}
+}
+
+test assemble-7.4 {appendStk} {
+    -body {
+	set a {hello, }
+	assemble {
+	    push a
+	    push world
+	    appendStk
+	}
+	set a
+    }
+    -result {hello, world}
+    -cleanup {unset a}
+}
+
+test assemble-7.5 {bitwise ops} {
+    -body {
+	list \
+	    [assemble {push 0b1100; push 0b1010; bitand}] \
+	    [assemble {push 0b1100; bitnot}] \
+	    [assemble {push 0b1100; push 0b1010; bitor}] \
+	    [assemble {push 0b1100; push 0b1010; bitxor}]
+    }
+    -result {8 -13 14 6}
+}
+
+test assemble-7.6 {div} {
+    -body {
+	assemble {push 999999; push 7; div} 
+    }
+    -result 142857
+}
+
+test assemble-7.7 {dup} {
+    -body {
+	assemble {
+	    push 1; dup; dup; add; dup; add; dup; add; add
+	}
+    }
+    -result 9
+}	
+
+test assemble-7.8 {eq} {
+    -body {
+	list \
+	    [assemble {push able; push baker; eq}] \
+	    [assemble {push able; push able;  eq}]
+    }
+    -result {0 1}
+}
+
+
+test assemble-7.9 {evalStk} {
+    -body {
+	assemble {
+	    push {concat test 7.3}
+	    evalStk
+	}
+    }
+    -result {test 7.3}
+}
+
+test assemble-7.9a {evalStk, syntax} {
+    -body {
+	assemble {
+	    push {{}bad}
+	    evalStk
+	}
+    }
+    -returnCodes error
+    -result {extra characters after close-brace}
+}
+
+test assemble-7.9b {evalStk, backtrace} {
+    -body {
+	proc y {z} {
+	    error testing
+	}
+	proc x {} {
+	    assemble {
+		push {
+		    # test error in evalStk
+		    y asd
+		}
+		evalStk
+	    }
+	}
+	list [catch x result] $result $errorInfo
+    }
+    -result {1 testing {testing
+    while executing
+"error testing"
+    (procedure "y" line 2)
+    invoked from within
+"y asd"*}}
+    -match glob
+    -cleanup {
+	rename y {}
+	rename x {}
+    }
+}
+
+test assemble-7.10 {existArrayStk} {
+    -body {
+	proc x {name key} {
+	    set a(b) c
+	    assemble {
+		load name; load key; existArrayStk
+	    }
+	}
+	list [x a a] [x a b] [x b a] [x b b]
+    }
+    -result {0 1 0 0}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.11 {existStk} {
+    -body {
+	proc x {name} {
+	    set a b
+	    assemble {
+		load name; existStk
+	    }
+	}
+	list [x a] [x b]
+    }
+    -result {1 0}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.12 {expon} {
+    -body {
+	assemble {push 3; push 4; expon}
+    }
+    -result 81
+}
+
+test assemble-7.13 {exprStk} {
+    -body {
+	assemble {
+	    push {acos(-1)}
+	    exprStk
+	}
+    }
+    -result 3.141592653589793
+}
+
+test assemble-7.13a {exprStk, syntax} {
+    -body {
+	assemble {
+	    push {2+}
+	    exprStk
+	}
+    }
+    -returnCodes error
+    -result {missing operand at _@_
+in expression "2+_@_"}
+}
+
+test assemble-7.13b {exprStk, backtrace} {
+    -body {
+	proc y {z} {
+	    error testing
+	}
+	proc x {} {
+	    assemble {
+		push {[y asd]}
+		exprStk
+	    }
+	}
+	list [catch x result] $result $errorInfo
+    }
+    -result {1 testing {testing
+    while executing
+"error testing"
+    (procedure "y" line 2)
+    invoked from within
+"y asd"*}}
+    -match glob
+    -cleanup {
+	rename y {}
+	rename x {}
+    }
+}
+
+test assemble-7.14 {ge gt le lt} {
+    -body {
+	proc x {a b} {
+	    list [assemble {load a; load b; ge}] \
+		[assemble {load a; load b; gt}] \
+		[assemble {load a; load b; le}] \
+		[assemble {load a; load b; lt}]
+	}
+	list [x 0 0] [x 0 1] [x 1 0]
+    }
+    -result {{1 0 1 0} {0 0 1 1} {1 1 0 0}}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.15 {incrArrayStk} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {
+		push a; push b; push 7; incrArrayStk
+	    }
+	}
+	x
+    }
+    -result 12
+    -cleanup {rename x {}}
+}
+
+test assemble-7.16 {incrStk} {
+    -body {
+	proc x {} {
+	    set a 5
+	    assemble {
+		push a; push 7; incrStk
+	    }
+	}
+	x
+    }
+    -result 12
+    -cleanup {rename x {}}
+}
+
+test assemble-7.17 {land/lor} {
+    -body {
+	proc x {a b} {
+	    list \
+		[assemble {load a; load b; land}] \
+		[assemble {load a; load b; lor}]
+	}
+	list [x 0 0] [x 0 23] [x 35 0] [x 47 59]
+    }
+    -result {{0 0} {0 1} {0 1} {1 1}}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.18 {lappendArrayStk} {
+    -body {
+	proc x {} {
+	    set able(baker) charlie
+	    assemble {
+		push able
+		push baker
+		push dog
+		lappendArrayStk
+	    }
+	}
+	x
+    }
+    -result {charlie dog}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.19 {lappendStk} {
+    -body {
+	proc x {} {
+	    set able baker
+	    assemble {
+		push able
+		push charlie
+		lappendStk
+	    }
+	}
+	x
+    }
+    -result {baker charlie}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.20 {listIndex} {
+    -body {
+	assemble {
+	    push {a b c d}
+	    push 2
+	    listIndex
+	}
+    }
+    -result c
+}
+
+test assemble-7.21 {listLength} {
+    -body {
+	assemble {
+	    push {a b c d}
+	    listLength
+	}
+    }
+    -result 4
+}
+
+test assemble-7.22 {loadArrayStk} {
+    -body {
+	proc x {} {
+	    set able(baker) charlie
+	    assemble {
+		push able
+		push baker
+		loadArrayStk
+	    }
+	}
+	x
+    }
+    -result charlie
+    -cleanup {rename x {}}
+}
+
+test assemble-7.23 {loadStk} {
+    -body {
+	proc x {} {
+	    set able baker
+	    assemble {
+		push able
+		loadStk
+	    }
+	}
+	x
+    }
+    -result baker
+    -cleanup {rename x {}}
+}
+
+test assemble-7.24 {lsetList} {
+    -body {
+	proc x {} {
+	    set l {{a b} {c d} {e f} {g h}}
+	    assemble {
+		push {2 1}; push i; load l; lsetList
+	    }
+	}
+	x
+    }
+    -result {{a b} {c d} {e i} {g h}}
+}
+
+test assemble-7.25 {lshift} {
+    -body {
+	assemble {push 16; push 4; lshift}
+    } 
+    -result 256
+}
+
+test assemble-7.26 {mod} {
+    -body {
+	assemble {push 123456; push 1000; mod}
+    }
+    -result 456
+}
+
+test assemble-7.27 {mult} {
+    -body {
+	assemble {push 12345679; push 9; mult}
+    }
+    -result 111111111
+}
+
+test assemble-7.28 {neq} {
+    -body {
+	list \
+	    [assemble {push able; push baker; neq}] \
+	    [assemble {push able; push able;  neq}]
+    }
+    -result {1 0}
+}
+
+test assemble-7.29 {not} {
+    -body {
+	list \
+	    [assemble {push 17; not}] \
+	    [assemble {push 0; not}]
+    }
+    -result {0 1}
+}
+
+test assemble-7.30 {pop} {
+    -body {
+	assemble {push this; pop; push that}
+    }
+    -result that
+}
+
+test assemble-7.31 {rshift} {
+    -body {
+	assemble {push 257; push 4; rshift}
+    } 
+    -result 16
+}
+
+test assemble-7.32 {storeArrayStk} {
+    -body {
+	proc x {} {
+	    assemble {
+		push able; push baker; push charlie; storeArrayStk
+	    }
+	    array get able
+	}
+	x
+    }
+    -result {baker charlie}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.33 {storeStk} {
+    -body {
+	proc x {} {
+	    assemble {
+		push able; push baker; storeStk
+	    }
+	    set able
+	}
+	x
+    }
+    -result {baker}
+    -cleanup {rename x {}}
+}
+
+test assemble-7,34 {strcmp} {
+    -body {
+	proc x {a b} {
+	    assemble {
+		load a; load b; strcmp
+	    }
+	}
+	list [x able baker] [x baker able] [x baker baker]
+    }
+    -result {-1 1 0}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.35 {streq/strneq} {
+    -body {
+	proc x {a b} {
+	    list \
+		[assemble {load a; load b; streq}] \
+		[assemble {load a; load b; strneq}]
+	}
+	list [x able able] [x able baker]
+    }
+    -result {{1 0} {0 1}}
+    -cleanup {rename x {}}
+}
+
+test assemble-7.36 {strindex} {
+    -body {
+	assemble {push testing; push 4; strindex}
+    }
+    -result i
+}
+
+test assemble-7.37 {strlen} {
+    -body {
+	assemble {push testing; strlen}
+    }
+    -result 7
+}
+
+test assemble-7.38 {sub} {
+    -body {
+	assemble {push 42; push 17; sub}
+    }
+    -result 25
+}
+
+test assemble-7.39 {tryCvtToNumeric} {
+    -body {
+	assemble {
+	    push 42; tryCvtToNumeric
+	}
+    }
+    -result 42
+}
+
+test assemble-7.41 {uminus} {
+    -body {
+	assemble {
+	    push 42; uminus
+	}
+    }
+    -result -42
+}
+
+test assemble-7.42 {uplus} {
+    -body {
+	assemble {
+	    push 42; uplus
+	}
+    }
+    -result 42
+}
+test assemble-7.43 {uplus} {
+    -body {
+	assemble {
+	    push NaN; uplus
+	}
+    }
+    -returnCodes error
+    -result {can't use non-numeric floating-point value as operand of "+"}
+}
+
+test assemble-7.43 {tryCvtToNumeric} {
+    -body {
+	assemble {
+	    push NaN; tryCvtToNumeric
+	}
+    }
+    -returnCodes error
+    -result {domain error: argument not in valid range}
+}
+
+test assemble-7.44 {listIn} {
+    -body {
+	assemble {
+	    push b; push {a b c}; listIn
+	}
+    }
+    -result 1
+}
+
+test assemble-7.45 {listNotIn} {
+    -body {
+	assemble {
+	    push d; push {a b c}; listNotIn
+	}
+    }
+    -result 1
+}
+
+test assemble-7.46 {nop} {
+    -body {
+	assemble { push x; nop; nop; nop}
+    }
+    -result x
+}
+
+# assemble-8 ASSEM_LVT and FindLocalVar
+
+test assemble-8.1 {load, wrong # args} {
+    -body {
+	assemble load
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-8.2 {load, wrong # args} {
+    -body {
+	assemble {load too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-8.3 {nonlocal var} {
+    -body {
+	list [catch {assemble {load ::env}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+
+test assemble-8.4 {bad context} {
+    -body {
+	set x 1
+	list [catch {assemble {load x}} result] $result $errorCode
+    }
+    -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
+    -cleanup {unset result}
+}
+
+test assemble-8.5 {bad context} {
+    -body {
+	namespace eval assem {
+	    set x 1
+	    list [catch {assemble {load x}} result] $result $errorCode
+	}
+    }
+    -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
+    -cleanup {namespace delete assem}
+}
+
+test assemble-8.6 {load1} {
+    -body {
+	proc x {a} {
+	    assemble {
+		load a
+	    }
+	}
+	x able
+    }
+    -result able
+    -cleanup {rename x {}}
+}
+
+test assemble-8.7 {load4} {
+    -body {
+	proc x {a} "
+	    [fillTables]
+            set b \$a
+            assemble {load b}
+        "
+	x able
+    }
+    -result able
+    -cleanup {rename x {}}
+}
+
+test assemble-8.8 {loadArray1} {
+    -body {
+	proc x {} {
+	    set able(baker) charlie
+	    assemble {
+		push baker
+		loadArray able
+	    }
+	}
+	x
+    }
+    -result charlie
+    -cleanup {rename x {}}
+}
+
+test assemble-8.9 {loadArray4} {
+    -body "
+	proc x {} {
+            [fillTables]
+	    set able(baker) charlie
+	    assemble {
+		push baker
+		loadArray able
+	    }
+	}
+	x
+    "
+    -result charlie
+    -cleanup {rename x {}}
+}
+
+test assemble-8.10 {append1} {
+    -body {
+	proc x {} {
+	    set y {hello, }
+	    assemble {
+		push world; append y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.11 {append4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y {hello, }
+	    assemble {
+		push world; append y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.12 {appendArray1} {
+    -body {
+	proc x {} {
+	    set y(z) {hello, }
+	    assemble {
+		push z; push world; appendArray y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.13 {appendArray4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y(z) {hello, }
+	    assemble {
+		push z; push world; appendArray y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.14 {lappend1} {
+    -body {
+	proc x {} {
+	    set y {hello,}
+	    assemble {
+		push world; lappend y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.15 {lappend4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y {hello,}
+	    assemble {
+		push world; lappend y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.16 {lappendArray1} {
+    -body {
+	proc x {} {
+	    set y(z) {hello,}
+	    assemble {
+		push z; push world; lappendArray y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.17 {lappendArray4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y(z) {hello,}
+	    assemble {
+		push z; push world; lappendArray y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.18 {store1} {
+    -body {
+	proc x {} {
+	    assemble {
+		push test; store y
+	    }
+	    set y
+	}
+	x
+    }
+    -result {test}
+    -cleanup {rename x {}}
+}
+
+test assemble-8.19 {store4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    assemble {
+		push test; store y
+	    }
+            set y
+	"
+	x
+    }
+    -result test
+    -cleanup {rename x {}}
+}
+
+test assemble-8.20 {storeArray1} {
+    -body {
+	proc x {} {
+	    assemble {
+		push z; push test; storeArray y
+	    }
+	    set y(z)
+	}
+	x
+    }
+    -result test
+    -cleanup {rename x {}}
+}
+
+test assemble-8.21 {storeArray4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    assemble {
+		push z; push test; storeArray y
+	    }
+	"
+	x
+    }
+    -result test
+    -cleanup {rename x {}}
+}
+
+# assemble-9 - ASSEM_CONCAT1, GetIntegerOperand, CheckOneByte
+
+test assemble-9.1 {wrong # args} {
+    -body {assemble concat}
+    -result {wrong # args*}
+    -match glob
+    -returnCodes error
+}
+
+test assemble-9.2 {wrong # args} {
+    -body {assemble {concat too many}}
+    -result {wrong # args*}
+    -match glob
+    -returnCodes error
+}
+
+test assemble-9.3 {not a number} {
+    -body {assemble {concat rubbish}}
+    -result {expected integer but got "rubbish"}
+    -returnCodes error
+}
+test assemble-9.4 {too small} {
+    -body {assemble {concat -1}}
+    -result {operand does not fit in one byte}
+    -returnCodes error
+}
+test assemble-9.5 {too small} {
+    -body {assemble {concat 256}}
+    -result {operand does not fit in one byte}
+    -returnCodes error
+}
+test assemble-9.6 {concat} {
+    -body {
+	assemble {push h; push e; push l; push l; push o; concat 5}
+    }
+    -result hello
+}
+test assemble-9.7 {concat} {
+    -body {
+	list [catch {assemble {concat 0}} result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {unset result}
+}
+
+# assemble-10 -- eval and expr
+
+test assemble-10.1 {eval - wrong # args} {
+    -body {
+	assemble {eval}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-10.2 {eval - wrong # args} {
+    -body {
+	assemble {eval too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-10.3 {eval} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 3
+		store n
+		pop
+		eval {expr {3*$n + 1}}
+		push 1
+		add
+	    }
+	}
+	x
+    }
+    -result 11
+    -cleanup {rename x {}}
+}
+
+test assemble-10.4 {expr} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 3
+		store n
+		pop
+		expr {3*$n + 1}
+		push 1
+		add
+	    }
+	}
+	x
+    }
+    -result 11
+    -cleanup {rename x {}}
+}
+
+test assemble-10.5 {eval and expr - nonsimple} {
+    -body {
+	proc x {} {
+	    assemble {
+		eval "s\x65t n 3"
+		pop
+		expr "\x33*\$n + 1"
+		push 1
+		add
+	    }
+	}
+	x
+    }
+    -result 11
+    -cleanup {
+	rename x {}
+    }
+}
+
+test assemble-10.6 {eval - noncompilable} {
+    -body {
+	list [catch {assemble {eval $x}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+
+test assemble-10.7 {expr - noncompilable} {
+    -body {
+	list [catch {assemble {expr $x}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+
+# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
+#			    nsupvar, variable, upvar)
+		
+test assemble-11.1 {exist - wrong # args} {
+    -body {
+	assemble {exist}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-11.2 {exist - wrong # args} {
+    -body {
+	assemble {exist too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-11.3 {nonlocal var} {
+    -body {
+	list [catch {assemble {exist ::env}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+
+test assemble-11.4 {exist} {
+    -body {
+	proc x {} {
+	    set y z
+	    list [assemble {exist y}] \
+		[assemble {exist z}]
+	}
+	x
+    }
+    -result {1 0}
+    -cleanup {rename x {}}
+}
+
+test assemble-11.5 {existArray} {
+    -body {
+	proc x {} {
+	    set a(b) c
+	    list [assemble {push b; existArray a}] \
+		[assemble {push c; existArray a}] \
+		[assemble {push a; existArray b}]
+	}
+	x
+    }
+    -result {1 0 0}
+    -cleanup {rename x {}}
+}
+
+test assemble-11.6 {dictAppend} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; push 22; dictAppend dict}
+	}
+	x
+    }
+    -result {a 1 b 222 c 3}
+    -cleanup {rename x {}}
+}
+
+test assemble-11.7 {dictLappend} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; push 2; dictLappend dict}
+	}
+	x
+    }
+    -result {a 1 b {2 2} c 3}
+    -cleanup {rename x {}}
+}
+
+test assemble-11.8 {upvar} {
+    -body {
+	proc x {v} {
+	    assemble {push 1; load v; upvar w; pop; load w}
+	}
+	proc y {} {
+	    set z 123
+	    x z
+	}
+	y
+    }
+    -result 123
+    -cleanup {rename x {}; rename y {}}
+}
+
+test assemble-11.9 {nsupvar} {
+    -body {
+	namespace eval q { variable v 123 }
+	proc x {} {
+	    assemble {push q; push v; nsupvar y; pop; load y}
+	}
+	x
+    }
+    -result 123
+    -cleanup {namespace delete q; rename x {}}
+}
+
+test assemble-11.10 {variable} {
+    -body {
+	namespace eval q { namespace eval r {variable v 123}}
+	proc x {} {
+	    assemble {push q::r::v; variable y; load y}
+	}
+	x
+    }
+    -result 123
+    -cleanup {namespace delete q; rename x {}}
+}
+
+# assemble-12 - ASSEM_LVT1 (incr and incrArray)
+		
+test assemble-12.1 {incr - wrong # args} {
+    -body {
+	assemble {incr}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-12.2 {incr - wrong # args} {
+    -body {
+	assemble {incr too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-12.3 {incr nonlocal var} {
+    -body {
+	list [catch {assemble {incr ::env}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+
+test assemble-12.4 {incr} {
+    -body {
+	proc x {} {
+	    set y 5
+	    assemble {push 3; incr y}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+
+test assemble-12.5 {incrArray} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {push b; push 3; incrArray a}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+
+test assemble-12.6 {incr, stupid stack restriction} {
+    -body {
+	proc x {} "
+	    [fillTables]
+            set y 5
+            assemble {push 3; incr y}
+        "
+	list [catch {x} result] $result $errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {unset result; rename x {}}
+}
+
+# assemble-13 -- ASSEM_LVT1_SINT1 - incrImm and incrArrayImm
+
+test assemble-13.1 {incrImm - wrong # args} {
+    -body {
+	assemble {incrImm x}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-13.2 {incrImm - wrong # args} {
+    -body {
+	assemble {incrImm too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-13.3 {incrImm nonlocal var} {
+    -body {
+	list [catch {assemble {incrImm ::env 2}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+
+test assemble-13.4 {incrImm not a number} {
+    -body {
+	proc x {} {
+	    assemble {incrImm x rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-13.5 {incrImm too big} {
+    -body {
+	proc x {} {
+	    assemble {incrImm x 0x80}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+    
+test assemble-13.6 {incrImm too small} {
+    -body {
+	proc x {} {
+	    assemble {incrImm x -0x81}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-13.7 {incrImm} {
+    -body {
+	proc x {} {
+	    set y 1
+	    list [assemble {incrImm y -0x80}] [assemble {incrImm y 0x7f}]
+	}
+	x
+    }
+    -result {-127 0}
+    -cleanup {rename x {}}
+}
+
+test assemble-13.8 {incrArrayImm} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {push b; incrArrayImm a 3}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+
+test assemble-13.9 {incrImm, stupid stack restriction} {
+    -body {
+	proc x {} "
+	    [fillTables]
+            set y 5
+            assemble {incrImm y 3}
+        "
+	list [catch {x} result] $result $errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {unset result; rename x {}}
+}
+
+# assemble-14 -- ASSEM_SINT1 (incrArrayStkImm and incrStkImm)
+
+test assemble-14.1 {incrStkImm - wrong # args} {
+    -body {
+	assemble {incrStkImm}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-14.2 {incrStkImm - wrong # args} {
+    -body {
+	assemble {incrStkImm too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-14.3 {incrStkImm not a number} {
+    -body {
+	proc x {} {
+	    assemble {incrStkImm rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-14.4 {incrStkImm too big} {
+    -body {
+	proc x {} {
+	    assemble {incrStkImm 0x80}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+    
+test assemble-14.5 {incrStkImm too small} {
+    -body {
+	proc x {} {
+	    assemble {incrStkImm -0x81}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-14.6 {incrStkImm} {
+    -body {
+	proc x {} {
+	    set y 1
+	    list [assemble {push y; incrStkImm -0x80}] \
+		[assemble {push y; incrStkImm 0x7f}]
+	}
+	x
+    }
+    -result {-127 0}
+    -cleanup {rename x {}}
+}
+
+test assemble-14.7 {incrArrayStkImm} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {push a; push b; incrArrayStkImm 3}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+
+# assemble-15 - listIndexImm
+
+test assemble-15.1 {listIndexImm - wrong # args} {
+    -body {
+	assemble {listIndexImm}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-16.2 {listIndexImm - wrong # args} {
+    -body {
+	assemble {listIndexImm too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-16.3 {listIndexImm - bad substitution} {
+    -body {
+	list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+    -cleanup {unset result}
+}
+
+test assemble-16.4 {listIndexImm - invalid index} {
+    -body {
+	assemble {listIndexImm rubbish}
+    }
+    -returnCodes error
+    -match glob
+    -result {bad index "rubbish"*}
+}
+
+test assemble-16.5 {listIndexImm} {
+    -body {
+	assemble {push {a b c}; listIndexImm 2}
+    }
+    -result c
+}
+
+test assemble-16.6 {listIndexImm} {
+    -body {
+	assemble {push {a b c}; listIndexImm end-1}
+    }
+    -result b
+}
+
+test assemble-16.6 {listIndexImm} {
+    -body {
+	assemble {push {a b c}; listIndexImm end}
+    }
+    -result c
+}
+
+# assemble-16 - invokeStk
+
+test assemble-16.1 {invokeStk - wrong # args} {
+    -body {
+	assemble {invokeStk}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-16.2 {invokeStk - wrong # args} {
+    -body {
+	assemble {invokeStk too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-16.3 {invokeStk - not a number} {
+    -body {
+	proc x {} {
+	    assemble {invokeStk rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-16.4 {invokeStk - no operands} {
+    -body {
+	proc x {} {
+	    assemble {invokeStk 0}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-16.5 {invokeStk1} {
+    -body {
+	tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3}
+    }
+    -result {1 2}
+}
+
+test assemble-16.6 {invokeStk4} {
+    -body {
+	proc x {n} {
+	    set code {push concat}
+	    set shouldbe {}
+	    for {set i 1} {$i < $n} {incr i} {
+		append code \n {push a} $i
+		lappend shouldbe a$i
+	    }
+	    append code \n {invokeStk} { } $n
+	    set is [assemble $code]
+	    expr {$is eq $shouldbe}
+	}
+	list [x 254] [x 255] [x 256] [x 257]
+    }
+    -result {1 1 1 1}
+    -cleanup {rename x {}}
+}
+
+# assemble-17 -- jumps and labels
+
+test assemble-17.1 {label, wrong # args} {
+    -body {
+	assemble {label}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-17.2 {label, wrong # args} {
+    -body {
+	assemble {label too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-17.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-17.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-17.5 {jump, wrong # args} {
+    -body {
+	assemble {jump}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-17.6 {jump, wrong # args} {
+    -body {
+	assemble {jump too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-17.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-17.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-17.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-17.10 {jump4 needed} {
+    -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-17.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-17.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-17.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-17.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-17.15 {multiple passes of code resizing} {
+    -setup {
+	set body {
+	    push -
+	}
+	for {set i 0} {$i < 14} {incr i} {
+	    append body "label a" $i \
+		"; push a; concat 2; nop; nop; jump b" \
+		$i \n
+	}
+	append body {label a14; push a; concat 2; push 1; jumpTrue b14} \n
+	append body {label a15; push a; concat 2; push 0; jumpFalse b15} \n
+	for {set i 0} {$i < 15} {incr i} {
+	    append body "label b" $i \
+		"; push b; concat 2; nop; nop; jump a" \
+		[expr {$i+1}] \n
+	}
+	append body {label c; push -; concat 2; nop; nop; nop; jump d} \n
+	append body {label b15; push b; concat 2; nop; nop; jump c} \n
+	append body {label d}
+	proc x {} [list assemble $body]
+    }	
+    -body {
+	x
+    }
+    -cleanup {
+	catch {unset body}
+	catch {rename x {}}
+    }
+    -result -abababababababababababababababab-
+}
+
+# assemble-18 - lindexMulti
+
+test assemble-18.1 {lindexMulti - wrong # args} {
+    -body {
+	assemble {lindexMulti}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-18.2 {lindexMulti - wrong # args} {
+    -body {
+	assemble {lindexMulti too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-18.3 {lindexMulti - bad subst} {
+    -body {
+	assemble {lindexMulti $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-18.4 {lindexMulti - not a number} {
+    -body {
+	proc x {} {
+	    assemble {lindexMulti rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-18.5 {lindexMulti - bad operand count} {
+    -body {
+	proc x {} {
+	    assemble {lindexMulti 0}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-18.6 {lindexMulti} {
+    -body {
+	assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1}
+    }
+    -result {{a b c} {d e f} {g h j}}
+}
+
+test assemble-18.7 {lindexMulti} {
+    -body {
+	assemble {push {{a b c} {d e f} {g h j}}; push 1; lindexMulti 2}
+    }
+    -result {d e f}
+}
+
+test assemble-18.8 {lindexMulti} {
+    -body {
+	assemble {push {{a b c} {d e f} {g h j}}; push 2; push 1; lindexMulti 3}
+    }
+    -result h
+}
+
+# assemble-19 - list
+
+test assemble-19.1 {list - wrong # args} {
+    -body {
+	assemble {list}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-19.2 {list - wrong # args} {
+    -body {
+	assemble {list too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-19.3 {list - bad subst} {
+    -body {
+	assemble {list $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-19.4 {list - not a number} {
+    -body {
+	proc x {} {
+	    assemble {list rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-19.5 {list - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {list -1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-19.6 {list - no args} {
+    -body {
+	assemble {list 0}
+    }
+    -result {}
+}
+
+test assemble-19.7 {list - 1 arg} {
+    -body {
+	assemble {push hello; list 1}
+    }
+    -result hello
+}
+
+test assemble-19.8 {list - 2 args} {
+    -body {
+	assemble {push hello; push world; list 2}
+    }
+    -result {hello world}
+}
+
+# assemble-20 - lsetFlat
+
+test assemble-20.1 {lsetFlat - wrong # args} {
+    -body {
+	assemble {lsetFlat}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-20.2 {lsetFlat - wrong # args} {
+    -body {
+	assemble {lsetFlat too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-20.3 {lsetFlat - bad subst} {
+    -body {
+	assemble {lsetFlat $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-20.4 {lsetFlat - not a number} {
+    -body {
+	proc x {} {
+	    assemble {lsetFlat rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-20.5 {lsetFlat - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {lsetFlat 1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-20.6 {lsetFlat} {
+    -body {
+	assemble {push b; push a; lsetFlat 2}
+    } 
+    -result b
+}
+
+test assemble-20.7 {lsetFlat} {
+    -body {
+	assemble {push 1; push d; push {a b c}; lsetFlat 3}
+    }
+    -result {a d c}
+}
+
+# assemble-21 - over
+
+test assemble-21.1 {over - wrong # args} {
+    -body {
+	assemble {over}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-21.2 {over - wrong # args} {
+    -body {
+	assemble {over too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-21.3 {over - bad subst} {
+    -body {
+	assemble {over $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-21.4 {over - not a number} {
+    -body {
+	proc x {} {
+	    assemble {over rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-21.5 {over - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {over -1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-21.6 {over} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		over 0
+		store x
+		pop
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 3
+    -cleanup {rename x {}}
+}
+
+test assemble-21.7 {over} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		over 2
+		store x
+		pop
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+
+# assemble-22 - reverse
+
+test assemble-22.1 {reverse - wrong # args} {
+    -body {
+	assemble {reverse}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-22.2 {reverse - wrong # args} {
+    -body {
+	assemble {reverse too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-22.3 {reverse - bad subst} {
+    -body {
+	assemble {reverse $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-22.4 {reverse - not a number} {
+    -body {
+	proc x {} {
+	    assemble {reverse rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-22.5 {reverse - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {reverse -1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-22.6 {reverse - zero operand count} {
+    -body {
+	proc x {} {
+	    assemble {push 1; reverse 0}
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+
+test assemble-22.7 {reverse} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		reverse 1
+		store x
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 3
+    -cleanup {rename x {}}
+}
+
+test assemble-22.8 {reverse} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		reverse 3
+		store x
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+
+# assemble-23 - ASSEM_BOOL (strmatch, unsetStk, unsetArrayStk)
+
+test assemble-23.1 {strmatch - wrong # args} {
+    -body {
+	assemble {strmatch}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-23.2 {strmatch - wrong # args} {
+    -body {
+	assemble {strmatch too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-23.3 {strmatch - bad subst} {
+    -body {
+	assemble {strmatch $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-23.4 {strmatch - not a boolean} {
+    -body {
+	proc x {} {
+	    assemble {strmatch rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected boolean value but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-23.5 {strmatch} {
+    -body {
+	proc x {a b} {
+	    list [assemble {load a; load b; strmatch 0}] \
+		[assemble {load a; load b; strmatch 1}]
+	}
+	list [x foo*.grill fengbar.grill] [x foo*.grill foobar.grill] [x foo*.grill FOOBAR.GRILL]
+    }
+    -result {{0 0} {1 1} {0 1}}
+    -cleanup {rename x {}}
+}
+
+test assemble-23.6 {unsetStk} {
+    -body {
+	proc x {} {
+	    set a {}
+	    assemble {push a; unsetStk false}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+
+test assemble-23.7 {unsetStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; unsetStk false}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-23.8 {unsetStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; unsetStk true}
+	    info exists a
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a": no such variable}
+    -cleanup {rename x {}}
+}
+
+test assemble-23.9 {unsetArrayStk} {
+    -body {
+	proc x {} {
+	    set a(b) {}
+	    assemble {push a; push b; unsetArrayStk false}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+
+test assemble-23.10 {unsetArrayStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; push b; unsetArrayStk false}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-23.11 {unsetArrayStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; push b; unsetArrayStk true}
+	    info exists a(b)
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a(b)": no such variable}
+    -cleanup {rename x {}}
+}
+
+# assemble-24 -- ASSEM_BOOL_LVT4 (unset; unsetArray)
+
+test assemble-24.1 {unset - wrong # args} {
+    -body {
+	assemble {unset one}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-24.2 {unset - wrong # args} {
+    -body {
+	assemble {unset too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-24.3 {unset - bad subst -arg 1} {
+    -body {
+	assemble {unset $foo bar}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-24.4 {unset - not a boolean} {
+    -body {
+	proc x {} {
+	    assemble {unset rubbish trash}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected boolean value but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-24.5 {unset - bad subst - arg 2} {
+    -body {
+	assemble {unset true $bar}
+    }
+    -returnCodes error
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-24.6 {unset - nonlocal var} {
+    -body {
+	assemble {unset true ::foo::bar}
+    }
+    -returnCodes error
+    -result {variable "::foo::bar" is not local}
+}
+
+test assemble-24.7 {unset} {
+    -body {
+	proc x {} {
+	    set a {}
+	    assemble {unset false a}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+
+test assemble-24.8 {unset} {
+    -body {
+	proc x {} {
+	    assemble {unset false a}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-24.9 {unset} {
+    -body {
+	proc x {} {
+	    assemble {unset true a}
+	    info exists a
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a": no such variable}
+    -cleanup {rename x {}}
+}
+
+test assemble-24.10 {unsetArray} {
+    -body {
+	proc x {} {
+	    set a(b) {}
+	    assemble {push b; unsetArray false a}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+
+test assemble-24.11 {unsetArray} {
+    -body {
+	proc x {} {
+	    assemble {push b; unsetArray false a}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+
+test assemble-24.12 {unsetArray} {
+    -body {
+	proc x {} {
+	    assemble {push b; unsetArray true a}
+	    info exists a(b)
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a(b)": no such variable}
+    -cleanup {rename x {}}
+}
+
+# assemble-25 - dict get
+
+test assemble-25.1 {dict get - wrong # args} {
+    -body {
+	assemble {dictGet}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-25.2 {dict get - wrong # args} {
+    -body {
+	assemble {dictGet too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-25.3 {dictGet - bad subst} {
+    -body {
+	assemble {dictGet $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-25.4 {dict get - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictGet rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-25.5 {dictGet - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {dictGet 0}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-25.6 {dictGet - 1 index} {
+    -body {
+	assemble {push {a 1 b 2}; push a; dictGet 1}
+    }
+    -result 1
+}
+
+# assemble-26 - dict set
+
+test assemble-26.1 {dict set - wrong # args} {
+    -body {
+	assemble {dictSet 1}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-26.2 {dict get - wrong # args} {
+    -body {
+	assemble {dictSet too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-26.3 {dictSet - bad subst} {
+    -body {
+	assemble {dictSet 1 $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-26.4 {dictSet - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictSet rubbish foo}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-26.5 {dictSet - zero operand count} {
+    -body {
+	proc x {} {
+	    assemble {dictSet 0 foo}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-26.6 {dictSet - bad local} {
+    -body {
+	proc x {} {
+	    assemble {dictSet 1 ::foo::bar}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-26.7 {dictSet} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; push 4; dictSet 1 dict}
+	}
+	x
+    }
+    -result {a 1 b 4 c 3}
+    -cleanup {rename x {}}
+}
+
+# assemble-27 - dictUnset
+
+test assemble-27.1 {dictUnset - wrong # args} {
+    -body {
+	assemble {dictUnset 1}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-27.2 {dictUnset - wrong # args} {
+    -body {
+	assemble {dictUnset too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-27.3 {dictUnset - bad subst} {
+    -body {
+	assemble {dictUnset 1 $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-27.4 {dictUnset - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictUnset rubbish foo}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-27.5 {dictUnset - zero operand count} {
+    -body {
+	proc x {} {
+	    assemble {dictUnset 0 foo}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-27.6 {dictUnset - bad local} {
+    -body {
+	proc x {} {
+	    assemble {dictUnset 1 ::foo::bar}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-27.7 {dictUnset} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; dictUnset 1 dict}
+	}
+	x
+    }
+    -result {a 1 c 3}
+    -cleanup {rename x {}}
+}
+
+# assemble-28 - dictIncrImm
+
+test assemble-28.1 {dictIncrImm - wrong # args} {
+    -body {
+	assemble {dictIncrImm 1}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-28.2 {dictIncrImm - wrong # args} {
+    -body {
+	assemble {dictIncrImm too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-28.3 {dictIncrImm - bad subst} {
+    -body {
+	assemble {dictIncrImm 1 $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-28.4 {dictIncrImm - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictIncrImm rubbish foo}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-28.5 {dictIncrImm - bad local} {
+    -body {
+	proc x {} {
+	    assemble {dictIncrImm 1 ::foo::bar}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+    -cleanup {rename x {}; unset result}
+}
+
+test assemble-28.6 {dictIncrImm} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; dictIncrImm 42 dict}
+	}
+	x
+    }
+    -result {a 1 b 44 c 3}
+    -cleanup {rename x {}}
+}
+
+# assemble-29 - ASSEM_REGEXP
+
+test assemble-29.1 {regexp - wrong # args} {
+    -body {
+	assemble {regexp}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-29.2 {regexp - wrong # args} {
+    -body {
+	assemble {regexp too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-29.3 {regexp - bad subst} {
+    -body {
+	assemble {regexp $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-29.4 {regexp - not a boolean} {
+    -body {
+	proc x {} {
+	    assemble {regexp rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected boolean value but got "rubbish"}
+    -cleanup {rename x {}}
+}
+
+test assemble-29.5 {regexp} {
+    -body {
+	assemble {push br.*br; push abracadabra; regexp false}
+    }
+    -result 1
+}
+
+test assemble-29.6 {regexp} {
+    -body {
+	assemble {push br.*br; push aBRacadabra; regexp false}
+    }
+    -result 0
+}
+
+test assemble-29.7 {regexp} {
+    -body {
+	assemble {push br.*br; push aBRacadabra; regexp true}
+    }
+    -result 1
+}
+
+# assemble-30 - Catches
+
+test assemble-30.1 {simplest possible catch} {
+    -body {
+	proc x {} {
+	    assemble {
+		beginCatch @bad
+		push error
+		push testing
+		invokeStk 2
+		pop
+		push 0
+		jump @ok
+		label @bad
+		push 1; # should be pushReturnCode
+		label @ok
+		endCatch
+	    }
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+	    
+test assemble-30.2 {catch in external catch conntext} {
+    -body {
+	proc x {} {
+	    list [catch {
+		assemble {
+		    beginCatch @bad
+		    push error
+		    push testing
+		    invokeStk 2
+		    pop
+		    push 0
+		    jump @ok
+		    label @bad
+		    pushReturnCode
+		    label @ok
+		    endCatch
+		}
+	    } result] $result
+	}
+	x
+    }
+    -result {0 1}
+    -cleanup {rename x {}}
+}
+
+test assemble-30.3 {embedded catches} {
+    -body {
+	proc x {} {
+	    list [catch {
+		assemble {
+		    beginCatch @bad
+		    push error
+		    eval { list [catch {error whatever} result] $result }
+		    invokeStk 2
+		    push 0
+		    reverse 2
+		    jump @done
+		    label @bad
+		    pushReturnCode
+		    pushResult
+		    label @done
+		    endCatch
+		    list 2
+		}
+	    } result2] $result2
+	}
+	x
+    }
+    -result {0 {1 {1 whatever}}}
+    -cleanup {rename x {}}
+}
+
+test assemble-30.4 {throw in wrong context} {
+    -body {
+	proc x {} {
+	    list [catch {
+		assemble {
+		    beginCatch @bad
+		    push error
+		    eval { list [catch {error whatever} result] $result }
+		    invokeStk 2
+		    push 0
+		    reverse 2
+		    jump @done
+
+		    label @bad
+		    load x
+		    pushResult
+
+		    label @done
+		    endCatch
+		    list 2
+		}
+	    } result] $result $::errorCode [split $::errorInfo \n]
+	}
+	x
+    }
+    -match glob
+    -result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {    in assembly code between lines 10 and 15}*}}
+    -cleanup {rename x {}}
+}
+    
+test assemble-30.5 {unclosed catch} {
+    -body {
+	proc x {} {
+	    assemble {
+		beginCatch @error
+		push 0
+		jump @done
+		label @error
+		push 1
+		label @done
+		push ""
+		pop
+	    }
+	}
+	list [catch {x} result] $result $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {catch still active on exit from assembly code} {TCL ASSEM UNCLOSEDCATCH} {catch still active on exit from assembly code
+    ("assemble" body, line 2)*}}
+    -cleanup {rename x {}}
+}
+
+test assemble-30.6 {inconsistent catch contexts} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpTrue @inblock
+		beginCatch @error
+		label @inblock
+		push 0
+		jump @done
+		label @error
+		push 1
+		label @done
+	    }
+	}
+	list [catch {x 2} result] $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {TCL ASSEM BADCATCH} {execution reaches an instruction in inconsistent exception contexts
+    ("assemble" body, line 5)*}}
+    -cleanup {rename x {}}
+}
+
+# assemble-31 - Jump tables
+
+test assemble-31.1 {jumpTable, wrong # args} {
+    -body {
+	assemble {jumpTable}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-31.2 {jumpTable, wrong # args} {
+    -body {
+	assemble {jumpTable too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-31.3 {jumpTable - bad subst} {
+    -body {
+	assemble {jumpTable $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-31.4 {jumptable - not a list} {
+    -body {
+	assemble {jumpTable \{rubbish}
+    }
+    -returnCodes error
+    -result {unmatched open brace in list}
+}
+test assemble-31.5 {jumpTable, badly structured} {
+    -body {
+	list [catch {assemble {
+	    # line 2
+	    jumpTable {one two three};# line 3
+	}} result] \
+	    $result $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {jump table must have an even number of list elements} {TCL ASSEM BADJUMPTABLE} {jump table must have an even number of list elements*("assemble" body, line 3)*}}
+}
+test assemble-31.6 {jumpTable, missing symbol} {
+    -body {
+	list [catch {assemble {
+	    # line 2
+	    jumpTable {1 a};# line 3
+	}} result] \
+	    $result $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}}
+}
+
+test assemble-31.7 {jumptable, actual example} {
+    -setup {
+	proc x {} {
+	    set result {}
+	    for {set i 0} {$i < 5} {incr i} {
+		lappend result [assemble {
+		    load i
+		    jumpTable {1 @one 2 @two 3 @three}
+		    push {none of the above}
+		    jump @done
+		    label @one
+		    push one
+		    jump @done
+		    label @two
+		    push two
+		    jump @done
+		    label @three
+		    push three
+		    label @done
+		}]
+	    }
+	    set tcl_traceCompile 2
+	    set result
+	}
+    }
+    -body x
+    -result {{none of the above} one two three {none of the above}}
+    -cleanup {set tcl_traceCompile 0; rename x {}}
+}
+
+test assemble-40.1 {unbalanced stack} {
+    -body {
+	list \
+	    [catch {
+		assemble {
+		    push 3
+		    dup 
+		    mult 
+		    push 4
+		    dup 
+		    mult 
+		    pop 
+		    expon
+		}
+	    } result] $result $::errorInfo
+    }
+    -result {1 {stack underflow} {stack underflow
+    in assembly code between lines 1 and end of assembly code*}}
+    -match glob
+   -returnCodes ok
+}
+
+test assemble-40.2 {unbalanced stack} {*}{
+    -body {
+	list \
+	    [catch {
+		assemble {
+		    label a
+		    push {}
+		    label b
+		    pop
+		    label c
+		    pop
+		    label d
+		    push {}
+		}
+	    } result] $result $::errorInfo
+    }
+    -result {1 {stack underflow} {stack underflow
+    in assembly code between lines 7 and 9*}}
+    -match glob
+   -returnCodes ok
+}
+
+test assemble-41.1 {Inconsistent stack usage} {*}{
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpFalse else
+		push 0
+		jump then
+	      label else
+		push 1
+		push 2
+	      label then
+		pop
+	    }
+	}
+	catch {x 1}
+	set errorInfo
+    }
+    -match glob
+    -result {inconsistent stack depths on two execution paths
+    ("assemble" body, line 10)*}
+}
+
+test assemble-41.2 {Inconsistent stack, jumptable and default} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpTable {0 else}
+		push 0
+	      label else
+		pop
+	    }
+	}
+	catch {x 1}
+	set errorInfo
+    }
+    -match glob
+    -result {inconsistent stack depths on two execution paths
+    ("assemble" body, line 6)*}
+}
+
+test assemble-41.3 {Inconsistent stack, two legs of jumptable} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpTable {0 no 1 yes}
+		label no
+		push 0
+		label yes
+		pop
+	    }
+	}
+	catch {x 1}
+	set errorInfo
+    }
+    -match glob
+    -result {inconsistent stack depths on two execution paths
+    ("assemble" body, line 7)*}
+}
+
+test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
+    -body {
+	proc ulam {n} {
+	    assemble {
+		load n;		# max
+		dup;		# max n
+		jump start;     # max n
+	    
+		label loop;	# max n
+		over 1;         # max n max
+		over 1;		# max in max n
+		ge;             # man n max>=n
+		jumpTrue skip;  # max n
+
+		reverse 2;      # n max
+		pop;            # n
+		dup;            # n n
+	    
+		label skip;	# max n
+		dup;            # max n n
+		push 2;         # max n n 2
+		mod;            # max n n%2
+		jumpTrue odd;   # max n
+	    
+		push 2;         # max n 2
+		div;            # max n/2 -> max n
+		jump start;     # max n
+	     
+		label odd;	# max n
+		push 3;         # max n 3
+		mult;           # max 3*n
+		push 1;         # max 3*n 1
+		add;            # max 3*n+1
+	    
+		label start;	# max n
+		dup;		# max n n
+		push 1;		# max n n 1
+		neq;		# max n n>1
+		jumpTrue loop;	# max n
+	    
+		pop;		# max
+	    }
+	}
+	set result {}
+	for {set i 1} {$i < 30} {incr i} {
+	    lappend result [ulam $i]
+	}
+	set result
+    }
+    -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
+}
+
+rename fillTables {}
+rename assemble {}
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
\ No newline at end of file
diff --git a/tests/assemble1.bench b/tests/assemble1.bench
new file mode 100644
index 0000000..18fd3a9
--- /dev/null
+++ b/tests/assemble1.bench
@@ -0,0 +1,85 @@
+proc ulam1 {n} {
+    set max $n
+    while {$n != 1} {
+	if {$n > $max} {
+	    set max $n
+	}
+	if {$n % 2} {
+	    set n [expr {3 * $n + 1}]
+	} else {
+	    set n [expr {$n / 2}]
+	}
+    }
+    return $max
+}
+
+set tcl_traceCompile 2; ulam1 1; set tcl_traceCompile 0
+
+proc ulam2 {n} {
+    tcl::unsupported::assemble {
+	load n;		# max
+	dup;		# max n
+	jump start;     # max n
+	
+	label loop;	# max n
+	over 1;         # max n max
+	over 1;		# max in max n
+	ge;             # man n max>=n
+	jumpTrue skip;  # max n
+
+	reverse 2;      # n max
+	pop;            # n
+	dup;            # n n
+	
+	label skip;	# max n
+	dup;            # max n n
+	push 2;         # max n n 2
+	mod;            # max n n%2
+	jumpTrue odd;   # max n
+	
+	push 2;         # max n 2
+	div;            # max n/2 -> max n
+	jump start;     # max n
+	
+	label odd;	# max n
+	push 3;         # max n 3
+	mult;           # max 3*n
+	push 1;         # max 3*n 1
+	add;            # max 3*n+1
+	
+	label start;	# max n
+	dup;		# max n n
+	push 1;		# max n n 1
+	neq;		# max n n>1
+	jumpTrue loop;	# max n
+	
+	pop;		# max
+    }
+}
+set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0
+
+proc test1 {n} {
+    for {set i 1} {$i <= $n} {incr i} {
+	ulam1 $i  
+    }
+}
+proc test2 {n} {
+    for {set i 1} {$i <= $n} {incr i} {
+	ulam2 $i  
+    }
+}
+
+for {set j 0} {$j < 10} {incr j} {
+    test1 1
+    set before [clock microseconds]
+    test1 30000
+    set after [clock microseconds]
+    puts "compiled: [expr {1e-6 * ($after - $before)}]"
+    
+    test2 1
+    set before [clock microseconds]
+    test2 30000
+    set after [clock microseconds]
+    puts "assembled: [expr {1e-6 * ($after - $before)}]"
+}
+    
\ No newline at end of file
diff --git a/unix/Makefile.in b/unix/Makefile.in
index f0f766c..bba6f91 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -306,7 +306,8 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclStrToD.o tclThread.o \
 	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
 	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
-	tclTomMathInterface.o
+	tclTomMathInterface.o \
+	tclAssembly.o
 
 OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
 	tclOOMethod.o tclOOStubInit.o
@@ -382,6 +383,7 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/regfree.c \
 	$(GENERIC_DIR)/regerror.c \
 	$(GENERIC_DIR)/tclAlloc.c \
+	$(GENERIC_DIR)/tclAssembly.c \
 	$(GENERIC_DIR)/tclAsync.c \
 	$(GENERIC_DIR)/tclBasic.c \
 	$(GENERIC_DIR)/tclBinary.c \
@@ -450,6 +452,7 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclTrace.c \
 	$(GENERIC_DIR)/tclUtil.c \
 	$(GENERIC_DIR)/tclVar.c \
+	$(GENERIC_DIR)/tclAssembly.c \
 	$(GENERIC_DIR)/tclZlib.c
 
 OO_SRCS = \
@@ -1010,6 +1013,9 @@ tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
 tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
 	$(CC) -c $(CC_SWITCHES) -DUSE_TCLALLOC=0 $(GENERIC_DIR)/tclAlloc.c
 
+tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c
+
 tclAsync.o: $(GENERIC_DIR)/tclAsync.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c
 
diff --git a/win/Makefile.in b/win/Makefile.in
index b47a7e1..eaf40d1 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -211,6 +211,7 @@ GENERIC_OBJS = \
 	regfree.$(OBJEXT) \
 	regerror.$(OBJEXT) \
 	tclAlloc.$(OBJEXT) \
+	tclAssembly.$(OBJEXT) \
 	tclAsync.$(OBJEXT) \
 	tclBasic.$(OBJEXT) \
 	tclBinary.$(OBJEXT) \
diff --git a/win/makefile.vc b/win/makefile.vc
index f04e193..9cf4769 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -247,6 +247,7 @@ COREOBJS = \
 	$(TMP_DIR)\regexec.obj \
 	$(TMP_DIR)\regfree.obj \
 	$(TMP_DIR)\tclAlloc.obj \
+	$(TMP_DIR)\tclAssembly.obj \
 	$(TMP_DIR)\tclAsync.obj \
 	$(TMP_DIR)\tclBasic.obj \
 	$(TMP_DIR)\tclBinary.obj \