diff options
Diffstat (limited to 'generic/tclAssembly.c')
| -rw-r--r-- | generic/tclAssembly.c | 2724 |
1 files changed, 1429 insertions, 1295 deletions
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: + */ |