diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclAssembly.c | 2724 | ||||
| -rw-r--r-- | tests/assemble.test | 264 |
3 files changed, 1451 insertions, 1542 deletions
@@ -1,3 +1,8 @@ +2011-03-08 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclAssembly.c, tests/assemble.test: Migrate to use a style + more consistent with the rest of Tcl. + 2011-03-06 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: More replacements of Tcl_UtfBackslash() calls diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index cc5dccf..d7e02bf 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -3,16 +3,14 @@ * * 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. + * 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 $ */ /*- @@ -34,14 +32,18 @@ #include "tclCompile.h" #include "tclOOInt.h" -/* Structure that represents a range of instructions in the bytecode */ +/* + * 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 */ +/* + * State identified for a basic block's catch context. + */ typedef enum BasicBlockCatchState { BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */ @@ -51,138 +53,143 @@ typedef enum BasicBlockCatchState { * 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 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 + * 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 */ + 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 + 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 */ - + 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 */ + 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 */ - + /* 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 */ - + /* 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 */ +/* + * 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_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' + * 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 + * unwinding the catch from the exception * stack. */ }; -/* Source instruction type recognized by the assembler */ +/* + * 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 */ + 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. */ +/* + * Description of an instruction recognized by the assembler. + */ typedef struct TalInstDesc { const char *name; /* Name of instruction. */ @@ -191,108 +198,122 @@ typedef struct TalInstDesc { * 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 */ + * 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 */ + * 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 */ +/* + * 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 + 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 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 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 tblIdx, + int count); +static void BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx, + unsigned char opnd, int count); +static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx, + int opnd, int count); +static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx, + int param, int count); +static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx, + 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", @@ -330,143 +351,141 @@ static const Tcl_ObjType assembleCodeType = { */ 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}, + {"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}, + 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}, + {"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}, + 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}, + {"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}, + {"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}, + {"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}, + {"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}, + 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}, + {"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}, + {"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}, + {"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}, + {"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}, + {"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}, + {"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}, + 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}, + {"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}, + {"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} + {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. + * 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. */ @@ -479,36 +498,47 @@ static unsigned char NonThrowingByteCodes[] = { INST_REVERSE, /* 126 */ INST_NOP /* 132 */ }; + +/* + * Helper macros. + */ + +#if defined(TCL_DEBUG_ASSEMBLY) && defined(__GNUC__) && __GNUC__ > 2 +#define DEBUG_PRINT(...) fprintf(stderr, ##__VA_ARGS__);fflush(stderr) +#elif defined(__GNUC__) && __GNUC__ > 2 +#define DEBUG_PRINT(...) /* nothing */ +#else +#define DEBUG_PRINT /* nothing */ +#endif /* *----------------------------------------------------------------------------- * * BBAdjustStackDepth -- * - * When an opcode is emitted, adjusts the stack information in the - * basic block to reflect the number of operands produced and consumed. + * 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. + * 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 +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 + int produced) /* Count of operands produced by the * operation */ { int depth = bbPtr->finalStackDepth; + depth -= consumed; if (depth < bbPtr->minStackDepth) { bbPtr->minStackDepth = depth; @@ -535,32 +565,39 @@ BBAdjustStackDepth(BasicBlock* bbPtr, * 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. + * 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. + * 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 +BBUpdateStackReqs( + BasicBlock* bbPtr, /* Structure describing the basic block */ + int tblIdx, /* Index in TalInstructionTable of the * operation being assembled */ - int count) /* Count of operands for variadic insts */ + int count) /* Count of operands for variadic insts */ { - int consumed = TalInstructionTable[tblind].operandsConsumed; - int produced = TalInstructionTable[tblind].operandsProduced; + int consumed = TalInstructionTable[tblIdx].operandsConsumed; + int produced = TalInstructionTable[tblIdx].operandsProduced; + if (consumed == INT_MIN) { - /* The instruction is variadic; it consumes 'count' operands. */ + /* + * 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' */ + /* + * 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); @@ -572,32 +609,35 @@ BBUpdateStackReqs(BasicBlock* bbPtr, * 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. + * 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. + * 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 */ +BBEmitOpcode( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + int tblIdx, /* 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; + int op = TalInstructionTable[tblIdx].tclInstCode & 0xff; - /* If this is the first instruction in a basic block, record its - * line number. */ + /* + * 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; @@ -605,27 +645,28 @@ BBEmitOpcode(AssemblyEnv* assemEnvPtr, TclEmitInt1(op, envPtr); envPtr->atCmdStart = ((op) == INST_START_CMD); - BBUpdateStackReqs(bbPtr, tblind, count); + BBUpdateStackReqs(bbPtr, tblIdx, 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 */ +BBEmitInstInt1( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + int tblIdx, /* Index in TalInstructionTable of op */ + unsigned char opnd, /* 1-byte operand */ + int count) /* Operand count for variadic ops */ { - BBEmitOpcode(assemEnvPtr, tblind, count); + BBEmitOpcode(assemEnvPtr, tblIdx, 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 */ +BBEmitInstInt4( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + int tblIdx, /* Index in TalInstructionTable of op */ + int opnd, /* 4-byte operand */ + int count) /* Operand count for variadic ops */ { - BBEmitOpcode(assemEnvPtr, tblind, count); + BBEmitOpcode(assemEnvPtr, tblIdx, count); TclEmitInt4(opnd, assemEnvPtr->envPtr); } @@ -641,18 +682,18 @@ BBEmitInstInt4(AssemblyEnv* assemEnvPtr, */ static void -BBEmitInst1or4(AssemblyEnv* assemEnvPtr, - /* Assembly environment */ - int tblind, /* Index in TalInstructionTable of op */ - int param, /* Variable-length parameter */ - int count) /* Arity if variadic */ +BBEmitInst1or4( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + int tblIdx, /* 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[tblIdx].tclInstCode; - int op = TalInstructionTable[tblind].tclInstCode; if (param <= 0xff) { op >>= 8; } else { @@ -665,7 +706,7 @@ BBEmitInst1or4(AssemblyEnv* assemEnvPtr, TclEmitInt4(param, envPtr); } envPtr->atCmdStart = ((op) == INST_START_CMD); - BBUpdateStackReqs(bbPtr, tblind, count); + BBUpdateStackReqs(bbPtr, tblIdx, count); } /* @@ -692,13 +733,14 @@ Tcl_AssembleObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - /* - * Boilerplate - make sure that there is an NRE trampoline on the - * C stack because there needs to be one in place to execute bytecode. + /* + * 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. */ @@ -707,21 +749,23 @@ TclNRAssembleObjCmd( 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 */ + Tcl_Obj* backtrace; /* Object where extra error information is + * constructed. */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList"); return TCL_ERROR; } - /* Assemble the source to bytecode */ + /* + * Assemble the source to bytecode. + */ codePtr = CompileAssembleObj(interp, objv[1]); - /* On failure, report error line */ + /* + * On failure, report error line. + */ if (codePtr == NULL) { Tcl_AddErrorInfo(interp, "\n (\""); @@ -735,15 +779,16 @@ TclNRAssembleObjCmd( return TCL_ERROR; } - /* Use NRE to evaluate the bytecode from the trampoline */ - /* + * Use NRE to evaluate the bytecode from the trampoline. + */ + +#if 0 Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr, NULL, NULL); return TCL_OK; - */ +#endif return TclNRExecuteByteCode(interp, codePtr); - } /* @@ -751,17 +796,17 @@ TclNRAssembleObjCmd( * * CompileAssembleObj -- * - * Sets up and assembles Tcl bytecode for the direct-execution path - * in the Tcl bytecode assembler. + * 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. + * 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 */ @@ -772,75 +817,80 @@ CompileAssembleObj( 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 */ + 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 */ + 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; + codePtr = objPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) - || (codePtr->compileEpoch != iPtr->compileEpoch) - || (codePtr->nsPtr != namespacePtr) - || (codePtr->nsEpoch != namespacePtr->resolverEpoch) - || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { - + || (codePtr->compileEpoch != iPtr->compileEpoch) + || (codePtr->nsPtr != namespacePtr) + || (codePtr->nsEpoch != namespacePtr->resolverEpoch) + || (codePtr->localCachePtr + != iPtr->varFramePtr->localCachePtr)) { FreeAssembleCodeInternalRep(objPtr); + } else { + return codePtr; } } - 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; - } + /* + * 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) { /* - * 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. + * Assembly failed. Clean up and report the error. */ - TclEmitOpcode(INST_DONE, &compEnv); - TclInitByteCodeObj(objPtr, &compEnv); - objPtr->typePtr = &assembleCodeType; TclFreeCompileEnv(&compEnv); + return NULL; + } - /* - * Record the local variable context to which the bytecode pertains - */ + /* + * 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. + */ - codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; - if (iPtr->varFramePtr->localCachePtr) { - codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; - codePtr->localCachePtr->refCount++; - } + TclEmitOpcode(INST_DONE, &compEnv); + TclInitByteCodeObj(objPtr, &compEnv); + objPtr->typePtr = &assembleCodeType; + TclFreeCompileEnv(&compEnv); - /* Report on what the assembler did. */ + /* + * Record the local variable context to which the bytecode pertains + */ + + codePtr = 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 */ + if (tclTraceCompile >= 2) { + TclPrintByteCodeObj(interp, objPtr); + fflush(stdout); } +#endif /* TCL_COMPILE_DEBUG */ + return codePtr; } @@ -855,46 +905,45 @@ CompileAssembleObj( * Returns a standard Tcl result. * * Side effects: - * Puts the result of assembling the code into the bytecode stream - * in 'compileEnv'. + * 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 + * 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( +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 */ + /* + * Make sure that the command has a single arg that is a simple word. + */ 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; + /* + * Compile the code and return any error from the compilation. + */ + return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0); } /* @@ -902,13 +951,12 @@ int TclCompileAssembleCmd( * * TclAssembleCode -- * - * Take a list of instructions in a Tcl_Obj, and assemble them to - * Tcl bytecodes + * 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. + * 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 @@ -918,36 +966,35 @@ int TclCompileAssembleCmd( */ 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 */ +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. + /* + * 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 + 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 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 */ + /* + * Parse out one command line from the assembly script. + */ status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr); instLen = parsePtr->commandSize; @@ -955,42 +1002,50 @@ TclAssembleCode(CompileEnv *envPtr, --instLen; } - /* Report errors in the parse */ + /* + * Report errors in the parse. + */ if (status != TCL_OK) { if (flags & TCL_EVAL_DIRECT) { - Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, - instLen); + Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, + instLen); } FreeAssemblyEnv(assemEnvPtr); return TCL_ERROR; } - /* Advance the pointers around any leading commentary */ + /* + * Advance the pointers around any leading commentary. + */ - TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr, parsePtr->commandStart); - TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, - parsePtr->commandStart - envPtr->source); + TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr, + parsePtr->commandStart); + TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, + parsePtr->commandStart - envPtr->source); - /* Process the line of code */ + /* + * Process the line of code. + */ if (parsePtr->numWords > 0) { - - /* If tracing, show each line assembled as it happens */ + /* + * 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); + envPtr->codeNext - envPtr->codeStart); TclPrintSource(stdout, parsePtr->commandStart, - TclMin(instLen, 55)); + TclMin(instLen, 55)); printf("\n"); } #endif if (AssembleOneLine(assemEnvPtr) != TCL_OK) { if (flags & TCL_EVAL_DIRECT) { - Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart, - instLen); + Tcl_LogCommandInfo(interp, codePtr, + parsePtr->commandStart, instLen); } Tcl_FreeParse(parsePtr); FreeAssemblyEnv(assemEnvPtr); @@ -998,18 +1053,23 @@ TclAssembleCode(CompileEnv *envPtr, } } - /* Advance to the next line of code */ + /* + * Advance to the next line of code. + */ nextPtr = parsePtr->commandStart + parsePtr->commandSize; bytesLeft -= (nextPtr - instPtr); instPtr = nextPtr; - TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart, instPtr); + TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart, + instPtr); TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext, - instPtr - envPtr->source); + instPtr - envPtr->source); Tcl_FreeParse(parsePtr); } while (bytesLeft > 0); - /* Done with parsing the code */ + /* + * Done with parsing the code. + */ status = FinishAssembly(assemEnvPtr); FreeAssemblyEnv(assemEnvPtr); @@ -1030,10 +1090,10 @@ TclAssembleCode(CompileEnv *envPtr, */ static AssemblyEnv* -NewAssemblyEnv(CompileEnv* envPtr, - /* Compilation environment being used - * for code generation*/ - int flags) /* Compilation flags (TCL_EVAL_DIRECT) */ +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 */ @@ -1047,21 +1107,26 @@ NewAssemblyEnv(CompileEnv* envPtr, assemEnvPtr->cmdLine = envPtr->line; assemEnvPtr->clNext = envPtr->clNext; - /* Make the hashtables that store symbol resolution */ + /* + * Make the hashtables that store symbol resolution. + */ Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS); - /* Start the first basic block */ + /* + * 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 */ + /* + * Stash compilation flags. + */ assemEnvPtr->flags = flags; - return assemEnvPtr; } @@ -1076,43 +1141,56 @@ NewAssemblyEnv(CompileEnv* envPtr, */ static void -FreeAssemblyEnv(AssemblyEnv* assemEnvPtr) - /* Environment to free */ +FreeAssemblyEnv( + AssemblyEnv* assemEnvPtr) /* Environment to free */ { CompileEnv* envPtr = assemEnvPtr->envPtr; - /* Compilation environment being used - * for code generation */ + /* 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 + BasicBlock* nextBB; /* Pointer to a deleted basic block's * successor */ - Tcl_HashEntry* hashEntry; - Tcl_HashSearch hashSearch; - /* Free all the basic block structures */ + /* + * 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)); + ckfree((char*) thisBB->foreignExceptions); } nextBB = thisBB->successor1; if (thisBB->jtPtr != NULL) { DeleteMirrorJumpTable(thisBB->jtPtr); thisBB->jtPtr = NULL; } - ckfree((char*)thisBB); + ckfree((char*) thisBB); } - /* Free the label hash */ - while ((hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash, - &hashSearch)) != NULL) { + /* + * Free the label hash. + */ + + while (1) { + Tcl_HashEntry* hashEntry; + Tcl_HashSearch hashSearch; + + hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash, &hashSearch); + if (hashEntry == NULL) { + break; + } Tcl_DeleteHashEntry(hashEntry); } + /* + * Dispose what's left. + */ + TclStackFree(interp, assemEnvPtr->parsePtr); TclStackFree(interp, assemEnvPtr); } @@ -1125,20 +1203,20 @@ FreeAssemblyEnv(AssemblyEnv* assemEnvPtr) * 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. + * 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 */ +AssembleOneLine( + AssemblyEnv* assemEnvPtr) /* State of the assembly */ { CompileEnv* envPtr = assemEnvPtr->envPtr; - /* Compilation environment being used for - * code gen */ + /* Compilation environment being used for code + * gen */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Parse* parsePtr = assemEnvPtr->parsePtr; @@ -1146,13 +1224,13 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) Tcl_Token* tokenPtr; /* Current token within the line of code */ Tcl_Obj* instNameObj = NULL; /* Name of the instruction */ - int tblind; /* Index in TalInstructionTable of the + int tblIdx; /* 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 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 */ @@ -1160,8 +1238,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) 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. */ + + /* + * Make sure that the instruction name is known at compile time. + */ tokenPtr = parsePtr->tokenPtr; instNameObj = Tcl_NewObj(); @@ -1170,18 +1250,21 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) return TCL_ERROR; } - /* Look up the instruction name */ - + /* + * Look up the instruction name. + */ + if (Tcl_GetIndexFromObjStruct(interp, instNameObj, - &TalInstructionTable[0].name, - sizeof(TalInstDesc), "instruction", - TCL_EXACT, &tblind) != TCL_OK) { + &TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction", + TCL_EXACT, &tblIdx) != TCL_OK) { return TCL_ERROR; } - /* Vector on the type of instruction being processed */ + /* + * Vector on the type of instruction being processed. + */ - instType = TalInstructionTable[tblind].instType; + instType = TalInstructionTable[tblIdx].instType; switch (instType) { case ASSEM_PUSH: @@ -1194,7 +1277,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) } operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len); - BBEmitInst1or4(assemEnvPtr, tblind, litIndex, 0); + BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0); break; case ASSEM_1BYTE: @@ -1202,16 +1285,17 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) Tcl_WrongNumArgs(interp, 1, &instNameObj, ""); goto cleanup; } - BBEmitOpcode(assemEnvPtr, tblind, 0); + BBEmitOpcode(assemEnvPtr, tblIdx, 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. + * 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; @@ -1220,8 +1304,8 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; - assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart; - BBEmitInstInt4(assemEnvPtr, tblind, 0, 0); + assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; + BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0); assemEnvPtr->curr_bb->flags |= BB_BEGINCATCH; StartBasicBlock(assemEnvPtr, BB_FALLTHRU, operand1Obj); break; @@ -1234,7 +1318,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0); + BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; case ASSEM_BOOL_LVT4: @@ -1243,10 +1327,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) { + || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) { goto cleanup; } - BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0); + BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; @@ -1256,11 +1340,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckOneByte(interp, opnd) != TCL_OK - || CheckStrictlyPositive(interp, opnd) != TCL_OK) { + || CheckOneByte(interp, opnd) != TCL_OK + || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt1(assemEnvPtr, tblind, opnd, opnd); + BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_DICT_GET: @@ -1269,10 +1353,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckStrictlyPositive(interp, opnd) != TCL_OK) { + || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); break; case ASSEM_DICT_SET: @@ -1281,11 +1365,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckStrictlyPositive(interp, opnd) != TCL_OK - || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { + || CheckStrictlyPositive(interp, opnd) != TCL_OK + || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); TclEmitInt4(localVar, envPtr); break; @@ -1295,11 +1379,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckStrictlyPositive(interp, opnd) != TCL_OK - || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { + || CheckStrictlyPositive(interp, opnd) != TCL_OK + || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); TclEmitInt4(localVar, envPtr); break; @@ -1309,34 +1393,37 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } assemEnvPtr->curr_bb->flags |= BB_ENDCATCH; - BBEmitOpcode(assemEnvPtr, tblind, 0); + BBEmitOpcode(assemEnvPtr, tblIdx, 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. - */ + /* 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")); + Tcl_WrongNumArgs(interp, 1, &instNameObj, + ((TalInstructionTable[tblIdx].tclInstCode + == INST_EVAL_STK) ? "script" : "expression")); goto cleanup; } if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - CompileEmbeddedScript(assemEnvPtr, tokenPtr+1, - TalInstructionTable+tblind); + CompileEmbeddedScript(assemEnvPtr, tokenPtr+1, + TalInstructionTable+tblIdx); } else if (GetNextOperand(assemEnvPtr, &tokenPtr, - &operand1Obj) != TCL_OK) { + &operand1Obj) != TCL_OK) { goto cleanup; } else { operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len); - /* Assumes that PUSH is the first slot! */ + + /* + * Assumes that PUSH is the first slot! + */ + BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); - BBEmitOpcode(assemEnvPtr, tblind, 0); + BBEmitOpcode(assemEnvPtr, tblIdx, 0); } break; @@ -1346,14 +1433,14 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckStrictlyPositive(interp, opnd) != TCL_OK) { + || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } - - BBEmitInst1or4(assemEnvPtr, tblind, opnd, opnd); + + BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd); break; - - case ASSEM_JUMP: + + case ASSEM_JUMP: case ASSEM_JUMP4: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "label"); @@ -1362,25 +1449,26 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } - assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart; + assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; if (instType == ASSEM_JUMP) { flags = BB_JUMP1; - BBEmitInstInt1(assemEnvPtr, tblind, 0, 0); + BBEmitInstInt1(assemEnvPtr, tblIdx, 0, 0); } else { flags = 0; - BBEmitInstInt4(assemEnvPtr, tblind, 0, 0); + BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0); } - - /* Start a new basic block at the instruction following the jump */ + + /* + * Start a new basic block at the instruction following the jump. + */ assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; - if (TalInstructionTable[tblind].operandsConsumed != 0) { + if (TalInstructionTable[tblIdx].operandsConsumed != 0) { flags |= BB_FALLTHRU; } StartBasicBlock(assemEnvPtr, flags, operand1Obj); - break; - + case ASSEM_JUMPTABLE: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "table"); @@ -1389,16 +1477,20 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) 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->jumpOffset = envPtr->codeNext-envPtr->codeStart; + DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n", assemEnvPtr->curr_bb, assemEnvPtr->cmdLine, - envPtr->codeNext - envPtr->codeStart); fflush(stderr); */ + envPtr->codeNext - envPtr->codeStart); + infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); - /* fprintf(stderr, "auxdata index=%d\n", infoIndex); */ - BBEmitInstInt4(assemEnvPtr, tblind, infoIndex, 0); + DEBUG_PRINT("auxdata index=%d\n", infoIndex); + + BBEmitInstInt4(assemEnvPtr, tblIdx, infoIndex, 0); if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) { goto cleanup; } @@ -1406,7 +1498,6 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) break; case ASSEM_LABEL: - if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "name"); goto cleanup; @@ -1414,7 +1505,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } - /* Add the (label_name, address) pair to the hash table */ + + /* + * Add the (label_name, address) pair to the hash table. + */ + if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) { goto cleanup; } @@ -1426,24 +1521,24 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckStrictlyPositive(interp, opnd) != TCL_OK) { + || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + BBEmitInstInt4(assemEnvPtr, tblIdx, 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) { + || CheckNonNegative(interp, opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; - + case ASSEM_INDEX: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count"); @@ -1452,7 +1547,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_LSET_FLAT: @@ -1466,14 +1561,14 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) if (opnd < 2) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("operand must be >=2", -1)); + Tcl_NewStringObj("operand must be >=2", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL); } goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; - + case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); @@ -1482,7 +1577,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) { goto cleanup; } - BBEmitInst1or4(assemEnvPtr, tblind, localVar, 0); + BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1: @@ -1491,10 +1586,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0 - || CheckOneByte(interp, localVar)) { + || CheckOneByte(interp, localVar)) { goto cleanup; } - BBEmitInstInt1(assemEnvPtr, tblind, localVar, 0); + BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1_SINT1: @@ -1503,12 +1598,12 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0 - || CheckOneByte(interp, localVar) - || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckSignedOneByte(interp, opnd)) { + || CheckOneByte(interp, localVar) + || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK + || CheckSignedOneByte(interp, opnd)) { goto cleanup; } - BBEmitInstInt1(assemEnvPtr, tblind, localVar, 0); + BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); TclEmitInt1(opnd, envPtr); break; @@ -1520,7 +1615,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, localVar, 0); + BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_OVER: @@ -1529,10 +1624,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckNonNegative(interp, opnd) != TCL_OK) { + || CheckNonNegative(interp, opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); break; case ASSEM_REGEXP: @@ -1545,7 +1640,8 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) } { int flags = TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0); - BBEmitInstInt1(assemEnvPtr, tblind, flags, 0); + + BBEmitInstInt1(assemEnvPtr, tblIdx, flags, 0); } break; @@ -1555,22 +1651,22 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || CheckNonNegative(interp, opnd) != TCL_OK) { + || CheckNonNegative(interp, opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd); + BBEmitInstInt4(assemEnvPtr, tblIdx, 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) { + || CheckSignedOneByte(interp, opnd) != TCL_OK) { goto cleanup; } - BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0); + BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; case ASSEM_SINT4_LVT4: @@ -1579,16 +1675,16 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK - || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { + || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) { goto cleanup; } - BBEmitInstInt4(assemEnvPtr, tblind, opnd, 0); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; default: Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n", - Tcl_GetString(instNameObj)); + Tcl_GetString(instNameObj)); } status = TCL_OK; @@ -1609,18 +1705,17 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) * * 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 + * 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). + * 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 @@ -1630,25 +1725,22 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr) */ static void -CompileEmbeddedScript(AssemblyEnv* assemEnvPtr, - /* Assembler environment */ - Tcl_Token* tokenPtr, - /* Tcl_Token containing the script */ - TalInstDesc* instPtr) - /* Instruction that determines whether +CompileEmbeddedScript( + AssemblyEnv* assemEnvPtr, /* Assembly 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 */ - /* + /* + * 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. + * * 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 @@ -1673,26 +1765,29 @@ CompileEmbeddedScript(AssemblyEnv* assemEnvPtr, break; default: Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen", - instPtr->name, instPtr->tclInstCode); + 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. + /* + * 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); + MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex, + savedExceptArrayNext); - /* Flush the current basic block */ + /* + * Flush the current basic block. + */ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); } @@ -1702,24 +1797,21 @@ CompileEmbeddedScript(AssemblyEnv* assemEnvPtr, * * SyncStackDepth -- * - * Copies the stack depth from the compile environment to a basic - * block. + * 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. + * 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. + * 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 */ +SyncStackDepth( + AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -1748,12 +1840,10 @@ SyncStackDepth(AssemblyEnv* assemEnvPtr) */ static void -MoveExceptionRangesToBasicBlock(AssemblyEnv* assemEnvPtr, - /* Assembler environment */ - int savedCodeIndex, - /* Start of the embedded code */ - int savedExceptArrayNext) - /* Saved index of the end of the exception +MoveExceptionRangesToBasicBlock( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + int savedCodeIndex, /* Start of the embedded code */ + int savedExceptArrayNext) /* Saved index of the end of the exception * range array */ { CompileEnv* envPtr = assemEnvPtr->envPtr; @@ -1769,59 +1859,56 @@ MoveExceptionRangesToBasicBlock(AssemblyEnv* assemEnvPtr, 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 + /* + * 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); */ + DEBUG_PRINT("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)); + ckalloc(exceptionCount * sizeof(ExceptionRange)); memcpy(curr_bb->foreignExceptions, - envPtr->exceptArrayPtr + savedExceptArrayNext, - exceptionCount * sizeof(ExceptionRange)); + 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. + * 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 + * 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 */ +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; @@ -1831,7 +1918,8 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, 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 */ + int isNew; /* Flag==1 if the key is not yet in the + * table. */ Tcl_Obj* result; /* Error message */ int i; @@ -1840,33 +1928,36 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, } 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_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 */ + + /* + * Allocate the jumptable. + */ jtPtr = (JumptableInfo*) ckalloc(sizeof(JumptableInfo)); - jtHashPtr = &(jtPtr->hashTable); + jtHashPtr = &jtPtr->hashTable; Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS); - /* Fill the keys and labels into the table */ + /* + * Fill the keys and labels into the table. + */ - /* fprintf(stderr, "jump table {\n"); */ + DEBUG_PRINT("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); */ + DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]), + Tcl_GetString(objv[i+1])); hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]), - &isNew); + &isNew); if (!isNew) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - result = Tcl_NewStringObj("duplicate entry in jump table for " - "\"", -1); + result = Tcl_NewStringObj( + "duplicate entry in jump table for \"", -1); Tcl_AppendObjToObj(result, objv[i]); Tcl_AppendToObj(result, "\"", -1); Tcl_SetObjResult(interp, result); @@ -1878,13 +1969,13 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_SetHashValue(hashEntry, (ClientData) objv[i+1]); Tcl_IncrRefCount(objv[i+1]); } - /* fprintf(stderr, "}\n"); fflush(stderr); */ - + DEBUG_PRINT("}\n"); - /* Put the mirror jumptable in the basic block struct */ + /* + * Put the mirror jumptable in the basic block struct. + */ bbPtr->jtPtr = jtPtr; - return TCL_OK; } @@ -1899,7 +1990,8 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, */ static void -DeleteMirrorJumpTable(JumptableInfo* jtPtr) +DeleteMirrorJumpTable( + JumptableInfo* jtPtr) { Tcl_HashTable* jtHashPtr = &jtPtr->hashTable; /* Hash table pointer */ @@ -1908,30 +2000,28 @@ DeleteMirrorJumpTable(JumptableInfo* jtPtr) 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); + entry != NULL; + entry = Tcl_NextHashEntry(&search)) { + label = Tcl_GetHashValue(entry); Tcl_DecrRefCount(label); Tcl_SetHashValue(entry, NULL); } Tcl_DeleteHashTable(jtHashPtr); - ckfree((char*)jtPtr); + 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. + * 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. + * 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. @@ -1940,24 +2030,21 @@ DeleteMirrorJumpTable(JumptableInfo* jtPtr) */ 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. */ +GetNextOperand( + AssemblyEnv* assemEnvPtr, /* Assembly 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_SetObjResult(interp, Tcl_NewStringObj( + "assembly code may not contain substitutions", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL); } return TCL_ERROR; @@ -1988,33 +2075,35 @@ GetNextOperand(AssemblyEnv* assemEnvPtr, */ static int -GetBooleanOperand(AssemblyEnv* assemEnvPtr, - /* Assembly environment */ - Tcl_Token** tokenPtrPtr, - /* Current token from the parser */ - int* result) - /* OUTPUT: Integer extracted from the token */ +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 */ + /* 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 */ + /* + * 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 */ + + /* + * Convert to an integer, advance to the next token and return. + */ status = Tcl_GetBooleanFromObj(interp, intObj, result); Tcl_DecrRefCount(intObj); @@ -2027,48 +2116,50 @@ GetBooleanOperand(AssemblyEnv* assemEnvPtr, * * GetIntegerOperand -- * - * Retrieves an integer operand from the input stream and advances - * the token pointer. + * 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. + * 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 */ +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 */ + /* 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 */ + /* + * 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 */ + + /* + * Convert to an integer, advance to the next token and return. + */ status = Tcl_GetIntFromObj(interp, intObj, result); Tcl_DecrRefCount(intObj); @@ -2084,8 +2175,8 @@ GetIntegerOperand(AssemblyEnv* assemEnvPtr, * 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. + * 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 @@ -2097,25 +2188,24 @@ GetIntegerOperand(AssemblyEnv* assemEnvPtr, static int GetListIndexOperand( - AssemblyEnv* assemEnvPtr, - /* Assembly environment */ - Tcl_Token** tokenPtrPtr, - /* Current token from the parser */ - int* result) - /* OUTPUT: Integer extracted from the token */ + 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 */ + /* 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 */ + /* + * Extract the next token as a string. + */ Tcl_IncrRefCount(intObj); if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) { @@ -2123,7 +2213,9 @@ GetListIndexOperand( return TCL_ERROR; } - /* Convert to an integer, advance to the next token and return */ + /* + * Convert to an integer, advance to the next token and return. + */ status = TclGetIntForIndex(interp, intObj, -2, result); Tcl_DecrRefCount(intObj); @@ -2140,22 +2232,22 @@ GetListIndexOperand( * 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). + * 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. + * 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) +FindLocalVar( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + Tcl_Token** tokenPtrPtr) { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -2183,10 +2275,9 @@ FindLocalVar(AssemblyEnv* assemEnvPtr, 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_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; @@ -2204,30 +2295,27 @@ FindLocalVar(AssemblyEnv* assemEnvPtr, * 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. + * 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 */ +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++) { + 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); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL); return TCL_ERROR; } } @@ -2239,11 +2327,12 @@ CheckNamespaceQualifiers(Tcl_Interp* interp, * * CheckOneByte -- * - * Verify that a constant fits in a single byte in the instruction stream. + * 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. + * 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 @@ -2253,11 +2342,12 @@ CheckNamespaceQualifiers(Tcl_Interp* interp, */ static int -CheckOneByte(Tcl_Interp* interp, - /* Tcl interpreter for error reporting */ - int value) /* Value to check */ +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); @@ -2273,11 +2363,11 @@ CheckOneByte(Tcl_Interp* interp, * CheckSignedOneByte -- * * Verify that a constant fits in a single signed byte in the instruction - * stream. + * stream. * * Results: - * On success, returns TCL_OK. On failure, returns TCL_ERROR and - * stores an error message in the interpreter result. + * 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 @@ -2287,11 +2377,12 @@ CheckOneByte(Tcl_Interp* interp, */ static int -CheckSignedOneByte(Tcl_Interp* interp, - /* Tcl interpreter for error reporting */ - int value) /* Value to check */ +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); @@ -2309,8 +2400,8 @@ CheckSignedOneByte(Tcl_Interp* interp, * 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. + * 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 @@ -2319,11 +2410,12 @@ CheckSignedOneByte(Tcl_Interp* interp, */ static int -CheckNonNegative(Tcl_Interp* interp, - /* Tcl interpreter for error reporting */ - int value) /* Value to check */ +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); @@ -2351,11 +2443,12 @@ CheckNonNegative(Tcl_Interp* interp, */ static int -CheckStrictlyPositive(Tcl_Interp* interp, - /* Tcl interpreter for error reporting */ - int value) /* Value to check */ +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); @@ -2373,16 +2466,17 @@ CheckStrictlyPositive(Tcl_Interp* interp, * 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. + * 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 */ +DefineLabel( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + const char* labelName) /* Label being defined */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -2397,31 +2491,33 @@ DefineLabel(AssemblyEnv* assemEnvPtr, /* Assembly environment */ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); - /* Look up the newly-defined label in the symbol table */ + /* + * 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 (!isNew) { + /* + * This is a duplicate label. + */ if (assemEnvPtr-> flags & (TCL_EVAL_DIRECT)) { - result = Tcl_NewStringObj("duplicate definition " - "of label \"", -1); + 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); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", + labelName, NULL); } return TCL_ERROR; } + /* + * This is the first appearance of the label in the code. + */ + + Tcl_SetHashValue(entry, assemEnvPtr->curr_bb); return TCL_OK; } @@ -2440,42 +2536,51 @@ DefineLabel(AssemblyEnv* assemEnvPtr, /* Assembly environment */ */ 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 */ +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 */ + /* + * Coalesce zero-length blocks. + */ if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) { currBB->startLine = assemEnvPtr->cmdLine; return currBB; } - /* Make the new basic block */ + /* + * Make the new basic block. + */ newBB = AllocBB(assemEnvPtr); - /* Record the jump target if there is one. */ + /* + * Record the jump target if there is one. + */ - if ((currBB->jumpTarget = jumpLabel) != NULL) { + currBB->jumpTarget = jumpLabel; + if (jumpLabel != NULL) { Tcl_IncrRefCount(currBB->jumpTarget); } - /* Record the fallthrough if there is one. */ + /* + * Record the fallthrough if there is one. + */ currBB->flags |= flags; - /* Record the successor block */ + /* + * Record the successor block. + */ currBB->successor1 = newBB; assemEnvPtr->curr_bb = newBB; @@ -2496,15 +2601,15 @@ StartBasicBlock(AssemblyEnv* assemEnvPtr, *----------------------------------------------------------------------------- */ -static BasicBlock * -AllocBB(AssemblyEnv* assemEnvPtr) - /* Assembly environment */ +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->startOffset = envPtr->codeNext - envPtr->codeStart; bb->startLine = assemEnvPtr->cmdLine + 1; bb->jumpOffset = -1; bb->jumpLine = -1; @@ -2531,50 +2636,55 @@ AllocBB(AssemblyEnv* assemEnvPtr) * * FinishAssembly -- * - * Postprocessing after all bytecode has been generated for a block - * of assembly code. + * 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. + * 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 */ +static int +FinishAssembly( + AssemblyEnv* assemEnvPtr) /* Assembly environment */ { + int mustMove; /* Amount by which the code needs to be grown + * because of expanding jumps */ - 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. + /* + * 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 */ + /* + * Move the code if necessary. + */ if (mustMove) { MoveCodeForJumps(assemEnvPtr, mustMove); } - /* Resolve jump target labels to bytecode offsets */ + /* + * Resolve jump target labels to bytecode offsets. + */ FillInJumpOffsets(assemEnvPtr); - /* Label each basic block with its catch context. Quit on inconsistency */ + /* + * Label each basic block with its catch context. Quit on inconsistency. + */ if (ProcessCatches(assemEnvPtr) != TCL_OK) { return TCL_ERROR; @@ -2589,7 +2699,9 @@ FinishAssembly(AssemblyEnv* assemEnvPtr) return TCL_ERROR; } - /* Compute stack balance throughout the program */ + /* + * Compute stack balance throughout the program. + */ if (CheckStack(assemEnvPtr) != TCL_OK) { return TCL_ERROR; @@ -2607,33 +2719,31 @@ FinishAssembly(AssemblyEnv* assemEnvPtr) * 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). + * 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. + * 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 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. + * + * 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 +CalculateJumpRelocations( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + int* mustMove) /* OUTPUT: Number of bytes that have been * added to the code */ { CompileEnv* envPtr = assemEnvPtr->envPtr; @@ -2641,56 +2751,59 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr, 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 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 */ + /* + * 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 != 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 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)); + entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(bbPtr->jumpTarget)); if (entry == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, - bbPtr->jumpTarget); + 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); + + jumpTarget = Tcl_GetHashValue(entry); if (bbPtr->flags & BB_JUMP1) { offset = jumpTarget->startOffset - - (bbPtr->jumpOffset + motion); + - (bbPtr->jumpOffset + motion); if (offset < -0x80 || offset > 0x7f) { opcode = TclGetUInt1AtPtr(envPtr->codeStart - + bbPtr->jumpOffset); + + bbPtr->jumpOffset); ++opcode; - TclStoreInt1AtPtr(opcode, - envPtr->codeStart - + bbPtr->jumpOffset); + TclStoreInt1AtPtr(opcode, + envPtr->codeStart + bbPtr->jumpOffset); motion += 3; bbPtr->flags &= ~BB_JUMP1; } @@ -2698,9 +2811,9 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr, } /* - * 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 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) { @@ -2729,10 +2842,9 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr, */ static int -CheckJumpTableLabels(AssemblyEnv* assemEnvPtr, - /* Assembly environment */ - BasicBlock* bbPtr) - /* Basic block that ends in a jump table */ +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 */ @@ -2741,25 +2853,27 @@ CheckJumpTableLabels(AssemblyEnv* assemEnvPtr, Tcl_Obj* symbolObj; /* Jump target */ Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */ - /* Look up every jump target in the jump hash */ + /* + * Look up every jump target in the jump hash. + */ - /* fprintf(stderr, "check jump table labels %p {\n", bbPtr); */ + DEBUG_PRINT("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), + symEntryPtr != NULL; + symEntryPtr = Tcl_NextHashEntry(&search)) { + symbolObj = Tcl_GetHashValue(symEntryPtr); + valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(symbolObj)); + DEBUG_PRINT(" %s -> %s (%d)\n", + (char*) Tcl_GetHashKey(symHash, symEntryPtr), Tcl_GetString(symbolObj), - (valEntryPtr != NULL)); fflush(stderr); */ + (valEntryPtr != NULL)); if (valEntryPtr == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj); return TCL_ERROR; } } - /* fprintf(stderr, "}\n"); fflush(stderr); */ + DEBUG_PRINT("}\n"); return TCL_OK; } @@ -2777,13 +2891,11 @@ CheckJumpTableLabels(AssemblyEnv* assemEnvPtr, *----------------------------------------------------------------------------- */ static void -ReportUndefinedLabel(AssemblyEnv* assemEnvPtr, - /* Assembler environment */ - BasicBlock* bbPtr, - /* Basic block that contains the - * undefined label */ - Tcl_Obj* jumpTarget) - /* Label of a jump target */ +ReportUndefinedLabel( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + BasicBlock* bbPtr, /* Basic block that contains the undefined + * label */ + Tcl_Obj* jumpTarget) /* Label of a jump target */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -2797,7 +2909,7 @@ ReportUndefinedLabel(AssemblyEnv* assemEnvPtr, Tcl_AppendToObj(result, "\"", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL", - Tcl_GetString(jumpTarget), NULL); + Tcl_GetString(jumpTarget), NULL); Tcl_SetErrorLine(interp, bbPtr->jumpLine); } } @@ -2814,35 +2926,34 @@ ReportUndefinedLabel(AssemblyEnv* assemEnvPtr, */ static void -MoveCodeForJumps(AssemblyEnv* assemEnvPtr, - /* Assembler environment */ - int mustMove) /* Number of bytes of added code */ +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 */ + 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. + /* + * 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. + /* + * 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); - */ + DEBUG_PRINT("move code from %d to %d\n", + bbPtr->originalStartOffset, bbPtr->startOffset); memmove(envPtr->codeStart + bbPtr->startOffset, envPtr->codeStart + bbPtr->originalStartOffset, topOffset - bbPtr->originalStartOffset); @@ -2864,7 +2975,8 @@ MoveCodeForJumps(AssemblyEnv* assemEnvPtr, */ static void -FillInJumpOffsets(AssemblyEnv* assemEnvPtr) +FillInJumpOffsets( + AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -2876,27 +2988,26 @@ FillInJumpOffsets(AssemblyEnv* assemEnvPtr) * target */ for (bbPtr = assemEnvPtr->head_bb; - bbPtr != NULL; - bbPtr = bbPtr->successor1) { + bbPtr != NULL; + bbPtr = bbPtr->successor1) { if (bbPtr->jumpTarget != NULL) { - entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, - Tcl_GetString(bbPtr->jumpTarget)); - jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry); + entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(bbPtr->jumpTarget)); + jumpTarget = Tcl_GetHashValue(entry); fromOffset = bbPtr->jumpOffset; targetOffset = jumpTarget->startOffset; if (bbPtr->flags & BB_JUMP1) { TclStoreInt1AtPtr(targetOffset - fromOffset, - envPtr->codeStart + fromOffset + 1); + envPtr->codeStart + fromOffset + 1); } else { TclStoreInt4AtPtr(targetOffset - fromOffset, - envPtr->codeStart + fromOffset + 1); + envPtr->codeStart + fromOffset + 1); } } if (bbPtr->flags & BB_JUMPTABLE) { ResolveJumpTableTargets(assemEnvPtr, bbPtr); } } - } /* @@ -2914,10 +3025,9 @@ FillInJumpOffsets(AssemblyEnv* assemEnvPtr) */ static void -ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr, - /* Assembly environment */ - BasicBlock* bbPtr) - /* Basic block that ends in a jump table */ +ResolveJumpTableTargets( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + BasicBlock* bbPtr) /* Basic block that ends in a jump table */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -2933,44 +3043,45 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr, Tcl_HashTable* realJumpHashPtr; /* Jump table hash in the actual code */ Tcl_HashEntry* realJumpEntryPtr; - /* Entry in the jump table hash in + /* 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); */ + DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", + bbPtr, bbPtr->jumpOffset, auxDataIndex); realJumpTablePtr = (JumptableInfo*) - envPtr->auxDataArrayPtr[auxDataIndex].clientData; - realJumpHashPtr = &(realJumpTablePtr->hashTable); + envPtr->auxDataArrayPtr[auxDataIndex].clientData; + realJumpHashPtr = &realJumpTablePtr->hashTable; - /* Look up every jump target in the jump hash */ + /* + * Look up every jump target in the jump hash. + */ - /* fprintf(stderr, "resolve jump table {\n"); fflush(stderr); */ + DEBUG_PRINT("resolve jump table {\n"); 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)); */ + symEntryPtr != NULL; + symEntryPtr = Tcl_NextHashEntry(&search)) { + symbolObj = Tcl_GetHashValue(symEntryPtr); + DEBUG_PRINT(" 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 = Tcl_GetHashValue(valEntryPtr); + + realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr, + Tcl_GetHashKey(symHash, symEntryPtr), &junk); + DEBUG_PRINT(" %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)); + INT2PTR(jumpTargetBBPtr->startOffset - bbPtr->jumpOffset)); } - /* fprintf(stderr, "}\n"); fflush(stderr); */ + DEBUG_PRINT("}\n"); } /* @@ -2979,8 +3090,8 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr, * 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. + * after an original exception is caught and before its exception context + * is removed from the stack. * * Results: * Returns a standard Tcl result. @@ -2992,28 +3103,27 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr, */ static int -CheckForThrowInWrongContext(AssemblyEnv* assemEnvPtr) - /* Assembler environment */ +CheckForThrowInWrongContext( + AssemblyEnv* assemEnvPtr) /* Assembly 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. + /* + * 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) { - + blockPtr != NULL; + blockPtr = blockPtr->successor1) { if (blockPtr->catchState == BBCS_CAUGHT) { - - /* Walk through the instructions in the basic block */ + /* + * Walk through the instructions in the basic block. + */ if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) { return TCL_ERROR; } - } } return TCL_OK; @@ -3036,25 +3146,27 @@ CheckForThrowInWrongContext(AssemblyEnv* assemEnvPtr) */ static int -CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr, - /* Assembler environment */ - BasicBlock* blockPtr) - /* Basic block where exceptions are - * not allowed */ +CheckNonThrowingBlock( + AssemblyEnv* assemEnvPtr, /* Assembly 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 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 */ - + /* + * Determine where in the code array the basic block ends. + */ + nextPtr = blockPtr->successor1; if (nextPtr == NULL) { bound = envPtr->codeNext - envPtr->codeStart; @@ -3062,26 +3174,28 @@ CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr, bound = nextPtr->startOffset; } - /* Walk through the instructions of the block */ + /* + * Walk through the instructions of the block. + */ offset = blockPtr->startOffset; while (offset < bound) { + /* + * Determine whether an instruction is nonthrowing. + */ - /* Determine whether an instruction is nonthrowing */ - opcode = (envPtr->codeStart)[offset]; - if (BytecodeMightThrow(opcode)) { - - /* Report an error for a throw in the wrong context */ + /* + * 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, 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); + "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); @@ -3108,15 +3222,18 @@ CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr, */ static int -BytecodeMightThrow(unsigned char opcode) +BytecodeMightThrow( + unsigned char opcode) { - - /* Binary search on the non-throwing bytecode list */ + /* + * 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]; @@ -3125,8 +3242,9 @@ BytecodeMightThrow(unsigned char opcode) } else if (opcode > c) { min = mid+1; } else { - - /* Opcode is nonthrowing */ + /* + * Opcode is nonthrowing. + */ return 0; } @@ -3154,39 +3272,46 @@ BytecodeMightThrow(unsigned char opcode) */ static int -CheckStack(AssemblyEnv* assemEnvPtr) - /* Assembly environment */ +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. */ + /* + * Checking the head block will check all the other blocks recursively. + */ assemEnvPtr->maxDepth = 0; - if (StackCheckBasicBlock(assemEnvPtr, - assemEnvPtr->head_bb, NULL, 0) == TCL_ERROR) { - return TCL_ERROR; + if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL, + 0) == TCL_ERROR) { + return TCL_ERROR; } - /* Post the max stack depth back to the compilation environment */ + /* + * 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 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 */ + /* + * Reset the visited state on all basic blocks. + */ ResetVisitedBasicBlocks(assemEnvPtr); - return TCL_OK; } @@ -3195,34 +3320,31 @@ CheckStack(AssemblyEnv* assemEnvPtr) * * StackCheckBasicBlock -- * - * Checks stack consumption for a basic block (and recursively for - * its successors). + * 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). + * 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. + * 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 */ +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 */ @@ -3238,44 +3360,42 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, 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 (blockPtr->initialStackDepth == initialStackDepth) { + return TCL_OK; + } + 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; } /* - * 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. + * 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_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); @@ -3284,17 +3404,17 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, } /* - * Make sure that the block doesn't try to pop below the stack level - * of an enclosing catch. + * 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 (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_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); @@ -3305,47 +3425,50 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, /* * 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 + * 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); - + 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); + Tcl_GetString(blockPtr->jumpTarget)); + jumpTarget = Tcl_GetHashValue(entry); + result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr, + stackDepth); } - /* All blocks referenced in a jump table are successors */ + /* + * 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); + for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable, + &jtSearch); + result == TCL_OK && jtEntry != NULL; + jtEntry = Tcl_NextHashEntry(&jtSearch)) { + targetLabel = Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, - Tcl_GetString(targetLabel)); - jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry); + Tcl_GetString(targetLabel)); + jumpTarget = Tcl_GetHashValue(entry); result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, - blockPtr, stackDepth); + blockPtr, stackDepth); } } - + return result; } @@ -3358,62 +3481,72 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr, * 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. + * 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. + * 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 */ +StackCheckExit( + AssemblyEnv* assemEnvPtr) /* Assembly 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 + 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. + /* + * 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. */ + /* + * 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 */ + /* + * Emit a 'push' of the empty literal. + */ + litIndex = TclRegisterNewLiteral(envPtr, "", 0); - /* Assumes that 'push' is at slot 0 in TalInstructionTable */ + + /* + * Assumes that 'push' is at slot 0 in TalInstructionTable. + */ + BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); ++depth; } - /* Exit with unbalanced stack */ + /* + * 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); + resultObj = Tcl_NewStringObj( + "stack is unbalanced on exit from the code (depth=", + -1); Tcl_AppendObjToObj(resultObj, depthObj); Tcl_DecrRefCount(depthObj); Tcl_AppendToObj(resultObj, ")", -1); @@ -3423,7 +3556,9 @@ StackCheckExit(AssemblyEnv* assemEnvPtr) return TCL_ERROR; } - /* Record stack usage */ + /* + * Record stack usage. + */ envPtr->currStackDepth += depth; } @@ -3436,11 +3571,11 @@ StackCheckExit(AssemblyEnv* assemEnvPtr) * * ProcessCatches -- * - * First pass of 'catch' processing. + * First pass of 'catch' processing. * * Results: - * Returns a standard Tcl result, with an appropriate error message - * if the result is TCL_ERROR. + * 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. @@ -3449,48 +3584,53 @@ StackCheckExit(AssemblyEnv* assemEnvPtr) */ static int -ProcessCatches(AssemblyEnv* assemEnvPtr) - /* Assembler environment */ +ProcessCatches( + AssemblyEnv* assemEnvPtr) /* Assembly environment */ { BasicBlock* blockPtr; /* Pointer to a basic block */ /* - * Clear the catch state of all basic blocks + * Clear the catch state of all basic blocks. */ for (blockPtr = assemEnvPtr->head_bb; - blockPtr != NULL; - blockPtr = blockPtr->successor1) { + 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 + /* + * 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) { + NULL, BBCS_NONE, 0) != TCL_OK) { return TCL_ERROR; } - /* Check for unclosed catch on exit */ + /* + * Check for unclosed catch on exit. + */ if (CheckForUnclosedCatches(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } - /* Now there's enough information to build the exception ranges. */ + /* + * 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 */ + /* + * Finally, restore any exception ranges from embedded scripts. + */ RestoreEmbeddedExceptionRanges(assemEnvPtr); - return TCL_OK; } @@ -3506,23 +3646,19 @@ ProcessCatches(AssemblyEnv* assemEnvPtr) * 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. + * 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, +ProcessCatchesInBasicBlock( + AssemblyEnv* assemEnvPtr, /* Assembly 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 */ + int catchDepth) /* Depth of nesting of catches */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -3533,48 +3669,45 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, /* 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 */ + 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. */ + 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. + /* + * 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_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 this block has been visited before, and its state hasn't changed, + * we're done with it for now. */ if (!changed) { @@ -3583,8 +3716,8 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, 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. + * 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; @@ -3596,29 +3729,29 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, * 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.' + /* + * 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 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_SetObjResult(interp, Tcl_NewStringObj( + "endCatch without a corresponding beginCatch", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL); } @@ -3635,46 +3768,44 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, result = TCL_OK; if (bbPtr->flags & BB_FALLTHRU) { - result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1, - fallThruEnclosing, fallThruState, - catchDepth); + 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); + Tcl_GetString(bbPtr->jumpTarget)); + jumpTarget = Tcl_GetHashValue(entry); + result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, + jumpEnclosing, jumpState, catchDepth); } - - /* All blocks referenced in a jump table are successors */ + + /* + * 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); + for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch); + result == TCL_OK && jtEntry != NULL; + jtEntry = Tcl_NextHashEntry(&jtSearch)) { + targetLabel = Tcl_GetHashValue(jtEntry); entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash, - Tcl_GetString(targetLabel)); - jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry); + Tcl_GetString(targetLabel)); + jumpTarget = Tcl_GetHashValue(entry); result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget, - jumpEnclosing, jumpState, - catchDepth); + jumpEnclosing, jumpState, catchDepth); } } - + return result; } /* *----------------------------------------------------------------------------- * - * CheckForUnclosedCatches -- + * CheckForUnclosedCatches -- * - * Checks that a sequence of assembly code has no unclosed catches - * on exit. + * 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 @@ -3684,7 +3815,8 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr, */ static int -CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr) +CheckForUnclosedCatches( + AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -3693,11 +3825,10 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr) 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_SetObjResult(interp, Tcl_NewStringObj( + "catch still active on exit from assembly code", -1)); Tcl_SetErrorLine(interp, - assemEnvPtr->curr_bb->enclosingCatch->startLine); + assemEnvPtr->curr_bb->enclosingCatch->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL); } return TCL_ERROR; @@ -3710,18 +3841,18 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr) * * BuildExceptionRanges -- * - * Walks through the assembly code and builds exception ranges for - * the catches embedded therein. + * 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. + * 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. * @@ -3729,31 +3860,34 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr) */ static int -BuildExceptionRanges(AssemblyEnv* assemEnvPtr) - /* Assembler environment */ +BuildExceptionRanges( + AssemblyEnv* assemEnvPtr) /* Assembly 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 */ + 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) { + + 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 */ + /* + * Allocate memory for a stack of active catches. + */ catches = (BasicBlock**) ckalloc(maxCatchDepth * sizeof(BasicBlock*)); catchIndices = (int*) ckalloc(maxCatchDepth * sizeof(int)); @@ -3762,23 +3896,25 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr) catchIndices[i] = -1; } - /* Walk through the basic blocks and manage exception ranges. */ - - for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) { + /* + * Walk through the basic blocks and manage exception ranges. + */ - UnstackExpiredCatches(envPtr, bbPtr, catchDepth, - catches, catchIndices); + 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); + StackFreshCatches(assemEnvPtr, bbPtr, catchDepth, catches, + catchIndices); - /* If the last block was a 'begin catch', fill in the exception range */ + /* + * If the last block was a 'begin catch', fill in the exception range. + */ catchDepth = bbPtr->catchDepth; - if (prevPtr != NULL - && (prevPtr->flags & BB_BEGINCATCH)) { + if (prevPtr != NULL && (prevPtr->flags & BB_BEGINCATCH)) { TclStoreInt4AtPtr(catchIndices[catchDepth-1], - envPtr->codeStart + bbPtr->startOffset - 4); + envPtr->codeStart + bbPtr->startOffset - 4); } prevPtr = bbPtr; @@ -3786,7 +3922,7 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr) if (catchDepth != 0) { Tcl_Panic("unclosed catch at end of code in " - "tclAssembly.c:BuildExceptionRanges, can't happen"); + "tclAssembly.c:BuildExceptionRanges, can't happen"); } return TCL_OK; @@ -3805,32 +3941,27 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr) */ 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 +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") */ + /* 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. + /* + * 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]; @@ -3839,19 +3970,18 @@ UnstackExpiredCatches(CompileEnv* envPtr, 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. + * 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) { + if (catches[catchDepth] != catch || catchState >= BBCS_CAUGHT) { range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->numCodeBytes = bbPtr->startOffset - range->codeOffset; catches[catchDepth] = NULL; @@ -3879,15 +4009,14 @@ UnstackExpiredCatches(CompileEnv* envPtr, */ static void -LookForFreshCatches(BasicBlock* bbPtr, - /* Basic block being entered */ - BasicBlock** catches) - /* Array of catch contexts that are - * already entered */ +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. */ + /* State ("in catch" or "caught") of the + * current catch. */ BasicBlock* catch; /* Current enclosing catch */ int catchDepth; /* Nesting depth of the current catch */ @@ -3905,27 +4034,24 @@ LookForFreshCatches(BasicBlock* bbPtr, } /* - *-----------------------------------------------------------------------------\ * + *----------------------------------------------------------------------------- + * * StackFreshCatches -- * - * Make ExceptionRange records for any catches that are in the - * basic block being entered and were not in the previous basic block. + * 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 +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; @@ -3943,29 +4069,29 @@ StackFreshCatches(AssemblyEnv* assemEnvPtr, */ for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) { - if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) { - - /* Create an exception range for a block that needs one. */ + 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); + TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->nestingLevel = envPtr->exceptDepth + catchDepth; envPtr->maxExceptDepth = - TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth); + TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth); range->codeOffset = bbPtr->startOffset; - - if ((entryPtr = - Tcl_FindHashEntry(&assemEnvPtr->labelHash, - Tcl_GetString(catch->jumpTarget))) - == NULL) { + + entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, + Tcl_GetString(catch->jumpTarget)); + if (entryPtr == NULL) { Tcl_Panic("undefined label in tclAssembly.c:" - "BuildExceptionRanges, can't happen"); - } else { - errorExit = (BasicBlock*) Tcl_GetHashValue(entryPtr); - range->catchOffset = errorExit->startOffset; + "BuildExceptionRanges, can't happen"); } + + errorExit = Tcl_GetHashValue(entryPtr); + range->catchOffset = errorExit->startOffset; } } } @@ -3982,39 +4108,41 @@ StackFreshCatches(AssemblyEnv* assemEnvPtr, */ static void -RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr) - /* Assembler environment */ +RestoreEmbeddedExceptionRanges( + AssemblyEnv* assemEnvPtr) /* Assembly 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 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 */ + 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 */ + 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 */ + /* + * Walk the basic blocks looking for exceptions in embedded scripts. + */ for (bbPtr = assemEnvPtr->head_bb; - bbPtr != NULL; - bbPtr = bbPtr->successor1) { + bbPtr != NULL; + bbPtr = bbPtr->successor1) { if (bbPtr->foreignExceptionCount != 0) { - /* - * Reinstall the embedded exceptions and track their - * nesting level + /* + * 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)); + sizeof(ExceptionRange)); if (range->nestingLevel >= envPtr->maxExceptDepth) { envPtr->maxExceptDepth = range->nestingLevel + 1; } @@ -4024,25 +4152,24 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr) * 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 + + bbPtr->foreignExceptionCount)) { catchIndex -= bbPtr->foreignExceptionBase; catchIndex += rangeBase; - TclStoreInt4AtPtr(catchIndex, - envPtr->codeStart + i + 1); + TclStoreInt4AtPtr(catchIndex, envPtr->codeStart+i+1); } } i += tclInstructionTable[opcode].numBytes; } } } - } /* @@ -4057,11 +4184,13 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr) */ static void -ResetVisitedBasicBlocks(AssemblyEnv* assemEnvPtr) +ResetVisitedBasicBlocks( + AssemblyEnv* assemEnvPtr) /* Assembly environment */ { BasicBlock* block; - for (block = assemEnvPtr->head_bb; block != NULL; - block = block->successor1) { + + for (block = assemEnvPtr->head_bb; block != NULL; + block = block->successor1) { block->flags &= ~BB_VISITED; } } @@ -4071,8 +4200,8 @@ ResetVisitedBasicBlocks(AssemblyEnv* assemEnvPtr) * * AddBasicBlockRangeToErrorInfo -- * - * Updates the error info of the Tcl interpreter to show a given - * basic block in the code. + * 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. @@ -4081,11 +4210,9 @@ ResetVisitedBasicBlocks(AssemblyEnv* assemEnvPtr) */ static void -AddBasicBlockRangeToErrorInfo(AssemblyEnv* assemEnvPtr, - /* Assembly environment */ - BasicBlock* bbPtr) - /* Basic block in which the error is - * found */ +AddBasicBlockRangeToErrorInfo( + AssemblyEnv* assemEnvPtr, /* Assembly environment */ + BasicBlock* bbPtr) /* Basic block in which the error is found */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -4133,7 +4260,7 @@ AddBasicBlockRangeToErrorInfo(AssemblyEnv* assemEnvPtr, * *----------------------------------------------------------------------------- */ - + static void DupAssembleCodeInternalRep( Tcl_Obj *srcPtr, @@ -4164,7 +4291,7 @@ static void FreeAssembleCodeInternalRep( Tcl_Obj *objPtr) { - ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + ByteCode *codePtr = objPtr->internalRep.otherValuePtr; codePtr->refCount--; if (codePtr->refCount <= 0) { @@ -4173,4 +4300,11 @@ FreeAssembleCodeInternalRep( objPtr->typePtr = NULL; objPtr->internalRep.otherValuePtr = NULL; } - + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/tests/assemble.test b/tests/assemble.test index b9178ec..761b36b 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -5,23 +5,21 @@ # 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 $ +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. #----------------------------------------------------------------------------- # Commands covered: assemble -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { 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. +# Procedure to make code that fills the literal and local variable tables, to +# force instructions to spill to four bytes. proc fillTables {} { set s {} @@ -32,7 +30,7 @@ proc fillTables {} { } return $s } - + # assemble-1 - TclNRAssembleObjCmd test assemble-1.1 {wrong # args, direct eval} { @@ -43,7 +41,6 @@ test assemble-1.1 {wrong # args, direct eval} { -result {wrong # args*} -match glob } - test assemble-1.2 {wrong # args, direct eval} { -body { eval [list assemble too many] @@ -52,7 +49,6 @@ test assemble-1.2 {wrong # args, direct eval} { -result {wrong # args*} -match glob } - test assemble-1.3 {error reporting, direct eval} { -body { list [catch { @@ -69,7 +65,6 @@ test assemble-1.3 {error reporting, direct eval} { ("assemble" body, line 3)*}} -cleanup {unset result} } - test assemble-1.4 {simple direct eval} { -body { eval [list assemble {push {this is a test}}] @@ -87,7 +82,6 @@ test assemble-2.1 {bytecode reuse, direct eval} { } -result {{this is a test} {this is a test}} } - test assemble-2.2 {bytecode discard, direct eval} { -body { set x {load value} @@ -109,7 +103,6 @@ test assemble-2.2 {bytecode discard, direct eval} { rename p2 {} } } - test assemble-2.3 {null script, direct eval} { -body { set x {} @@ -132,7 +125,6 @@ test assemble-3.1 {wrong # args, compiled path} { -match glob -result {wrong # args:*} } - test assemble-3.2 {wrong # args, compiled path} { -body { proc x {} { @@ -170,7 +162,6 @@ test assemble-4.1 {syntax error} { " ("assemble" body, line 2)*}} } - test assemble-4.2 {null command} { -body { proc x {} { @@ -203,7 +194,6 @@ test assemble-5.1 {unsupported expansion} { unset result } } - test assemble-5.2 {unsupported substitution} { -body { proc x {y} { @@ -219,7 +209,6 @@ test assemble-5.2 {unsupported substitution} { } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} } - test assemble-5.3 {unsupported substitution} { -body { proc x {} { @@ -231,7 +220,6 @@ test assemble-5.3 {unsupported substitution} { } -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} } - test assemble-5.4 {backslash substitution} { -body { proc x {} { @@ -258,7 +246,6 @@ test assemble-6.1 {push, wrong # args} { -match glob -result {wrong # args*} } - test assemble-6.2 {push, wrong # args} { -body { assemble {push too many} @@ -267,22 +254,19 @@ test assemble-6.2 {push, wrong # args} { -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 + x } -cleanup { rename x {} @@ -300,7 +284,6 @@ test assemble-7.1 {add, wrong # args} { -match glob -result {wrong # args*} } - test assemble-7.2 {add} { -body { assemble { @@ -311,7 +294,6 @@ test assemble-7.2 {add} { } -result {4} } - test assemble-7.3 {appendArrayStk} { -body { set a(b) {hello, } @@ -326,7 +308,6 @@ test assemble-7.3 {appendArrayStk} { -result {hello, world} -cleanup {unset a} } - test assemble-7.4 {appendStk} { -body { set a {hello, } @@ -340,7 +321,6 @@ test assemble-7.4 {appendStk} { -result {hello, world} -cleanup {unset a} } - test assemble-7.5 {bitwise ops} { -body { list \ @@ -351,14 +331,12 @@ test assemble-7.5 {bitwise ops} { } -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 { @@ -367,7 +345,6 @@ test assemble-7.7 {dup} { } -result 9 } - test assemble-7.8 {eq} { -body { list \ @@ -376,8 +353,6 @@ test assemble-7.8 {eq} { } -result {0 1} } - - test assemble-7.9 {evalStk} { -body { assemble { @@ -387,7 +362,6 @@ test assemble-7.9 {evalStk} { } -result {test 7.3} } - test assemble-7.9a {evalStk, syntax} { -body { assemble { @@ -398,7 +372,6 @@ test assemble-7.9a {evalStk, syntax} { -returnCodes error -result {extra characters after close-brace} } - test assemble-7.9b {evalStk, backtrace} { -body { proc y {z} { @@ -427,7 +400,6 @@ test assemble-7.9b {evalStk, backtrace} { rename x {} } } - test assemble-7.10 {existArrayStk} { -body { proc x {name key} { @@ -441,7 +413,6 @@ test assemble-7.10 {existArrayStk} { -result {0 1 0 0} -cleanup {rename x {}} } - test assemble-7.11 {existStk} { -body { proc x {name} { @@ -455,14 +426,12 @@ test assemble-7.11 {existStk} { -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 { @@ -472,7 +441,6 @@ test assemble-7.13 {exprStk} { } -result 3.141592653589793 } - test assemble-7.13a {exprStk, syntax} { -body { assemble { @@ -484,7 +452,6 @@ test assemble-7.13a {exprStk, syntax} { -result {missing operand at _@_ in expression "2+_@_"} } - test assemble-7.13b {exprStk, backtrace} { -body { proc y {z} { @@ -510,7 +477,6 @@ test assemble-7.13b {exprStk, backtrace} { rename x {} } } - test assemble-7.14 {ge gt le lt} { -body { proc x {a b} { @@ -524,7 +490,6 @@ test assemble-7.14 {ge gt le lt} { -result {{1 0 1 0} {0 0 1 1} {1 1 0 0}} -cleanup {rename x {}} } - test assemble-7.15 {incrArrayStk} { -body { proc x {} { @@ -538,7 +503,6 @@ test assemble-7.15 {incrArrayStk} { -result 12 -cleanup {rename x {}} } - test assemble-7.16 {incrStk} { -body { proc x {} { @@ -552,7 +516,6 @@ test assemble-7.16 {incrStk} { -result 12 -cleanup {rename x {}} } - test assemble-7.17 {land/lor} { -body { proc x {a b} { @@ -565,7 +528,6 @@ test assemble-7.17 {land/lor} { -result {{0 0} {0 1} {0 1} {1 1}} -cleanup {rename x {}} } - test assemble-7.18 {lappendArrayStk} { -body { proc x {} { @@ -582,7 +544,6 @@ test assemble-7.18 {lappendArrayStk} { -result {charlie dog} -cleanup {rename x {}} } - test assemble-7.19 {lappendStk} { -body { proc x {} { @@ -598,7 +559,6 @@ test assemble-7.19 {lappendStk} { -result {baker charlie} -cleanup {rename x {}} } - test assemble-7.20 {listIndex} { -body { assemble { @@ -609,7 +569,6 @@ test assemble-7.20 {listIndex} { } -result c } - test assemble-7.21 {listLength} { -body { assemble { @@ -619,7 +578,6 @@ test assemble-7.21 {listLength} { } -result 4 } - test assemble-7.22 {loadArrayStk} { -body { proc x {} { @@ -635,7 +593,6 @@ test assemble-7.22 {loadArrayStk} { -result charlie -cleanup {rename x {}} } - test assemble-7.23 {loadStk} { -body { proc x {} { @@ -650,7 +607,6 @@ test assemble-7.23 {loadStk} { -result baker -cleanup {rename x {}} } - test assemble-7.24 {lsetList} { -body { proc x {} { @@ -663,28 +619,24 @@ test assemble-7.24 {lsetList} { } -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 \ @@ -693,7 +645,6 @@ test assemble-7.28 {neq} { } -result {1 0} } - test assemble-7.29 {not} { -body { list \ @@ -702,21 +653,18 @@ test assemble-7.29 {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 {} { @@ -730,7 +678,6 @@ test assemble-7.32 {storeArrayStk} { -result {baker charlie} -cleanup {rename x {}} } - test assemble-7.33 {storeStk} { -body { proc x {} { @@ -744,7 +691,6 @@ test assemble-7.33 {storeStk} { -result {baker} -cleanup {rename x {}} } - test assemble-7,34 {strcmp} { -body { proc x {a b} { @@ -757,7 +703,6 @@ test assemble-7,34 {strcmp} { -result {-1 1 0} -cleanup {rename x {}} } - test assemble-7.35 {streq/strneq} { -body { proc x {a b} { @@ -770,28 +715,24 @@ test assemble-7.35 {streq/strneq} { -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 { @@ -800,7 +741,7 @@ test assemble-7.39 {tryCvtToNumeric} { } -result 42 } - +# assemble-7.40 absent test assemble-7.41 {uminus} { -body { assemble { @@ -809,7 +750,6 @@ test assemble-7.41 {uminus} { } -result -42 } - test assemble-7.42 {uplus} { -body { assemble { @@ -827,7 +767,6 @@ test assemble-7.43 {uplus} { -returnCodes error -result {can't use non-numeric floating-point value as operand of "+"} } - test assemble-7.43 {tryCvtToNumeric} { -body { assemble { @@ -837,7 +776,6 @@ test assemble-7.43 {tryCvtToNumeric} { -returnCodes error -result {domain error: argument not in valid range} } - test assemble-7.44 {listIn} { -body { assemble { @@ -846,7 +784,6 @@ test assemble-7.44 {listIn} { } -result 1 } - test assemble-7.45 {listNotIn} { -body { assemble { @@ -855,7 +792,6 @@ test assemble-7.45 {listNotIn} { } -result 1 } - test assemble-7.46 {nop} { -body { assemble { push x; nop; nop; nop} @@ -873,7 +809,6 @@ test assemble-8.1 {load, wrong # args} { -match glob -result {wrong # args*} } - test assemble-8.2 {load, wrong # args} { -body { assemble {load too many} @@ -882,7 +817,6 @@ test assemble-8.2 {load, wrong # args} { -match glob -result {wrong # args*} } - test assemble-8.3 {nonlocal var} { -body { list [catch {assemble {load ::env}} result] $result $errorCode @@ -890,7 +824,6 @@ test assemble-8.3 {nonlocal var} { -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}} -cleanup {unset result} } - test assemble-8.4 {bad context} { -body { set x 1 @@ -899,7 +832,6 @@ test assemble-8.4 {bad context} { -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 { @@ -910,7 +842,6 @@ test assemble-8.5 {bad context} { -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} { @@ -923,7 +854,6 @@ test assemble-8.6 {load1} { -result able -cleanup {rename x {}} } - test assemble-8.7 {load4} { -body { proc x {a} " @@ -936,7 +866,6 @@ test assemble-8.7 {load4} { -result able -cleanup {rename x {}} } - test assemble-8.8 {loadArray1} { -body { proc x {} { @@ -951,7 +880,6 @@ test assemble-8.8 {loadArray1} { -result charlie -cleanup {rename x {}} } - test assemble-8.9 {loadArray4} { -body " proc x {} { @@ -967,7 +895,6 @@ test assemble-8.9 {loadArray4} { -result charlie -cleanup {rename x {}} } - test assemble-8.10 {append1} { -body { proc x {} { @@ -981,7 +908,6 @@ test assemble-8.10 {append1} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.11 {append4} { -body { proc x {} " @@ -996,7 +922,6 @@ test assemble-8.11 {append4} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.12 {appendArray1} { -body { proc x {} { @@ -1010,7 +935,6 @@ test assemble-8.12 {appendArray1} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.13 {appendArray4} { -body { proc x {} " @@ -1025,7 +949,6 @@ test assemble-8.13 {appendArray4} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.14 {lappend1} { -body { proc x {} { @@ -1039,7 +962,6 @@ test assemble-8.14 {lappend1} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.15 {lappend4} { -body { proc x {} " @@ -1054,7 +976,6 @@ test assemble-8.15 {lappend4} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.16 {lappendArray1} { -body { proc x {} { @@ -1068,7 +989,6 @@ test assemble-8.16 {lappendArray1} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.17 {lappendArray4} { -body { proc x {} " @@ -1083,7 +1003,6 @@ test assemble-8.17 {lappendArray4} { -result {hello, world} -cleanup {rename x {}} } - test assemble-8.18 {store1} { -body { proc x {} { @@ -1097,7 +1016,6 @@ test assemble-8.18 {store1} { -result {test} -cleanup {rename x {}} } - test assemble-8.19 {store4} { -body { proc x {} " @@ -1112,7 +1030,6 @@ test assemble-8.19 {store4} { -result test -cleanup {rename x {}} } - test assemble-8.20 {storeArray1} { -body { proc x {} { @@ -1126,7 +1043,6 @@ test assemble-8.20 {storeArray1} { -result test -cleanup {rename x {}} } - test assemble-8.21 {storeArray4} { -body { proc x {} " @@ -1149,14 +1065,12 @@ test assemble-9.1 {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"} @@ -1196,7 +1110,6 @@ test assemble-10.1 {eval - wrong # args} { -match glob -result {wrong # args*} } - test assemble-10.2 {eval - wrong # args} { -body { assemble {eval too many} @@ -1205,7 +1118,6 @@ test assemble-10.2 {eval - wrong # args} { -match glob -result {wrong # args*} } - test assemble-10.3 {eval} { -body { proc x {} { @@ -1223,7 +1135,6 @@ test assemble-10.3 {eval} { -result 11 -cleanup {rename x {}} } - test assemble-10.4 {expr} { -body { proc x {} { @@ -1241,7 +1152,6 @@ test assemble-10.4 {expr} { -result 11 -cleanup {rename x {}} } - test assemble-10.5 {eval and expr - nonsimple} { -body { proc x {} { @@ -1260,14 +1170,12 @@ test assemble-10.5 {eval and expr - nonsimple} { 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 @@ -1286,7 +1194,6 @@ test assemble-11.1 {exist - wrong # args} { -match glob -result {wrong # args*} } - test assemble-11.2 {exist - wrong # args} { -body { assemble {exist too many} @@ -1295,7 +1202,6 @@ test assemble-11.2 {exist - wrong # args} { -match glob -result {wrong # args*} } - test assemble-11.3 {nonlocal var} { -body { list [catch {assemble {exist ::env}} result] $result $errorCode @@ -1303,7 +1209,6 @@ test assemble-11.3 {nonlocal var} { -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}} -cleanup {unset result} } - test assemble-11.4 {exist} { -body { proc x {} { @@ -1316,7 +1221,6 @@ test assemble-11.4 {exist} { -result {1 0} -cleanup {rename x {}} } - test assemble-11.5 {existArray} { -body { proc x {} { @@ -1330,7 +1234,6 @@ test assemble-11.5 {existArray} { -result {1 0 0} -cleanup {rename x {}} } - test assemble-11.6 {dictAppend} { -body { proc x {} { @@ -1342,7 +1245,6 @@ test assemble-11.6 {dictAppend} { -result {a 1 b 222 c 3} -cleanup {rename x {}} } - test assemble-11.7 {dictLappend} { -body { proc x {} { @@ -1354,7 +1256,6 @@ test assemble-11.7 {dictLappend} { -result {a 1 b {2 2} c 3} -cleanup {rename x {}} } - test assemble-11.8 {upvar} { -body { proc x {v} { @@ -1369,7 +1270,6 @@ test assemble-11.8 {upvar} { -result 123 -cleanup {rename x {}; rename y {}} } - test assemble-11.9 {nsupvar} { -body { namespace eval q { variable v 123 } @@ -1381,7 +1281,6 @@ test assemble-11.9 {nsupvar} { -result 123 -cleanup {namespace delete q; rename x {}} } - test assemble-11.10 {variable} { -body { namespace eval q { namespace eval r {variable v 123}} @@ -1404,7 +1303,6 @@ test assemble-12.1 {incr - wrong # args} { -match glob -result {wrong # args*} } - test assemble-12.2 {incr - wrong # args} { -body { assemble {incr too many} @@ -1413,7 +1311,6 @@ test assemble-12.2 {incr - wrong # args} { -match glob -result {wrong # args*} } - test assemble-12.3 {incr nonlocal var} { -body { list [catch {assemble {incr ::env}} result] $result $errorCode @@ -1421,7 +1318,6 @@ test assemble-12.3 {incr nonlocal var} { -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}} -cleanup {unset result} } - test assemble-12.4 {incr} { -body { proc x {} { @@ -1433,7 +1329,6 @@ test assemble-12.4 {incr} { -result 8 -cleanup {rename x {}} } - test assemble-12.5 {incrArray} { -body { proc x {} { @@ -1445,7 +1340,6 @@ test assemble-12.5 {incrArray} { -result 8 -cleanup {rename x {}} } - test assemble-12.6 {incr, stupid stack restriction} { -body { proc x {} " @@ -1469,7 +1363,6 @@ test assemble-13.1 {incrImm - wrong # args} { -match glob -result {wrong # args*} } - test assemble-13.2 {incrImm - wrong # args} { -body { assemble {incrImm too many args} @@ -1478,7 +1371,6 @@ test assemble-13.2 {incrImm - wrong # args} { -match glob -result {wrong # args*} } - test assemble-13.3 {incrImm nonlocal var} { -body { list [catch {assemble {incrImm ::env 2}} result] $result $errorCode @@ -1486,7 +1378,6 @@ test assemble-13.3 {incrImm nonlocal var} { -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 {} { @@ -1498,7 +1389,6 @@ test assemble-13.4 {incrImm not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-13.5 {incrImm too big} { -body { proc x {} { @@ -1509,7 +1399,6 @@ test assemble-13.5 {incrImm too big} { -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 {} { @@ -1520,7 +1409,6 @@ test assemble-13.6 {incrImm too small} { -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 {} { @@ -1532,7 +1420,6 @@ test assemble-13.7 {incrImm} { -result {-127 0} -cleanup {rename x {}} } - test assemble-13.8 {incrArrayImm} { -body { proc x {} { @@ -1544,7 +1431,6 @@ test assemble-13.8 {incrArrayImm} { -result 8 -cleanup {rename x {}} } - test assemble-13.9 {incrImm, stupid stack restriction} { -body { proc x {} " @@ -1568,7 +1454,6 @@ test assemble-14.1 {incrStkImm - wrong # args} { -match glob -result {wrong # args*} } - test assemble-14.2 {incrStkImm - wrong # args} { -body { assemble {incrStkImm too many} @@ -1577,7 +1462,6 @@ test assemble-14.2 {incrStkImm - wrong # args} { -match glob -result {wrong # args*} } - test assemble-14.3 {incrStkImm not a number} { -body { proc x {} { @@ -1589,7 +1473,6 @@ test assemble-14.3 {incrStkImm not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-14.4 {incrStkImm too big} { -body { proc x {} { @@ -1600,7 +1483,6 @@ test assemble-14.4 {incrStkImm too big} { -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 {} { @@ -1611,7 +1493,6 @@ test assemble-14.5 {incrStkImm too small} { -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 {} { @@ -1624,7 +1505,6 @@ test assemble-14.6 {incrStkImm} { -result {-127 0} -cleanup {rename x {}} } - test assemble-14.7 {incrArrayStkImm} { -body { proc x {} { @@ -1647,8 +1527,7 @@ test assemble-15.1 {listIndexImm - wrong # args} { -match glob -result {wrong # args*} } - -test assemble-16.2 {listIndexImm - wrong # args} { +test assemble-15.2 {listIndexImm - wrong # args} { -body { assemble {listIndexImm too many} } @@ -1656,16 +1535,14 @@ test assemble-16.2 {listIndexImm - wrong # args} { -match glob -result {wrong # args*} } - -test assemble-16.3 {listIndexImm - bad substitution} { +test assemble-15.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} { +test assemble-15.4 {listIndexImm - invalid index} { -body { assemble {listIndexImm rubbish} } @@ -1673,22 +1550,19 @@ test assemble-16.4 {listIndexImm - invalid index} { -match glob -result {bad index "rubbish"*} } - -test assemble-16.5 {listIndexImm} { +test assemble-15.5 {listIndexImm} { -body { assemble {push {a b c}; listIndexImm 2} } -result c } - -test assemble-16.6 {listIndexImm} { +test assemble-15.6 {listIndexImm} { -body { assemble {push {a b c}; listIndexImm end-1} } -result b } - -test assemble-16.6 {listIndexImm} { +test assemble-15.6 {listIndexImm} { -body { assemble {push {a b c}; listIndexImm end} } @@ -1705,7 +1579,6 @@ test assemble-16.1 {invokeStk - wrong # args} { -match glob -result {wrong # args*} } - test assemble-16.2 {invokeStk - wrong # args} { -body { assemble {invokeStk too many} @@ -1714,7 +1587,6 @@ test assemble-16.2 {invokeStk - wrong # args} { -match glob -result {wrong # args*} } - test assemble-16.3 {invokeStk - not a number} { -body { proc x {} { @@ -1726,7 +1598,6 @@ test assemble-16.3 {invokeStk - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-16.4 {invokeStk - no operands} { -body { proc x {} { @@ -1737,14 +1608,12 @@ test assemble-16.4 {invokeStk - no operands} { -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} { @@ -1774,7 +1643,6 @@ test assemble-17.1 {label, wrong # args} { -match glob -result {wrong # args*} } - test assemble-17.2 {label, wrong # args} { -body { assemble {label too many} @@ -1783,7 +1651,6 @@ test assemble-17.2 {label, wrong # args} { -match glob -result {wrong # args*} } - test assemble-17.3 {label, bad subst} { -body { list [catch {assemble {label $foo}} result] $result $::errorCode @@ -1791,7 +1658,6 @@ test assemble-17.3 {label, bad subst} { -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] \ @@ -1799,7 +1665,6 @@ test assemble-17.4 {duplicate label} { } -result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}} } - test assemble-17.5 {jump, wrong # args} { -body { assemble {jump} @@ -1808,7 +1673,6 @@ test assemble-17.5 {jump, wrong # args} { -match glob -result {wrong # args*} } - test assemble-17.6 {jump, wrong # args} { -body { assemble {jump too many} @@ -1817,7 +1681,6 @@ test assemble-17.6 {jump, wrong # args} { -match glob -result {wrong # args*} } - test assemble-17.7 {jump, bad subst} { -body { list [catch {assemble {jump $foo}} result] $result $::errorCode @@ -1825,7 +1688,6 @@ test assemble-17.7 {jump, bad subst} { -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}} -cleanup {unset result} } - test assemble-17.8 {jump - ahead and back} { -body { assemble { @@ -1858,7 +1720,6 @@ test assemble-17.8 {jump - ahead and back} { } -result ceadbf } - test assemble-17.9 {jump - resolve a label multiple times} { -body { proc x {} { @@ -1926,7 +1787,6 @@ test assemble-17.9 {jump - resolve a label multiple times} { -result abcd -cleanup {rename x {}} } - test assemble-17.10 {jump4 needed} { -body { assemble "push x; jump one; label two; [string repeat {dup; pop;} 128] @@ -1934,7 +1794,6 @@ test assemble-17.10 {jump4 needed} { } -result x } - test assemble-17.11 {jumpTrue} { -body { proc x {y} { @@ -1953,7 +1812,6 @@ test assemble-17.11 {jumpTrue} { -result {no yes} -cleanup {rename x {}} } - test assemble-17.12 {jumpFalse} { -body { proc x {y} { @@ -1972,14 +1830,12 @@ test assemble-17.12 {jumpFalse} { -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 @@ -1994,7 +1850,6 @@ test assemble-17.14 {jump to undefined label, line number correct?} { -match glob -result {*"assemble" body, line 4*} } - test assemble-17.15 {multiple passes of code resizing} { -setup { set body { @@ -2037,7 +1892,6 @@ test assemble-18.1 {lindexMulti - wrong # args} { -match glob -result {wrong # args*} } - test assemble-18.2 {lindexMulti - wrong # args} { -body { assemble {lindexMulti too many} @@ -2046,7 +1900,6 @@ test assemble-18.2 {lindexMulti - wrong # args} { -match glob -result {wrong # args*} } - test assemble-18.3 {lindexMulti - bad subst} { -body { assemble {lindexMulti $foo} @@ -2055,7 +1908,6 @@ test assemble-18.3 {lindexMulti - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-18.4 {lindexMulti - not a number} { -body { proc x {} { @@ -2067,7 +1919,6 @@ test assemble-18.4 {lindexMulti - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-18.5 {lindexMulti - bad operand count} { -body { proc x {} { @@ -2078,21 +1929,18 @@ test assemble-18.5 {lindexMulti - bad operand count} { -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} @@ -2110,7 +1958,6 @@ test assemble-19.1 {list - wrong # args} { -match glob -result {wrong # args*} } - test assemble-19.2 {list - wrong # args} { -body { assemble {list too many} @@ -2119,7 +1966,6 @@ test assemble-19.2 {list - wrong # args} { -match glob -result {wrong # args*} } - test assemble-19.3 {list - bad subst} { -body { assemble {list $foo} @@ -2128,7 +1974,6 @@ test assemble-19.3 {list - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-19.4 {list - not a number} { -body { proc x {} { @@ -2140,7 +1985,6 @@ test assemble-19.4 {list - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-19.5 {list - negative operand count} { -body { proc x {} { @@ -2151,21 +1995,18 @@ test assemble-19.5 {list - negative operand count} { -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} @@ -2183,7 +2024,6 @@ test assemble-20.1 {lsetFlat - wrong # args} { -match glob -result {wrong # args*} } - test assemble-20.2 {lsetFlat - wrong # args} { -body { assemble {lsetFlat too many} @@ -2192,7 +2032,6 @@ test assemble-20.2 {lsetFlat - wrong # args} { -match glob -result {wrong # args*} } - test assemble-20.3 {lsetFlat - bad subst} { -body { assemble {lsetFlat $foo} @@ -2201,7 +2040,6 @@ test assemble-20.3 {lsetFlat - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-20.4 {lsetFlat - not a number} { -body { proc x {} { @@ -2213,7 +2051,6 @@ test assemble-20.4 {lsetFlat - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-20.5 {lsetFlat - negative operand count} { -body { proc x {} { @@ -2224,14 +2061,12 @@ test assemble-20.5 {lsetFlat - negative operand count} { -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} @@ -2249,7 +2084,6 @@ test assemble-21.1 {over - wrong # args} { -match glob -result {wrong # args*} } - test assemble-21.2 {over - wrong # args} { -body { assemble {over too many} @@ -2258,7 +2092,6 @@ test assemble-21.2 {over - wrong # args} { -match glob -result {wrong # args*} } - test assemble-21.3 {over - bad subst} { -body { assemble {over $foo} @@ -2267,7 +2100,6 @@ test assemble-21.3 {over - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-21.4 {over - not a number} { -body { proc x {} { @@ -2279,7 +2111,6 @@ test assemble-21.4 {over - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-21.5 {over - negative operand count} { -body { proc x {} { @@ -2290,7 +2121,6 @@ test assemble-21.5 {over - negative operand count} { -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}} -cleanup {rename x {}; unset result} } - test assemble-21.6 {over} { -body { proc x {} { @@ -2312,7 +2142,6 @@ test assemble-21.6 {over} { -result 3 -cleanup {rename x {}} } - test assemble-21.7 {over} { -body { proc x {} { @@ -2345,7 +2174,6 @@ test assemble-22.1 {reverse - wrong # args} { -match glob -result {wrong # args*} } - test assemble-22.2 {reverse - wrong # args} { -body { assemble {reverse too many} @@ -2375,7 +2203,6 @@ test assemble-22.4 {reverse - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-22.5 {reverse - negative operand count} { -body { proc x {} { @@ -2386,7 +2213,6 @@ test assemble-22.5 {reverse - negative operand count} { -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 {} { @@ -2397,7 +2223,6 @@ test assemble-22.6 {reverse - zero operand count} { -result 1 -cleanup {rename x {}} } - test assemble-22.7 {reverse} { -body { proc x {} { @@ -2418,7 +2243,6 @@ test assemble-22.7 {reverse} { -result 3 -cleanup {rename x {}} } - test assemble-22.8 {reverse} { -body { proc x {} { @@ -2450,7 +2274,6 @@ test assemble-23.1 {strmatch - wrong # args} { -match glob -result {wrong # args*} } - test assemble-23.2 {strmatch - wrong # args} { -body { assemble {strmatch too many} @@ -2459,7 +2282,6 @@ test assemble-23.2 {strmatch - wrong # args} { -match glob -result {wrong # args*} } - test assemble-23.3 {strmatch - bad subst} { -body { assemble {strmatch $foo} @@ -2468,7 +2290,6 @@ test assemble-23.3 {strmatch - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-23.4 {strmatch - not a boolean} { -body { proc x {} { @@ -2480,7 +2301,6 @@ test assemble-23.4 {strmatch - not a boolean} { -result {expected boolean value but got "rubbish"} -cleanup {rename x {}} } - test assemble-23.5 {strmatch} { -body { proc x {a b} { @@ -2492,7 +2312,6 @@ test assemble-23.5 {strmatch} { -result {{0 0} {1 1} {0 1}} -cleanup {rename x {}} } - test assemble-23.6 {unsetStk} { -body { proc x {} { @@ -2505,7 +2324,6 @@ test assemble-23.6 {unsetStk} { -result 0 -cleanup {rename x {}} } - test assemble-23.7 {unsetStk} { -body { proc x {} { @@ -2529,7 +2347,6 @@ test assemble-23.8 {unsetStk} { -result {can't unset "a": no such variable} -cleanup {rename x {}} } - test assemble-23.9 {unsetArrayStk} { -body { proc x {} { @@ -2542,7 +2359,6 @@ test assemble-23.9 {unsetArrayStk} { -result 0 -cleanup {rename x {}} } - test assemble-23.10 {unsetArrayStk} { -body { proc x {} { @@ -2577,7 +2393,6 @@ test assemble-24.1 {unset - wrong # args} { -match glob -result {wrong # args*} } - test assemble-24.2 {unset - wrong # args} { -body { assemble {unset too many args} @@ -2586,7 +2401,6 @@ test assemble-24.2 {unset - wrong # args} { -match glob -result {wrong # args*} } - test assemble-24.3 {unset - bad subst -arg 1} { -body { assemble {unset $foo bar} @@ -2595,7 +2409,6 @@ test assemble-24.3 {unset - bad subst -arg 1} { -match glob -result {assembly code may not contain substitutions} } - test assemble-24.4 {unset - not a boolean} { -body { proc x {} { @@ -2607,7 +2420,6 @@ test assemble-24.4 {unset - not a boolean} { -result {expected boolean value but got "rubbish"} -cleanup {rename x {}} } - test assemble-24.5 {unset - bad subst - arg 2} { -body { assemble {unset true $bar} @@ -2615,7 +2427,6 @@ test assemble-24.5 {unset - bad subst - arg 2} { -returnCodes error -result {assembly code may not contain substitutions} } - test assemble-24.6 {unset - nonlocal var} { -body { assemble {unset true ::foo::bar} @@ -2623,7 +2434,6 @@ test assemble-24.6 {unset - nonlocal var} { -returnCodes error -result {variable "::foo::bar" is not local} } - test assemble-24.7 {unset} { -body { proc x {} { @@ -2636,7 +2446,6 @@ test assemble-24.7 {unset} { -result 0 -cleanup {rename x {}} } - test assemble-24.8 {unset} { -body { proc x {} { @@ -2660,7 +2469,6 @@ test assemble-24.9 {unset} { -result {can't unset "a": no such variable} -cleanup {rename x {}} } - test assemble-24.10 {unsetArray} { -body { proc x {} { @@ -2673,7 +2481,6 @@ test assemble-24.10 {unsetArray} { -result 0 -cleanup {rename x {}} } - test assemble-24.11 {unsetArray} { -body { proc x {} { @@ -2685,7 +2492,6 @@ test assemble-24.11 {unsetArray} { -result 0 -cleanup {rename x {}} } - test assemble-24.12 {unsetArray} { -body { proc x {} { @@ -2709,7 +2515,6 @@ test assemble-25.1 {dict get - wrong # args} { -match glob -result {wrong # args*} } - test assemble-25.2 {dict get - wrong # args} { -body { assemble {dictGet too many} @@ -2718,7 +2523,6 @@ test assemble-25.2 {dict get - wrong # args} { -match glob -result {wrong # args*} } - test assemble-25.3 {dictGet - bad subst} { -body { assemble {dictGet $foo} @@ -2727,7 +2531,6 @@ test assemble-25.3 {dictGet - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-25.4 {dict get - not a number} { -body { proc x {} { @@ -2739,7 +2542,6 @@ test assemble-25.4 {dict get - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-25.5 {dictGet - negative operand count} { -body { proc x {} { @@ -2750,7 +2552,6 @@ test assemble-25.5 {dictGet - negative operand count} { -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} @@ -2768,7 +2569,6 @@ test assemble-26.1 {dict set - wrong # args} { -match glob -result {wrong # args*} } - test assemble-26.2 {dict get - wrong # args} { -body { assemble {dictSet too many args} @@ -2777,7 +2577,6 @@ test assemble-26.2 {dict get - wrong # args} { -match glob -result {wrong # args*} } - test assemble-26.3 {dictSet - bad subst} { -body { assemble {dictSet 1 $foo} @@ -2786,7 +2585,6 @@ test assemble-26.3 {dictSet - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-26.4 {dictSet - not a number} { -body { proc x {} { @@ -2798,7 +2596,6 @@ test assemble-26.4 {dictSet - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-26.5 {dictSet - zero operand count} { -body { proc x {} { @@ -2809,7 +2606,6 @@ test assemble-26.5 {dictSet - zero operand count} { -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {rename x {}; unset result} } - test assemble-26.6 {dictSet - bad local} { -body { proc x {} { @@ -2820,7 +2616,6 @@ test assemble-26.6 {dictSet - bad local} { -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 {} { @@ -2843,7 +2638,6 @@ test assemble-27.1 {dictUnset - wrong # args} { -match glob -result {wrong # args*} } - test assemble-27.2 {dictUnset - wrong # args} { -body { assemble {dictUnset too many args} @@ -2852,7 +2646,6 @@ test assemble-27.2 {dictUnset - wrong # args} { -match glob -result {wrong # args*} } - test assemble-27.3 {dictUnset - bad subst} { -body { assemble {dictUnset 1 $foo} @@ -2861,7 +2654,6 @@ test assemble-27.3 {dictUnset - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-27.4 {dictUnset - not a number} { -body { proc x {} { @@ -2873,7 +2665,6 @@ test assemble-27.4 {dictUnset - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-27.5 {dictUnset - zero operand count} { -body { proc x {} { @@ -2884,7 +2675,6 @@ test assemble-27.5 {dictUnset - zero operand count} { -result {1 {operand must be positive} {TCL ASSEM POSITIVE}} -cleanup {rename x {}; unset result} } - test assemble-27.6 {dictUnset - bad local} { -body { proc x {} { @@ -2895,7 +2685,6 @@ test assemble-27.6 {dictUnset - bad local} { -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 {} { @@ -2918,7 +2707,6 @@ test assemble-28.1 {dictIncrImm - wrong # args} { -match glob -result {wrong # args*} } - test assemble-28.2 {dictIncrImm - wrong # args} { -body { assemble {dictIncrImm too many args} @@ -2927,7 +2715,6 @@ test assemble-28.2 {dictIncrImm - wrong # args} { -match glob -result {wrong # args*} } - test assemble-28.3 {dictIncrImm - bad subst} { -body { assemble {dictIncrImm 1 $foo} @@ -2936,7 +2723,6 @@ test assemble-28.3 {dictIncrImm - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-28.4 {dictIncrImm - not a number} { -body { proc x {} { @@ -2948,7 +2734,6 @@ test assemble-28.4 {dictIncrImm - not a number} { -result {expected integer but got "rubbish"} -cleanup {rename x {}} } - test assemble-28.5 {dictIncrImm - bad local} { -body { proc x {} { @@ -2959,7 +2744,6 @@ test assemble-28.5 {dictIncrImm - bad local} { -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 {} { @@ -2982,7 +2766,6 @@ test assemble-29.1 {regexp - wrong # args} { -match glob -result {wrong # args*} } - test assemble-29.2 {regexp - wrong # args} { -body { assemble {regexp too many} @@ -2991,7 +2774,6 @@ test assemble-29.2 {regexp - wrong # args} { -match glob -result {wrong # args*} } - test assemble-29.3 {regexp - bad subst} { -body { assemble {regexp $foo} @@ -3000,7 +2782,6 @@ test assemble-29.3 {regexp - bad subst} { -match glob -result {assembly code may not contain substitutions} } - test assemble-29.4 {regexp - not a boolean} { -body { proc x {} { @@ -3012,21 +2793,18 @@ test assemble-29.4 {regexp - not a boolean} { -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} @@ -3058,7 +2836,6 @@ test assemble-30.1 {simplest possible catch} { -result 1 -cleanup {rename x {}} } - test assemble-30.2 {catch in external catch conntext} { -body { proc x {} { @@ -3083,7 +2860,6 @@ test assemble-30.2 {catch in external catch conntext} { -result {0 1} -cleanup {rename x {}} } - test assemble-30.3 {embedded catches} { -body { proc x {} { @@ -3110,7 +2886,6 @@ test assemble-30.3 {embedded catches} { -result {0 {1 {1 whatever}}} -cleanup {rename x {}} } - test assemble-30.4 {throw in wrong context} { -body { proc x {} { @@ -3140,7 +2915,6 @@ test assemble-30.4 {throw in wrong context} { -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 {} { @@ -3162,7 +2936,6 @@ test assemble-30.5 {unclosed catch} { ("assemble" body, line 2)*}} -cleanup {rename x {}} } - test assemble-30.6 {inconsistent catch contexts} { -body { proc x {y} { @@ -3241,7 +3014,6 @@ test assemble-31.6 {jumpTable, missing symbol} { -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 {} { @@ -3293,7 +3065,6 @@ test assemble-40.1 {unbalanced stack} { -match glob -returnCodes ok } - test assemble-40.2 {unbalanced stack} {*}{ -body { list \ @@ -3338,7 +3109,6 @@ test assemble-41.1 {Inconsistent stack usage} {*}{ -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} { @@ -3357,7 +3127,6 @@ test assemble-41.2 {Inconsistent stack, jumptable and default} { -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} { @@ -3429,7 +3198,7 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} { } -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 {} @@ -3438,4 +3207,5 @@ return # Local Variables: # mode: tcl -# End:
\ No newline at end of file +# fill-column: 78 +# End: |