summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-03-08 10:28:03 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-03-08 10:28:03 (GMT)
commitfabd507cfed4bc840f78a7b98f16ecaaef6c4c65 (patch)
tree783e95dfa26d70428fe48a68e073b3be7eb8c59a
parent49a98e30ff06dbcf27768af0efed49f12c31610e (diff)
downloadtcl-fabd507cfed4bc840f78a7b98f16ecaaef6c4c65.zip
tcl-fabd507cfed4bc840f78a7b98f16ecaaef6c4c65.tar.gz
tcl-fabd507cfed4bc840f78a7b98f16ecaaef6c4c65.tar.bz2
Make the assembler code more like Tcl code.
Diffstat
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclAssembly.c2724
-rw-r--r--tests/assemble.test264
3 files changed, 1451 insertions, 1542 deletions
diff --git a/ChangeLog b/ChangeLog
index 02ba909..d7bdeec 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2011-03-08 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c, tests/assemble.test: Migrate to use a style
+ more consistent with the rest of Tcl.
+
2011-03-06 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c: More replacements of Tcl_UtfBackslash() calls
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index cc5dccf..d7e02bf 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -3,16 +3,14 @@
*
* Assembler for Tcl bytecodes.
*
- * This file contains the procedures that convert Tcl Assembly Language
- * (TAL) to a sequence of bytecode instructions for the Tcl execution engine.
+ * This file contains the procedures that convert Tcl Assembly Language (TAL)
+ * to a sequence of bytecode instructions for the Tcl execution engine.
*
* Copyright (c) 2010 by Ozgur Dogan Ugurlu.
* Copyright (c) 2010 by Kevin B. Kenny.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclAssembly.c,v 1.1.2.18 2010/12/16 01:40:42 kennykb Exp $
*/
/*-
@@ -34,14 +32,18 @@
#include "tclCompile.h"
#include "tclOOInt.h"
-/* Structure that represents a range of instructions in the bytecode */
+/*
+ * Structure that represents a range of instructions in the bytecode.
+ */
typedef struct CodeRange {
int startOffset; /* Start offset in the bytecode array */
int endOffset; /* End offset in the bytecode array */
} CodeRange;
-/* State identified for a basic block's catch context */
+/*
+ * State identified for a basic block's catch context.
+ */
typedef enum BasicBlockCatchState {
BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
@@ -51,138 +53,143 @@ typedef enum BasicBlockCatchState {
* may be executed after an exception fires */
} BasicBlockCatchState;
-/*
+/*
* Structure that defines a basic block - a linear sequence of bytecode
* instructions with no jumps in or out (including not changing the
* state of any exception range).
*/
typedef struct BasicBlock {
-
- int originalStartOffset; /* Instruction offset before JUMP1s
- * were substituted with JUMP4's */
- int startOffset; /* Instruction offset of the start of
- * the block */
+ int originalStartOffset; /* Instruction offset before JUMP1s were
+ * substituted with JUMP4's */
+ int startOffset; /* Instruction offset of the start of the
+ * block */
int startLine; /* Line number in the input script of the
- * instruction at the start of the block */
- int jumpOffset; /* Bytecode offset of the 'jump' instruction
+ * instruction at the start of the block */
+ int jumpOffset; /* Bytecode offset of the 'jump' instruction
* that ends the block, or -1 if there is no
* jump. */
- int jumpLine; /* Line number in the input script of the
- * 'jump' instruction that ends the block,
- * or -1 if there is no jump */
+ int jumpLine; /* Line number in the input script of the
+ * 'jump' instruction that ends the block, or
+ * -1 if there is no jump */
struct BasicBlock* prevPtr; /* Immediate predecessor of this block */
- struct BasicBlock* predecessor;
- /* Predecessor of this block in the
- * spanning tree */
- struct BasicBlock * successor1;
- /* BasicBlock structure of the following
- * block: NULL at the end of the bytecode
+ struct BasicBlock* predecessor;
+ /* Predecessor of this block in the spanning
+ * tree */
+ struct BasicBlock* successor1;
+ /* BasicBlock structure of the following
+ * block: NULL at the end of the bytecode
* sequence. */
- Tcl_Obj * jumpTarget; /* Jump target label if the jump target
- * is unresolved */
-
+ Tcl_Obj* jumpTarget; /* Jump target label if the jump target is
+ * unresolved */
int initialStackDepth; /* Absolute stack depth on entry */
int minStackDepth; /* Low-water relative stack depth */
int maxStackDepth; /* High-water relative stack depth */
int finalStackDepth; /* Relative stack depth on exit */
-
enum BasicBlockCatchState catchState;
/* State of the block for 'catch' analysis */
- int catchDepth; /* Number of nested catches in which the
- * basic block appears */
+ int catchDepth; /* Number of nested catches in which the basic
+ * block appears */
struct BasicBlock* enclosingCatch;
- /* BasicBlock structure of the last
- * startCatch executed on a path to this
- * block, or NULL if there is no
- * enclosing catch */
-
+ /* BasicBlock structure of the last startCatch
+ * executed on a path to this block, or NULL
+ * if there is no enclosing catch */
int foreignExceptionBase; /* Base index of foreign exceptions */
int foreignExceptionCount; /* Count of foreign exceptions */
ExceptionRange* foreignExceptions;
- /* ExceptionRange structures for
- * exception ranges belonging to embedded
- * scripts and expressions in this block */
-
+ /* ExceptionRange structures for exception
+ * ranges belonging to embedded scripts and
+ * expressions in this block */
JumptableInfo* jtPtr; /* Jump table at the end of this basic block */
-
int flags; /* Boolean flags */
-
} BasicBlock;
-/* Flags that pertain to a basic block */
+/*
+ * Flags that pertain to a basic block.
+ */
enum BasicBlockFlags {
BB_VISITED = (1 << 0), /* Block has been visited in the current
* traversal */
- BB_FALLTHRU = (1 << 1), /* Control may pass from this block to
- * a successor */
- BB_JUMP1 = (1 << 2), /* Basic block ends with a 1-byte-offset
- * jump and may need expansion */
+ BB_FALLTHRU = (1 << 1), /* Control may pass from this block to a
+ * successor */
+ BB_JUMP1 = (1 << 2), /* Basic block ends with a 1-byte-offset jump
+ * and may need expansion */
BB_JUMPTABLE = (1 << 3), /* Basic block ends with a jump table */
BB_BEGINCATCH = (1 << 4), /* Block ends with a 'beginCatch' instruction,
- * marking it as the start of a 'catch'
+ * marking it as the start of a 'catch'
* sequence. The 'jumpTarget' is the exception
* exit from the catch block. */
BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
- * unwinding the catch from the exception
+ * unwinding the catch from the exception
* stack. */
};
-/* Source instruction type recognized by the assembler */
+/*
+ * Source instruction type recognized by the assembler.
+ */
typedef enum TalInstType {
-
- ASSEM_1BYTE, /* Fixed arity, 1-byte instruction */
- ASSEM_BEGIN_CATCH,
- /* Begin catch: one 4-byte jump offset to be converted
- * to appropriate exception ranges */
- ASSEM_BOOL, /* One Boolean operand */
- ASSEM_BOOL_LVT4,/* One Boolean, one 4-byte LVT ref. */
- ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must be
- * strictly positive, consumes N, produces 1 */
- ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1 operands,
- * produces 1, N > 0 */
- ASSEM_DICT_SET, /* specifies key count and LVT index, consumes N+1 operands,
- * produces 1, N > 0 */
- ASSEM_DICT_UNSET,
- /* specifies key count and LVT index, consumes N operands,
- * produces 1, N > 0 */
- ASSEM_END_CATCH,/* End catch. No args. Exception range popped from stack
- * and stack pointer restored. */
- ASSEM_EVAL, /* 'eval' - evaluate a constant script (by compiling it
- * in line with the assembly code! I love Tcl!) */
- ASSEM_INDEX, /* 4 byte operand, integer or end-integer */
- ASSEM_INVOKE, /* 1- or 4-byte operand count, must be strictly positive,
- * consumes N, produces 1. */
- ASSEM_JUMP, /* Jump instructions */
- ASSEM_JUMP4, /* Jump instructions forcing a 4-byte offset */
- ASSEM_JUMPTABLE,/* Jumptable (switch -exact) */
- ASSEM_LABEL, /* The assembly directive that defines a label */
- ASSEM_LINDEX_MULTI,
- /* 4-byte operand count, must be strictly positive,
- * consumes N, produces 1 */
- ASSEM_LIST, /* 4-byte operand count, must be nonnegative, consumses N,
- * produces 1 */
- ASSEM_LSET_FLAT,/* 4-byte operand count, must be >= 3, consumes N,
- * produces 1 */
- ASSEM_LVT, /* One operand that references a local variable */
- ASSEM_LVT1, /* One 1-byte operand that references a local variable */
- ASSEM_LVT1_SINT1,
- /* One 1-byte operand that references a local variable,
- * one signed-integer 1-byte operand */
- ASSEM_LVT4, /* One 4-byte operand that references a local variable */
- ASSEM_OVER, /* OVER: 4-byte operand count, consumes N+1, produces N+2 */
- ASSEM_PUSH, /* one literal operand */
- ASSEM_REGEXP, /* One Boolean operand, but weird mapping to call flags */
- ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N, produces N */
- ASSEM_SINT1, /* One 1-byte signed-integer operand (INCR_STK_IMM) */
- ASSEM_SINT4_LVT4,
- /* Signed 4-byte integer operand followed by LVT entry.
- * Fixed arity */
+ ASSEM_1BYTE, /* Fixed arity, 1-byte instruction */
+ ASSEM_BEGIN_CATCH, /* Begin catch: one 4-byte jump offset to be
+ * converted to appropriate exception
+ * ranges */
+ ASSEM_BOOL, /* One Boolean operand */
+ ASSEM_BOOL_LVT4, /* One Boolean, one 4-byte LVT ref. */
+ ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must
+ * be strictly positive, consumes N, produces
+ * 1 */
+ ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1
+ * operands, produces 1, N > 0 */
+ ASSEM_DICT_SET, /* specifies key count and LVT index, consumes
+ * N+1 operands, produces 1, N > 0 */
+ ASSEM_DICT_UNSET, /* specifies key count and LVT index, consumes
+ * N operands, produces 1, N > 0 */
+ ASSEM_END_CATCH, /* End catch. No args. Exception range popped
+ * from stack and stack pointer restored. */
+ ASSEM_EVAL, /* 'eval' - evaluate a constant script (by
+ * compiling it in line with the assembly
+ * code! I love Tcl!) */
+ ASSEM_INDEX, /* 4 byte operand, integer or end-integer */
+ ASSEM_INVOKE, /* 1- or 4-byte operand count, must be
+ * strictly positive, consumes N, produces
+ * 1. */
+ ASSEM_JUMP, /* Jump instructions */
+ ASSEM_JUMP4, /* Jump instructions forcing a 4-byte offset */
+ ASSEM_JUMPTABLE, /* Jumptable (switch -exact) */
+ ASSEM_LABEL, /* The assembly directive that defines a
+ * label */
+ ASSEM_LINDEX_MULTI, /* 4-byte operand count, must be strictly
+ * positive, consumes N, produces 1 */
+ ASSEM_LIST, /* 4-byte operand count, must be nonnegative,
+ * consumses N, produces 1 */
+ ASSEM_LSET_FLAT, /* 4-byte operand count, must be >= 3,
+ * consumes N, produces 1 */
+ ASSEM_LVT, /* One operand that references a local
+ * variable */
+ ASSEM_LVT1, /* One 1-byte operand that references a local
+ * variable */
+ ASSEM_LVT1_SINT1, /* One 1-byte operand that references a local
+ * variable, one signed-integer 1-byte
+ * operand */
+ ASSEM_LVT4, /* One 4-byte operand that references a local
+ * variable */
+ ASSEM_OVER, /* OVER: 4-byte operand count, consumes N+1,
+ * produces N+2 */
+ ASSEM_PUSH, /* one literal operand */
+ ASSEM_REGEXP, /* One Boolean operand, but weird mapping to
+ * call flags */
+ ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N,
+ * produces N */
+ ASSEM_SINT1, /* One 1-byte signed-integer operand
+ * (INCR_STK_IMM) */
+ ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by
+ * LVT entry. Fixed arity */
} TalInstType;
-/* Description of an instruction recognized by the assembler. */
+/*
+ * Description of an instruction recognized by the assembler.
+ */
typedef struct TalInstDesc {
const char *name; /* Name of instruction. */
@@ -191,108 +198,122 @@ typedef struct TalInstDesc {
* 1- and 4-byte variables, tclInstCode is
* ((1byte)<<8) || (4byte) */
int operandsConsumed; /* Number of operands consumed by the
- * operation, or INT_MIN if the operation
- * is variadic */
+ * operation, or INT_MIN if the operation is
+ * variadic */
int operandsProduced; /* Number of operands produced by the
- * operation. If negative, the operation
- * has a net stack effect of
- * -1-operandsProduced */
+ * operation. If negative, the operation has a
+ * net stack effect of -1-operandsProduced */
} TalInstDesc;
-/* Structure that holds the state of the assembler while generating code */
+/*
+ * Structure that holds the state of the assembler while generating code.
+ */
typedef struct AssemblyEnv {
- CompileEnv* envPtr; /* Compilation environment being used
- * for code generation */
- Tcl_Parse* parsePtr; /* Parse of the current line of source */
- Tcl_HashTable labelHash; /* Hash table whose keys are labels and
- * whose values are 'label' objects storing
- * the code offsets of the labels. */
-
- int cmdLine; /* Current line number within the assembly
+ CompileEnv* envPtr; /* Compilation environment being used for code
+ * generation */
+ Tcl_Parse* parsePtr; /* Parse of the current line of source */
+ Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose
+ * values are 'label' objects storing the code
+ * offsets of the labels. */
+ int cmdLine; /* Current line number within the assembly
* code */
int* clNext; /* Invisible continuation line for
* [info frame] */
-
BasicBlock* head_bb; /* First basic block in the code */
BasicBlock* curr_bb; /* Current basic block */
-
- int maxDepth; /* Maximum stack depth encountered */
-
+ int maxDepth; /* Maximum stack depth encountered */
int curCatchDepth; /* Current depth of catches */
int maxCatchDepth; /* Maximum depth of catches encountered */
-
int flags; /* Compilation flags (TCL_EVAL_DIRECT) */
} AssemblyEnv;
-/* Static functions defined in this file */
-
-static void AddBasicBlockRangeToErrorInfo(AssemblyEnv*, BasicBlock*);
-static BasicBlock * AllocBB(AssemblyEnv*);
-static int AssembleOneLine(AssemblyEnv* envPtr);
-static void BBAdjustStackDepth(BasicBlock* bbPtr, int consumed, int produced);
-static void BBUpdateStackReqs(BasicBlock* bbPtr, int tblind, int count);
-static void BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblind,
- unsigned char opnd, int count);
-static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblind, int opnd,
- int count);
-static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblind, int param,
- int count);
-static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblind, int count);
-static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
-static int CalculateJumpRelocations(AssemblyEnv*, int*);
-static int CheckForUnclosedCatches(AssemblyEnv*);
-static int CheckForThrowInWrongContext(AssemblyEnv*);
-static int CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
-static int BytecodeMightThrow(unsigned char);
-static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*);
-static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int);
-static int CheckNonNegative(Tcl_Interp*, int);
-static int CheckOneByte(Tcl_Interp*, int);
-static int CheckSignedOneByte(Tcl_Interp*, int);
-static int CheckStack(AssemblyEnv*);
-static int CheckStrictlyPositive(Tcl_Interp*, int);
-static ByteCode * CompileAssembleObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*, TalInstDesc*);
-static int DefineLabel(AssemblyEnv* envPtr, const char* label);
-static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void DupAssembleCodeInternalRep(Tcl_Obj* src, Tcl_Obj* dest);
-static void FillInJumpOffsets(AssemblyEnv*);
-static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_Obj* jumpTable);
-static int FindLocalVar(AssemblyEnv* envPtr, Tcl_Token** tokenPtrPtr);
-static int FinishAssembly(AssemblyEnv*);
-static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
-static void FreeAssemblyEnv(AssemblyEnv*);
-static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
-static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
-static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*);
-static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**);
-static void LookForFreshCatches(BasicBlock*, BasicBlock**);
-static void MoveCodeForJumps(AssemblyEnv*, int);
-static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int, int);
-static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int);
-static int ProcessCatches(AssemblyEnv*);
-static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*, BasicBlock*,
- enum BasicBlockCatchState, int);
-static void ResetVisitedBasicBlocks(AssemblyEnv*);
-static void ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*);
-static void ReportUndefinedLabel(AssemblyEnv*, BasicBlock*, Tcl_Obj*);
-static void RestoreEmbeddedExceptionRanges(AssemblyEnv*);
-static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *, BasicBlock *, int);
-static BasicBlock* StartBasicBlock(AssemblyEnv*, int fallthrough,
- Tcl_Obj* jumpLabel);
-/* static int AdvanceIp(const unsigned char *pc); */
-static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *, BasicBlock *, int);
-static int StackCheckExit(AssemblyEnv*);
-static void StackFreshCatches(AssemblyEnv*, BasicBlock*, int, BasicBlock**,
- int*);
-static void SyncStackDepth(AssemblyEnv*);
-static int TclAssembleCode(CompileEnv* envPtr, const char* code, int codeLen,
- int flags);
-static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
- BasicBlock**, int*);
-
-/* Tcl_ObjType that describes bytecode emitted by the assembler */
+/*
+ * Static functions defined in this file.
+ */
+
+static void AddBasicBlockRangeToErrorInfo(AssemblyEnv*,
+ BasicBlock*);
+static BasicBlock * AllocBB(AssemblyEnv*);
+static int AssembleOneLine(AssemblyEnv* envPtr);
+static void BBAdjustStackDepth(BasicBlock* bbPtr, int consumed,
+ int produced);
+static void BBUpdateStackReqs(BasicBlock* bbPtr, int tblIdx,
+ int count);
+static void BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx,
+ unsigned char opnd, int count);
+static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int opnd, int count);
+static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int param, int count);
+static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
+ int count);
+static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
+static int CalculateJumpRelocations(AssemblyEnv*, int*);
+static int CheckForUnclosedCatches(AssemblyEnv*);
+static int CheckForThrowInWrongContext(AssemblyEnv*);
+static int CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
+static int BytecodeMightThrow(unsigned char);
+static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*);
+static int CheckNamespaceQualifiers(Tcl_Interp*, const char*,
+ int);
+static int CheckNonNegative(Tcl_Interp*, int);
+static int CheckOneByte(Tcl_Interp*, int);
+static int CheckSignedOneByte(Tcl_Interp*, int);
+static int CheckStack(AssemblyEnv*);
+static int CheckStrictlyPositive(Tcl_Interp*, int);
+static ByteCode * CompileAssembleObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
+ TalInstDesc*);
+static int DefineLabel(AssemblyEnv* envPtr, const char* label);
+static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
+static void DupAssembleCodeInternalRep(Tcl_Obj* src,
+ Tcl_Obj* dest);
+static void FillInJumpOffsets(AssemblyEnv*);
+static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
+ Tcl_Obj* jumpTable);
+static int FindLocalVar(AssemblyEnv* envPtr,
+ Tcl_Token** tokenPtrPtr);
+static int FinishAssembly(AssemblyEnv*);
+static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
+static void FreeAssemblyEnv(AssemblyEnv*);
+static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*);
+static int GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**);
+static void LookForFreshCatches(BasicBlock*, BasicBlock**);
+static void MoveCodeForJumps(AssemblyEnv*, int);
+static void MoveExceptionRangesToBasicBlock(AssemblyEnv*, int,
+ int);
+static AssemblyEnv* NewAssemblyEnv(CompileEnv*, int);
+static int ProcessCatches(AssemblyEnv*);
+static int ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*,
+ BasicBlock*, enum BasicBlockCatchState, int);
+static void ResetVisitedBasicBlocks(AssemblyEnv*);
+static void ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*);
+static void ReportUndefinedLabel(AssemblyEnv*, BasicBlock*,
+ Tcl_Obj*);
+static void RestoreEmbeddedExceptionRanges(AssemblyEnv*);
+static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
+ BasicBlock *, int);
+static BasicBlock* StartBasicBlock(AssemblyEnv*, int fallthrough,
+ Tcl_Obj* jumpLabel);
+/* static int AdvanceIp(const unsigned char *pc); */
+static int StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
+ BasicBlock *, int);
+static int StackCheckExit(AssemblyEnv*);
+static void StackFreshCatches(AssemblyEnv*, BasicBlock*, int,
+ BasicBlock**, int*);
+static void SyncStackDepth(AssemblyEnv*);
+static int TclAssembleCode(CompileEnv* envPtr, const char* code,
+ int codeLen, int flags);
+static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
+ BasicBlock**, int*);
+
+/*
+ * Tcl_ObjType that describes bytecode emitted by the assembler.
+ */
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
@@ -330,143 +351,141 @@ static const Tcl_ObjType assembleCodeType = {
*/
TalInstDesc TalInstructionTable[] = {
-
/* PUSH must be first, see the code near the end of TclAssembleCode */
-
- {"push", ASSEM_PUSH , (INST_PUSH1<<8
- | INST_PUSH4), 0 , 1},
-
- {"add", ASSEM_1BYTE , INST_ADD , 2 , 1},
- {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8
- | INST_APPEND_SCALAR4),1, 1},
- {"appendArray", ASSEM_LVT, (INST_APPEND_ARRAY1<<8
- | INST_APPEND_ARRAY4), 2, 1},
- {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1},
- {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1},
+ {"push", ASSEM_PUSH, (INST_PUSH1<<8
+ | INST_PUSH4), 0, 1},
+
+ {"add", ASSEM_1BYTE, INST_ADD, 2, 1},
+ {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8
+ | INST_APPEND_SCALAR4),1, 1},
+ {"appendArray", ASSEM_LVT, (INST_APPEND_ARRAY1<<8
+ | INST_APPEND_ARRAY4), 2, 1},
+ {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1},
+ {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1},
{"beginCatch", ASSEM_BEGIN_CATCH,
- INST_BEGIN_CATCH4, 0, 0},
- {"bitand", ASSEM_1BYTE , INST_BITAND , 2 , 1},
- {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1},
- {"bitor", ASSEM_1BYTE , INST_BITOR , 2 , 1},
- {"bitxor", ASSEM_1BYTE , INST_BITXOR , 2 , 1},
+ INST_BEGIN_CATCH4, 0, 0},
+ {"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1},
+ {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1},
+ {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1},
+ {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
{"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1},
- {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
- {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1},
- {"dictIncrImm", ASSEM_SINT4_LVT4,
- INST_DICT_INCR_IMM, 1, 1},
- {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1},
- {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1},
+ {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
+ {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1},
+ {"dictIncrImm", ASSEM_SINT4_LVT4,
+ INST_DICT_INCR_IMM, 1, 1},
+ {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1},
+ {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1},
{"dictUnset", ASSEM_DICT_UNSET,
- INST_DICT_UNSET, INT_MIN,1},
- {"div", ASSEM_1BYTE, INST_DIV, 2, 1},
- {"dup", ASSEM_1BYTE , INST_DUP , 1 , 2},
- {"endCatch", ASSEM_END_CATCH,INST_END_CATCH, 0, 0},
- {"eq", ASSEM_1BYTE , INST_EQ , 2 , 1},
+ INST_DICT_UNSET, INT_MIN,1},
+ {"div", ASSEM_1BYTE, INST_DIV, 2, 1},
+ {"dup", ASSEM_1BYTE, INST_DUP, 1, 2},
+ {"endCatch", ASSEM_END_CATCH,INST_END_CATCH, 0, 0},
+ {"eq", ASSEM_1BYTE, INST_EQ, 2, 1},
{"eval", ASSEM_EVAL, INST_EVAL_STK, 1, 1},
{"evalStk", ASSEM_1BYTE, INST_EVAL_STK, 1, 1},
- {"exist", ASSEM_LVT4, INST_EXIST_SCALAR, 0, 1},
- {"existArray", ASSEM_LVT4, INST_EXIST_ARRAY, 1, 1},
+ {"exist", ASSEM_LVT4, INST_EXIST_SCALAR, 0, 1},
+ {"existArray", ASSEM_LVT4, INST_EXIST_ARRAY, 1, 1},
{"existArrayStk", ASSEM_1BYTE, INST_EXIST_ARRAY_STK, 2, 1},
{"existStk", ASSEM_1BYTE, INST_EXIST_STK, 1, 1},
- {"expon", ASSEM_1BYTE, INST_EXPON, 2, 1},
+ {"expon", ASSEM_1BYTE, INST_EXPON, 2, 1},
{"expr", ASSEM_EVAL, INST_EXPR_STK, 1, 1},
- {"exprStk", ASSEM_1BYTE, INST_EXPR_STK, 1, 1},
- {"ge", ASSEM_1BYTE , INST_GE , 2 , 1},
- {"gt", ASSEM_1BYTE , INST_GT , 2 , 1},
- {"incr", ASSEM_LVT1, INST_INCR_SCALAR1, 1, 1},
- {"incrArray", ASSEM_LVT1, INST_INCR_ARRAY1, 2, 1},
- {"incrArrayImm", ASSEM_LVT1_SINT1,
- INST_INCR_ARRAY1_IMM, 1, 1},
- {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1},
- {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1},
- {"incrImm", ASSEM_LVT1_SINT1,
- INST_INCR_SCALAR1_IMM, 0, 1},
- {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1},
- {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM,
- 1, 1},
- {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8
- | INST_INVOKE_STK4), INT_MIN,1},
- {"jump", ASSEM_JUMP, INST_JUMP1, 0, 0},
- {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0},
- {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0},
- {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0},
+ {"exprStk", ASSEM_1BYTE, INST_EXPR_STK, 1, 1},
+ {"ge", ASSEM_1BYTE, INST_GE, 2, 1},
+ {"gt", ASSEM_1BYTE, INST_GT, 2, 1},
+ {"incr", ASSEM_LVT1, INST_INCR_SCALAR1, 1, 1},
+ {"incrArray", ASSEM_LVT1, INST_INCR_ARRAY1, 2, 1},
+ {"incrArrayImm", ASSEM_LVT1_SINT1,
+ INST_INCR_ARRAY1_IMM, 1, 1},
+ {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1},
+ {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1},
+ {"incrImm", ASSEM_LVT1_SINT1,
+ INST_INCR_SCALAR1_IMM, 0, 1},
+ {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1},
+ {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM,
+ 1, 1},
+ {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8
+ | INST_INVOKE_STK4), INT_MIN,1},
+ {"jump", ASSEM_JUMP, INST_JUMP1, 0, 0},
+ {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0},
+ {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0},
+ {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0},
{"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0},
- {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0},
- {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0},
- {"label", ASSEM_LABEL, 0, 0, 0},
- {"land", ASSEM_1BYTE , INST_LAND , 2 , 1},
- {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8
- | INST_LAPPEND_SCALAR4),
- 1, 1},
- {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8
- | INST_LAPPEND_ARRAY4),2, 1},
- {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1},
- {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1},
- {"le", ASSEM_1BYTE , INST_LE , 2 , 1},
+ {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0},
+ {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0},
+ {"label", ASSEM_LABEL, 0, 0, 0},
+ {"land", ASSEM_1BYTE, INST_LAND, 2, 1},
+ {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8
+ | INST_LAPPEND_SCALAR4),
+ 1, 1},
+ {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8
+ | INST_LAPPEND_ARRAY4),2, 1},
+ {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1},
+ {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1},
+ {"le", ASSEM_1BYTE, INST_LE, 2, 1},
{"lindexMulti", ASSEM_LINDEX_MULTI,
- INST_LIST_INDEX_MULTI, INT_MIN,1},
+ INST_LIST_INDEX_MULTI, INT_MIN,1},
{"list", ASSEM_LIST, INST_LIST, INT_MIN,1},
{"listIn", ASSEM_1BYTE, INST_LIST_IN, 2, 1},
- {"listIndex", ASSEM_1BYTE, INST_LIST_INDEX, 2, 1},
+ {"listIndex", ASSEM_1BYTE, INST_LIST_INDEX, 2, 1},
{"listIndexImm", ASSEM_INDEX, INST_LIST_INDEX_IMM, 1, 1},
- {"listLength", ASSEM_1BYTE, INST_LIST_LENGTH, 1, 1},
+ {"listLength", ASSEM_1BYTE, INST_LIST_LENGTH, 1, 1},
{"listNotIn", ASSEM_1BYTE, INST_LIST_NOT_IN, 2, 1},
- {"load", ASSEM_LVT, (INST_LOAD_SCALAR1 << 8
- | INST_LOAD_SCALAR4), 0, 1},
- {"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8
- | INST_LOAD_ARRAY4), 1, 1},
- {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1},
- {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1},
- {"lor", ASSEM_1BYTE , INST_LOR , 2 , 1},
+ {"load", ASSEM_LVT, (INST_LOAD_SCALAR1 << 8
+ | INST_LOAD_SCALAR4), 0, 1},
+ {"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8
+ | INST_LOAD_ARRAY4), 1, 1},
+ {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1},
+ {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1},
+ {"lor", ASSEM_1BYTE, INST_LOR, 2, 1},
{"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1},
- {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1},
- {"lshift", ASSEM_1BYTE , INST_LSHIFT , 2 , 1},
- {"lt", ASSEM_1BYTE , INST_LT , 2 , 1},
- {"mod", ASSEM_1BYTE, INST_MOD, 2, 1},
- {"mult", ASSEM_1BYTE , INST_MULT , 2 , 1},
- {"neq", ASSEM_1BYTE , INST_NEQ , 2 , 1},
+ {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1},
+ {"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1},
+ {"lt", ASSEM_1BYTE, INST_LT, 2, 1},
+ {"mod", ASSEM_1BYTE, INST_MOD, 2, 1},
+ {"mult", ASSEM_1BYTE, INST_MULT, 2, 1},
+ {"neq", ASSEM_1BYTE, INST_NEQ, 2, 1},
{"nop", ASSEM_1BYTE, INST_NOP, 0, 0},
- {"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
+ {"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
{"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1},
- {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
- {"pop", ASSEM_1BYTE , INST_POP , 1 , 0},
+ {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
+ {"pop", ASSEM_1BYTE, INST_POP, 1, 0},
{"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1},
{"pushReturnOpts", ASSEM_1BYTE, INST_PUSH_RETURN_OPTIONS,
- 0, 1},
+ 0, 1},
{"pushResult", ASSEM_1BYTE, INST_PUSH_RESULT, 0, 1},
{"regexp", ASSEM_REGEXP, INST_REGEXP, 2, 1},
- {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0},
- {"rshift", ASSEM_1BYTE , INST_RSHIFT , 2 , 1},
- {"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8
- | INST_STORE_SCALAR4), 1, 1},
- {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8
- | INST_STORE_ARRAY4), 2, 1},
- {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
- {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1},
- {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
- {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
- {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1},
- {"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1},
- {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
- {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
- {"sub", ASSEM_1BYTE , INST_SUB , 2 , 1},
- {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
- {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
- {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
- {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0},
+ {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0},
+ {"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1},
+ {"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8
+ | INST_STORE_SCALAR4), 1, 1},
+ {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8
+ | INST_STORE_ARRAY4), 2, 1},
+ {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
+ {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1},
+ {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
+ {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
+ {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1},
+ {"strlen", ASSEM_1BYTE, INST_STR_LEN, 1, 1},
+ {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
+ {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
+ {"sub", ASSEM_1BYTE, INST_SUB, 2, 1},
+ {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
+ {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
+ {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
+ {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0},
{"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0},
{"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0},
- {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1},
+ {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1},
{"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1},
{"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0},
- {NULL, 0, 0, 0, 0}
+ {NULL, 0, 0, 0, 0}
};
/*
- * List of instructions that cannot throw an exception under any circumstances.
- * These instructions are the ones that are permissible after an exception
- * is caught but before the corresponding exception range is popped from
- * the stack.
+ * List of instructions that cannot throw an exception under any
+ * circumstances. These instructions are the ones that are permissible after
+ * an exception is caught but before the corresponding exception range is
+ * popped from the stack.
* The instructions must be in ascending order by numeric operation code.
*/
@@ -479,36 +498,47 @@ static unsigned char NonThrowingByteCodes[] = {
INST_REVERSE, /* 126 */
INST_NOP /* 132 */
};
+
+/*
+ * Helper macros.
+ */
+
+#if defined(TCL_DEBUG_ASSEMBLY) && defined(__GNUC__) && __GNUC__ > 2
+#define DEBUG_PRINT(...) fprintf(stderr, ##__VA_ARGS__);fflush(stderr)
+#elif defined(__GNUC__) && __GNUC__ > 2
+#define DEBUG_PRINT(...) /* nothing */
+#else
+#define DEBUG_PRINT /* nothing */
+#endif
/*
*-----------------------------------------------------------------------------
*
* BBAdjustStackDepth --
*
- * When an opcode is emitted, adjusts the stack information in the
- * basic block to reflect the number of operands produced and consumed.
+ * When an opcode is emitted, adjusts the stack information in the basic
+ * block to reflect the number of operands produced and consumed.
*
* Results:
* None.
*
* Side effects:
- * Updates minimum, maximum and final stack requirements in the
- * basic block.
+ * Updates minimum, maximum and final stack requirements in the basic
+ * block.
*
*-----------------------------------------------------------------------------
*/
static void
-BBAdjustStackDepth(BasicBlock* bbPtr,
- /* Structure describing the basic block */
- int consumed,
- /* Count of operands consumed by the
+BBAdjustStackDepth(
+ BasicBlock *bbPtr, /* Structure describing the basic block */
+ int consumed, /* Count of operands consumed by the
* operation */
- int produced)
- /* Count of operands produced by the
+ int produced) /* Count of operands produced by the
* operation */
{
int depth = bbPtr->finalStackDepth;
+
depth -= consumed;
if (depth < bbPtr->minStackDepth) {
bbPtr->minStackDepth = depth;
@@ -535,32 +565,39 @@ BBAdjustStackDepth(BasicBlock* bbPtr,
* Updates min, max and final stack requirements in the basic block.
*
* Notes:
- * This function must not be called for instructions such as REVERSE
- * and OVER that are variadic but do not consume all their operands.
- * Instead, BBAdjustStackDepth should be called directly.
+ * This function must not be called for instructions such as REVERSE and
+ * OVER that are variadic but do not consume all their operands. Instead,
+ * BBAdjustStackDepth should be called directly.
*
- * count should be provided only for variadic operations. For
- * operations with known arity, count should be 0.
+ * count should be provided only for variadic operations. For operations
+ * with known arity, count should be 0.
*
*-----------------------------------------------------------------------------
*/
static void
-BBUpdateStackReqs(BasicBlock* bbPtr,
- /* Structure describing the basic block */
- int tblind, /* Index in TalInstructionTable of the
+BBUpdateStackReqs(
+ BasicBlock* bbPtr, /* Structure describing the basic block */
+ int tblIdx, /* Index in TalInstructionTable of the
* operation being assembled */
- int count) /* Count of operands for variadic insts */
+ int count) /* Count of operands for variadic insts */
{
- int consumed = TalInstructionTable[tblind].operandsConsumed;
- int produced = TalInstructionTable[tblind].operandsProduced;
+ int consumed = TalInstructionTable[tblIdx].operandsConsumed;
+ int produced = TalInstructionTable[tblIdx].operandsProduced;
+
if (consumed == INT_MIN) {
- /* The instruction is variadic; it consumes 'count' operands. */
+ /*
+ * The instruction is variadic; it consumes 'count' operands.
+ */
+
consumed = count;
}
if (produced < 0) {
- /* The instruction leaves some of its variadic operands on the stack,
- * with net stack effect of '-1-produced' */
+ /*
+ * The instruction leaves some of its variadic operands on the stack,
+ * with net stack effect of '-1-produced'
+ */
+
produced = consumed - produced - 1;
}
BBAdjustStackDepth(bbPtr, consumed, produced);
@@ -572,32 +609,35 @@ BBUpdateStackReqs(BasicBlock* bbPtr,
* BBEmitOpcode, BBEmitInstInt1, BBEmitInstInt4 --
*
* Emit the opcode part of an instruction, or the entirety of an
- * instruction with a 1- or 4-byte operand, and adjust stack requirements.
+ * instruction with a 1- or 4-byte operand, and adjust stack
+ * requirements.
*
* Results:
* None.
*
* Side effects:
- * Stores instruction and operand in the operand stream, and
- * adjusts the stack.
+ * Stores instruction and operand in the operand stream, and adjusts the
+ * stack.
*
*-----------------------------------------------------------------------------
*/
static void
-BBEmitOpcode(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- int tblind, /* Table index in TalInstructionTable of op */
- int count) /* Operand count for variadic ops */
+BBEmitOpcode(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Table index in TalInstructionTable of op */
+ int count) /* Operand count for variadic ops */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
BasicBlock* bbPtr = assemEnvPtr->curr_bb;
/* Current basic block */
- int op = TalInstructionTable[tblind].tclInstCode & 0xff;
+ int op = TalInstructionTable[tblIdx].tclInstCode & 0xff;
- /* If this is the first instruction in a basic block, record its
- * line number. */
+ /*
+ * If this is the first instruction in a basic block, record its line
+ * number.
+ */
if (bbPtr->startOffset == envPtr->codeNext - envPtr->codeStart) {
bbPtr->startLine = assemEnvPtr->cmdLine;
@@ -605,27 +645,28 @@ BBEmitOpcode(AssemblyEnv* assemEnvPtr,
TclEmitInt1(op, envPtr);
envPtr->atCmdStart = ((op) == INST_START_CMD);
- BBUpdateStackReqs(bbPtr, tblind, count);
+ BBUpdateStackReqs(bbPtr, tblIdx, count);
}
+
static void
-BBEmitInstInt1(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- int tblind, /* Index in TalInstructionTable of op */
- unsigned char opnd,
- /* 1-byte operand */
- int count) /* Operand count for variadic ops */
+BBEmitInstInt1(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Index in TalInstructionTable of op */
+ unsigned char opnd, /* 1-byte operand */
+ int count) /* Operand count for variadic ops */
{
- BBEmitOpcode(assemEnvPtr, tblind, count);
+ BBEmitOpcode(assemEnvPtr, tblIdx, count);
TclEmitInt1(opnd, assemEnvPtr->envPtr);
}
+
static void
-BBEmitInstInt4(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- int tblind, /* Index in TalInstructionTable of op */
- int opnd, /* 4-byte operand */
- int count) /* Operand count for variadic ops */
+BBEmitInstInt4(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Index in TalInstructionTable of op */
+ int opnd, /* 4-byte operand */
+ int count) /* Operand count for variadic ops */
{
- BBEmitOpcode(assemEnvPtr, tblind, count);
+ BBEmitOpcode(assemEnvPtr, tblIdx, count);
TclEmitInt4(opnd, assemEnvPtr->envPtr);
}
@@ -641,18 +682,18 @@ BBEmitInstInt4(AssemblyEnv* assemEnvPtr,
*/
static void
-BBEmitInst1or4(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- int tblind, /* Index in TalInstructionTable of op */
- int param, /* Variable-length parameter */
- int count) /* Arity if variadic */
+BBEmitInst1or4(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int tblIdx, /* Index in TalInstructionTable of op */
+ int param, /* Variable-length parameter */
+ int count) /* Arity if variadic */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
BasicBlock* bbPtr = assemEnvPtr->curr_bb;
/* Current basic block */
+ int op = TalInstructionTable[tblIdx].tclInstCode;
- int op = TalInstructionTable[tblind].tclInstCode;
if (param <= 0xff) {
op >>= 8;
} else {
@@ -665,7 +706,7 @@ BBEmitInst1or4(AssemblyEnv* assemEnvPtr,
TclEmitInt4(param, envPtr);
}
envPtr->atCmdStart = ((op) == INST_START_CMD);
- BBUpdateStackReqs(bbPtr, tblind, count);
+ BBUpdateStackReqs(bbPtr, tblIdx, count);
}
/*
@@ -692,13 +733,14 @@ Tcl_AssembleObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- /*
- * Boilerplate - make sure that there is an NRE trampoline on the
- * C stack because there needs to be one in place to execute bytecode.
+ /*
+ * Boilerplate - make sure that there is an NRE trampoline on the C stack
+ * because there needs to be one in place to execute bytecode.
*/
-
+
return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv);
}
+
int
TclNRAssembleObjCmd(
ClientData dummy, /* Not used. */
@@ -707,21 +749,23 @@ TclNRAssembleObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
ByteCode *codePtr; /* Pointer to the bytecode to execute */
- Tcl_Obj* backtrace; /* Object where extra error information
- * is constructed. */
-
- /* Check args */
+ Tcl_Obj* backtrace; /* Object where extra error information is
+ * constructed. */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList");
return TCL_ERROR;
}
- /* Assemble the source to bytecode */
+ /*
+ * Assemble the source to bytecode.
+ */
codePtr = CompileAssembleObj(interp, objv[1]);
- /* On failure, report error line */
+ /*
+ * On failure, report error line.
+ */
if (codePtr == NULL) {
Tcl_AddErrorInfo(interp, "\n (\"");
@@ -735,15 +779,16 @@ TclNRAssembleObjCmd(
return TCL_ERROR;
}
- /* Use NRE to evaluate the bytecode from the trampoline */
-
/*
+ * Use NRE to evaluate the bytecode from the trampoline.
+ */
+
+#if 0
Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
NULL, NULL);
return TCL_OK;
- */
+#endif
return TclNRExecuteByteCode(interp, codePtr);
-
}
/*
@@ -751,17 +796,17 @@ TclNRAssembleObjCmd(
*
* CompileAssembleObj --
*
- * Sets up and assembles Tcl bytecode for the direct-execution path
- * in the Tcl bytecode assembler.
+ * Sets up and assembles Tcl bytecode for the direct-execution path in
+ * the Tcl bytecode assembler.
*
* Results:
- * Returns a pointer to the assembled code. Returns NULL if the
- * assembly fails for any reason, with an appropriate error message
- * in the interpreter.
+ * Returns a pointer to the assembled code. Returns NULL if the assembly
+ * fails for any reason, with an appropriate error message in the
+ * interpreter.
*
*-----------------------------------------------------------------------------
*/
-
+
static ByteCode *
CompileAssembleObj(
Tcl_Interp *interp, /* Tcl interpreter */
@@ -772,75 +817,80 @@ CompileAssembleObj(
CompileEnv compEnv; /* Compilation environment structure */
register ByteCode *codePtr = NULL;
/* Bytecode resulting from the assembly */
- Namespace* namespacePtr; /* Namespace in which variable and
- * command names in the bytecode resolve */
+ Namespace* namespacePtr; /* Namespace in which variable and command
+ * names in the bytecode resolve */
int status; /* Status return from Tcl_AssembleCode */
- const char* source; /* String representation of the
- * source code */
- int sourceLen; /* Length of the source code in bytes */
+ const char* source; /* String representation of the source code */
+ int sourceLen; /* Length of the source code in bytes */
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
-
+
if (objPtr->typePtr == &assembleCodeType) {
namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ codePtr = objPtr->internalRep.otherValuePtr;
if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)
- || (codePtr->nsPtr != namespacePtr)
- || (codePtr->nsEpoch != namespacePtr->resolverEpoch)
- || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
-
+ || (codePtr->compileEpoch != iPtr->compileEpoch)
+ || (codePtr->nsPtr != namespacePtr)
+ || (codePtr->nsEpoch != namespacePtr->resolverEpoch)
+ || (codePtr->localCachePtr
+ != iPtr->varFramePtr->localCachePtr)) {
FreeAssembleCodeInternalRep(objPtr);
+ } else {
+ return codePtr;
}
}
- if (objPtr->typePtr != &assembleCodeType) {
-
- /* Set up the compilation environment, and assemble the code */
- source = TclGetStringFromObj(objPtr, &sourceLen);
- TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
- status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
- if (status != TCL_OK) {
-
- /* Assembly failed. Clean up and report the error */
-
- TclFreeCompileEnv(&compEnv);
- return NULL;
- }
+ /*
+ * Set up the compilation environment, and assemble the code.
+ */
+ source = TclGetStringFromObj(objPtr, &sourceLen);
+ TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
+ status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
+ if (status != TCL_OK) {
/*
- * Add a "done" instruction as the last instruction and change the
- * object into a ByteCode object. Ownership of the literal objects and
- * aux data items is given to the ByteCode object.
+ * Assembly failed. Clean up and report the error.
*/
- TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &assembleCodeType;
TclFreeCompileEnv(&compEnv);
+ return NULL;
+ }
- /*
- * Record the local variable context to which the bytecode pertains
- */
+ /*
+ * Add a "done" instruction as the last instruction and change the object
+ * into a ByteCode object. Ownership of the literal objects and aux data
+ * items is given to the ByteCode object.
+ */
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if (iPtr->varFramePtr->localCachePtr) {
- codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
- codePtr->localCachePtr->refCount++;
- }
+ TclEmitOpcode(INST_DONE, &compEnv);
+ TclInitByteCodeObj(objPtr, &compEnv);
+ objPtr->typePtr = &assembleCodeType;
+ TclFreeCompileEnv(&compEnv);
- /* Report on what the assembler did. */
+ /*
+ * Record the local variable context to which the bytecode pertains
+ */
+
+ codePtr = objPtr->internalRep.otherValuePtr;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
+ }
+
+ /*
+ * Report on what the assembler did.
+ */
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ fflush(stdout);
}
+#endif /* TCL_COMPILE_DEBUG */
+
return codePtr;
}
@@ -855,46 +905,45 @@ CompileAssembleObj(
* Returns a standard Tcl result.
*
* Side effects:
- * Puts the result of assembling the code into the bytecode stream
- * in 'compileEnv'.
+ * Puts the result of assembling the code into the bytecode stream in
+ * 'compileEnv'.
*
* This procedure makes sure that the command has a single arg, which is
- * constant. If that condition is met, the procedure calls TclAssembleCode
- * to produce bytecode for the given assembly code, and returns any error
+ * constant. If that condition is met, the procedure calls TclAssembleCode to
+ * produce bytecode for the given assembly code, and returns any error
* resulting from the assembly.
*
*-----------------------------------------------------------------------------
*/
-int TclCompileAssembleCmd(
+int
+TclCompileAssembleCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
-{
+{
Tcl_Token *tokenPtr; /* Token in the input script */
- int status; /* Status return from assembling the code */
- /* Make sure that the command has a single arg */
+ /*
+ * Make sure that the command has a single arg that is a simple word.
+ */
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
-
- /* Make sure that the arg is a simple word */
-
tokenPtr = TokenAfter(parsePtr->tokenPtr);
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
- /* Compile the code and return any error from the compilation */
-
- status = TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
- return status;
+ /*
+ * Compile the code and return any error from the compilation.
+ */
+ return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
}
/*
@@ -902,13 +951,12 @@ int TclCompileAssembleCmd(
*
* TclAssembleCode --
*
- * Take a list of instructions in a Tcl_Obj, and assemble them to
- * Tcl bytecodes
+ * Take a list of instructions in a Tcl_Obj, and assemble them to Tcl
+ * bytecodes
*
* Results:
- * Returns TCL_OK on success, TCL_ERROR on failure.
- * If 'flags' includes TCL_EVAL_DIRECT, places an error message
- * in the interpreter result.
+ * Returns TCL_OK on success, TCL_ERROR on failure. If 'flags' includes
+ * TCL_EVAL_DIRECT, places an error message in the interpreter result.
*
* Side effects:
* Adds byte codes to the compile environment, and updates the
@@ -918,36 +966,35 @@ int TclCompileAssembleCmd(
*/
static int
-TclAssembleCode(CompileEnv *envPtr,
- /* Compilation environment that is to
- * receive the generated bytecode */
- const char* codePtr,
- /* Assembly-language code to be processed */
- int codeLen, /* Length of the code */
- int flags) /* OR'ed combination of flags */
+TclAssembleCode(
+ CompileEnv *envPtr, /* Compilation environment that is to receive
+ * the generated bytecode */
+ const char* codePtr, /* Assembly-language code to be processed */
+ int codeLen, /* Length of the code */
+ int flags) /* OR'ed combination of flags */
{
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
- /*
- * Walk through the assembly script using the Tcl parser.
- * Each 'command' will be an instruction or assembly directive.
+ /*
+ * Walk through the assembly script using the Tcl parser. Each 'command'
+ * will be an instruction or assembly directive.
*/
const char* instPtr = codePtr;
/* Where to start looking for a line of code */
- int instLen; /* Length in bytes of the current line of
+ int instLen; /* Length in bytes of the current line of
* code */
const char* nextPtr; /* Pointer to the end of the line of code */
- int bytesLeft = codeLen; /* Number of bytes of source code remaining
- * to be parsed */
+ int bytesLeft = codeLen; /* Number of bytes of source code remaining to
+ * be parsed */
int status; /* Tcl status return */
-
AssemblyEnv* assemEnvPtr = NewAssemblyEnv(envPtr, flags);
Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
do {
-
- /* Parse out one command line from the assembly script */
+ /*
+ * Parse out one command line from the assembly script.
+ */
status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
instLen = parsePtr->commandSize;
@@ -955,42 +1002,50 @@ TclAssembleCode(CompileEnv *envPtr,
--instLen;
}
- /* Report errors in the parse */
+ /*
+ * Report errors in the parse.
+ */
if (status != TCL_OK) {
if (flags & TCL_EVAL_DIRECT) {
- Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
- instLen);
+ Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
+ instLen);
}
FreeAssemblyEnv(assemEnvPtr);
return TCL_ERROR;
}
- /* Advance the pointers around any leading commentary */
+ /*
+ * Advance the pointers around any leading commentary.
+ */
- TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr, parsePtr->commandStart);
- TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
- parsePtr->commandStart - envPtr->source);
+ TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr,
+ parsePtr->commandStart);
+ TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
+ parsePtr->commandStart - envPtr->source);
- /* Process the line of code */
+ /*
+ * Process the line of code.
+ */
if (parsePtr->numWords > 0) {
-
- /* If tracing, show each line assembled as it happens */
+ /*
+ * If tracing, show each line assembled as it happens.
+ */
#ifdef TCL_COMPILE_DEBUG
if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) {
printf(" %4d Assembling: ",
- envPtr->codeNext - envPtr->codeStart);
+ envPtr->codeNext - envPtr->codeStart);
TclPrintSource(stdout, parsePtr->commandStart,
- TclMin(instLen, 55));
+ TclMin(instLen, 55));
printf("\n");
}
#endif
if (AssembleOneLine(assemEnvPtr) != TCL_OK) {
if (flags & TCL_EVAL_DIRECT) {
- Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
- instLen);
+ Tcl_LogCommandInfo(interp, codePtr,
+ parsePtr->commandStart, instLen);
}
Tcl_FreeParse(parsePtr);
FreeAssemblyEnv(assemEnvPtr);
@@ -998,18 +1053,23 @@ TclAssembleCode(CompileEnv *envPtr,
}
}
- /* Advance to the next line of code */
+ /*
+ * Advance to the next line of code.
+ */
nextPtr = parsePtr->commandStart + parsePtr->commandSize;
bytesLeft -= (nextPtr - instPtr);
instPtr = nextPtr;
- TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart, instPtr);
+ TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart,
+ instPtr);
TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
- instPtr - envPtr->source);
+ instPtr - envPtr->source);
Tcl_FreeParse(parsePtr);
} while (bytesLeft > 0);
- /* Done with parsing the code */
+ /*
+ * Done with parsing the code.
+ */
status = FinishAssembly(assemEnvPtr);
FreeAssemblyEnv(assemEnvPtr);
@@ -1030,10 +1090,10 @@ TclAssembleCode(CompileEnv *envPtr,
*/
static AssemblyEnv*
-NewAssemblyEnv(CompileEnv* envPtr,
- /* Compilation environment being used
- * for code generation*/
- int flags) /* Compilation flags (TCL_EVAL_DIRECT) */
+NewAssemblyEnv(
+ CompileEnv* envPtr, /* Compilation environment being used for code
+ * generation*/
+ int flags) /* Compilation flags (TCL_EVAL_DIRECT) */
{
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
@@ -1047,21 +1107,26 @@ NewAssemblyEnv(CompileEnv* envPtr,
assemEnvPtr->cmdLine = envPtr->line;
assemEnvPtr->clNext = envPtr->clNext;
- /* Make the hashtables that store symbol resolution */
+ /*
+ * Make the hashtables that store symbol resolution.
+ */
Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS);
- /* Start the first basic block */
+ /*
+ * Start the first basic block.
+ */
assemEnvPtr->curr_bb = NULL;
assemEnvPtr->head_bb = AllocBB(assemEnvPtr);
assemEnvPtr->curr_bb = assemEnvPtr->head_bb;
assemEnvPtr->head_bb->startLine = 1;
- /* Stash compilation flags */
+ /*
+ * Stash compilation flags.
+ */
assemEnvPtr->flags = flags;
-
return assemEnvPtr;
}
@@ -1076,43 +1141,56 @@ NewAssemblyEnv(CompileEnv* envPtr,
*/
static void
-FreeAssemblyEnv(AssemblyEnv* assemEnvPtr)
- /* Environment to free */
+FreeAssemblyEnv(
+ AssemblyEnv* assemEnvPtr) /* Environment to free */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
- /* Compilation environment being used
- * for code generation */
+ /* Compilation environment being used for code
+ * generation */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
-
BasicBlock* thisBB; /* Pointer to a basic block being deleted */
- BasicBlock* nextBB; /* Pointer to a deleted basic block's
+ BasicBlock* nextBB; /* Pointer to a deleted basic block's
* successor */
- Tcl_HashEntry* hashEntry;
- Tcl_HashSearch hashSearch;
- /* Free all the basic block structures */
+ /*
+ * Free all the basic block structures.
+ */
+
for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
if (thisBB->jumpTarget != NULL) {
Tcl_DecrRefCount(thisBB->jumpTarget);
}
if (thisBB->foreignExceptions != NULL) {
- ckfree((char*)(thisBB->foreignExceptions));
+ ckfree((char*) thisBB->foreignExceptions);
}
nextBB = thisBB->successor1;
if (thisBB->jtPtr != NULL) {
DeleteMirrorJumpTable(thisBB->jtPtr);
thisBB->jtPtr = NULL;
}
- ckfree((char*)thisBB);
+ ckfree((char*) thisBB);
}
- /* Free the label hash */
- while ((hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash,
- &hashSearch)) != NULL) {
+ /*
+ * Free the label hash.
+ */
+
+ while (1) {
+ Tcl_HashEntry* hashEntry;
+ Tcl_HashSearch hashSearch;
+
+ hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash, &hashSearch);
+ if (hashEntry == NULL) {
+ break;
+ }
Tcl_DeleteHashEntry(hashEntry);
}
+ /*
+ * Dispose what's left.
+ */
+
TclStackFree(interp, assemEnvPtr->parsePtr);
TclStackFree(interp, assemEnvPtr);
}
@@ -1125,20 +1203,20 @@ FreeAssemblyEnv(AssemblyEnv* assemEnvPtr)
* Assembles a single command from an assembly language source.
*
* Results:
- * Returns TCL_ERROR with an appropriate error message if the
- * assembly fails. Returns TCL_OK if the assembly succeeds. Updates
- * the assembly environment with the state of the assembly.
+ * Returns TCL_ERROR with an appropriate error message if the assembly
+ * fails. Returns TCL_OK if the assembly succeeds. Updates the assembly
+ * environment with the state of the assembly.
*
*-----------------------------------------------------------------------------
*/
static int
-AssembleOneLine(AssemblyEnv* assemEnvPtr)
- /* State of the assembly */
+AssembleOneLine(
+ AssemblyEnv* assemEnvPtr) /* State of the assembly */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
- /* Compilation environment being used for
- * code gen */
+ /* Compilation environment being used for code
+ * gen */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
@@ -1146,13 +1224,13 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
Tcl_Token* tokenPtr; /* Current token within the line of code */
Tcl_Obj* instNameObj = NULL;
/* Name of the instruction */
- int tblind; /* Index in TalInstructionTable of the
+ int tblIdx; /* Index in TalInstructionTable of the
* instruction */
enum TalInstType instType; /* Type of the instruction */
Tcl_Obj* operand1Obj = NULL;
/* First operand to the instruction */
const char* operand1; /* String rep of the operand */
- int operand1Len; /* String length of the operand */
+ int operand1Len; /* String length of the operand */
int opnd; /* Integer representation of an operand */
int litIndex; /* Literal pool index of a constant */
int localVar; /* LVT index of a local variable */
@@ -1160,8 +1238,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
JumptableInfo* jtPtr; /* Pointer to a jumptable */
int infoIndex; /* Index of the jumptable in auxdata */
int status = TCL_ERROR; /* Return value from this function */
-
- /* Make sure that the instruction name is known at compile time. */
+
+ /*
+ * Make sure that the instruction name is known at compile time.
+ */
tokenPtr = parsePtr->tokenPtr;
instNameObj = Tcl_NewObj();
@@ -1170,18 +1250,21 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
return TCL_ERROR;
}
- /* Look up the instruction name */
-
+ /*
+ * Look up the instruction name.
+ */
+
if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
- &TalInstructionTable[0].name,
- sizeof(TalInstDesc), "instruction",
- TCL_EXACT, &tblind) != TCL_OK) {
+ &TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
+ TCL_EXACT, &tblIdx) != TCL_OK) {
return TCL_ERROR;
}
- /* Vector on the type of instruction being processed */
+ /*
+ * Vector on the type of instruction being processed.
+ */
- instType = TalInstructionTable[tblind].instType;
+ instType = TalInstructionTable[tblIdx].instType;
switch (instType) {
case ASSEM_PUSH:
@@ -1194,7 +1277,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
}
operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
- BBEmitInst1or4(assemEnvPtr, tblind, litIndex, 0);
+ BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
break;
case ASSEM_1BYTE:
@@ -1202,16 +1285,17 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
goto cleanup;
}
- BBEmitOpcode(assemEnvPtr, tblind, 0);
+ BBEmitOpcode(assemEnvPtr, tblIdx, 0);
break;
case ASSEM_BEGIN_CATCH:
- /*
+ /*
* Emit the BEGIN_CATCH instruction with the code offset of the
- * exception branch target instead of the exception range index.
- * The correct index will be generated and inserted later, when
- * catches are being resolved.
+ * exception branch target instead of the exception range index. The
+ * correct index will be generated and inserted later, when catches
+ * are being resolved.
*/
+
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
goto cleanup;
@@ -1220,8 +1304,8 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
- assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart;
- BBEmitInstInt4(assemEnvPtr, tblind, 0, 0);
+ assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
+ BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
assemEnvPtr->curr_bb->flags |= BB_BEGINCATCH;
StartBasicBlock(assemEnvPtr, BB_FALLTHRU, operand1Obj);
break;
@@ -1234,7 +1318,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
break;
case ASSEM_BOOL_LVT4:
@@ -1243,10 +1327,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
goto cleanup;
}
- BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
TclEmitInt4(localVar, envPtr);
break;
@@ -1256,11 +1340,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckOneByte(interp, opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ || CheckOneByte(interp, opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt1(assemEnvPtr, tblind, opnd, opnd);
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
break;
case ASSEM_DICT_GET:
@@ -1269,10 +1353,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
break;
case ASSEM_DICT_SET:
@@ -1281,11 +1365,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK
+ || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
TclEmitInt4(localVar, envPtr);
break;
@@ -1295,11 +1379,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK
+ || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
TclEmitInt4(localVar, envPtr);
break;
@@ -1309,34 +1393,37 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
assemEnvPtr->curr_bb->flags |= BB_ENDCATCH;
- BBEmitOpcode(assemEnvPtr, tblind, 0);
+ BBEmitOpcode(assemEnvPtr, tblIdx, 0);
StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
break;
case ASSEM_EVAL:
- /* TODO - Refactor this stuff into a subroutine
- * that takes the inst code, the message ("script" or "expression")
- * and an evaluator callback that calls TclCompileScript or
- * TclCompileExpr.
- */
+ /* TODO - Refactor this stuff into a subroutine that takes the inst
+ * code, the message ("script" or "expression") and an evaluator
+ * callback that calls TclCompileScript or TclCompileExpr. */
+
if (parsePtr->numWords != 2) {
- Tcl_WrongNumArgs(interp, 1, &instNameObj,
- ((TalInstructionTable[tblind].tclInstCode
- == INST_EVAL_STK) ? "script" : "expression"));
+ Tcl_WrongNumArgs(interp, 1, &instNameObj,
+ ((TalInstructionTable[tblIdx].tclInstCode
+ == INST_EVAL_STK) ? "script" : "expression"));
goto cleanup;
}
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
- TalInstructionTable+tblind);
+ CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
+ TalInstructionTable+tblIdx);
} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
- &operand1Obj) != TCL_OK) {
+ &operand1Obj) != TCL_OK) {
goto cleanup;
} else {
operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
- /* Assumes that PUSH is the first slot! */
+
+ /*
+ * Assumes that PUSH is the first slot!
+ */
+
BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
- BBEmitOpcode(assemEnvPtr, tblind, 0);
+ BBEmitOpcode(assemEnvPtr, tblIdx, 0);
}
break;
@@ -1346,14 +1433,14 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
goto cleanup;
}
-
- BBEmitInst1or4(assemEnvPtr, tblind, opnd, opnd);
+
+ BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
break;
-
- case ASSEM_JUMP:
+
+ case ASSEM_JUMP:
case ASSEM_JUMP4:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
@@ -1362,25 +1449,26 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
goto cleanup;
}
- assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart;
+ assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
if (instType == ASSEM_JUMP) {
flags = BB_JUMP1;
- BBEmitInstInt1(assemEnvPtr, tblind, 0, 0);
+ BBEmitInstInt1(assemEnvPtr, tblIdx, 0, 0);
} else {
flags = 0;
- BBEmitInstInt4(assemEnvPtr, tblind, 0, 0);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
}
-
- /* Start a new basic block at the instruction following the jump */
+
+ /*
+ * Start a new basic block at the instruction following the jump.
+ */
assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
- if (TalInstructionTable[tblind].operandsConsumed != 0) {
+ if (TalInstructionTable[tblIdx].operandsConsumed != 0) {
flags |= BB_FALLTHRU;
}
StartBasicBlock(assemEnvPtr, flags, operand1Obj);
-
break;
-
+
case ASSEM_JUMPTABLE:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
@@ -1389,16 +1477,20 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
goto cleanup;
}
+
jtPtr = (JumptableInfo*) ckalloc(sizeof(JumptableInfo));
+
Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
- assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext - envPtr->codeStart;
- /*fprintf(stderr, "bb %p jumpLine %d jumpOffset %d\n",
+ assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
+ DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n",
assemEnvPtr->curr_bb, assemEnvPtr->cmdLine,
- envPtr->codeNext - envPtr->codeStart); fflush(stderr); */
+ envPtr->codeNext - envPtr->codeStart);
+
infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
- /* fprintf(stderr, "auxdata index=%d\n", infoIndex); */
- BBEmitInstInt4(assemEnvPtr, tblind, infoIndex, 0);
+ DEBUG_PRINT("auxdata index=%d\n", infoIndex);
+
+ BBEmitInstInt4(assemEnvPtr, tblIdx, infoIndex, 0);
if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) {
goto cleanup;
}
@@ -1406,7 +1498,6 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
break;
case ASSEM_LABEL:
-
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "name");
goto cleanup;
@@ -1414,7 +1505,11 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
goto cleanup;
}
- /* Add the (label_name, address) pair to the hash table */
+
+ /*
+ * Add the (label_name, address) pair to the hash table.
+ */
+
if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
goto cleanup;
}
@@ -1426,24 +1521,24 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
break;
-
+
case ASSEM_LIST:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckNonNegative(interp, opnd) != TCL_OK) {
+ || CheckNonNegative(interp, opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
break;
-
+
case ASSEM_INDEX:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
@@ -1452,7 +1547,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
break;
case ASSEM_LSET_FLAT:
@@ -1466,14 +1561,14 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if (opnd < 2) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("operand must be >=2", -1));
+ Tcl_NewStringObj("operand must be >=2", -1));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
}
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
break;
-
+
case ASSEM_LVT:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
@@ -1482,7 +1577,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
goto cleanup;
}
- BBEmitInst1or4(assemEnvPtr, tblind, localVar, 0);
+ BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
break;
case ASSEM_LVT1:
@@ -1491,10 +1586,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)) {
+ || CheckOneByte(interp, localVar)) {
goto cleanup;
}
- BBEmitInstInt1(assemEnvPtr, tblind, localVar, 0);
+ BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
break;
case ASSEM_LVT1_SINT1:
@@ -1503,12 +1598,12 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)
- || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckSignedOneByte(interp, opnd)) {
+ || CheckOneByte(interp, localVar)
+ || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckSignedOneByte(interp, opnd)) {
goto cleanup;
}
- BBEmitInstInt1(assemEnvPtr, tblind, localVar, 0);
+ BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
TclEmitInt1(opnd, envPtr);
break;
@@ -1520,7 +1615,7 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, localVar, 0);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
break;
case ASSEM_OVER:
@@ -1529,10 +1624,10 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckNonNegative(interp, opnd) != TCL_OK) {
+ || CheckNonNegative(interp, opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
break;
case ASSEM_REGEXP:
@@ -1545,7 +1640,8 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
}
{
int flags = TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0);
- BBEmitInstInt1(assemEnvPtr, tblind, flags, 0);
+
+ BBEmitInstInt1(assemEnvPtr, tblIdx, flags, 0);
}
break;
@@ -1555,22 +1651,22 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckNonNegative(interp, opnd) != TCL_OK) {
+ || CheckNonNegative(interp, opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
break;
-
+
case ASSEM_SINT1:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckSignedOneByte(interp, opnd) != TCL_OK) {
+ || CheckSignedOneByte(interp, opnd) != TCL_OK) {
goto cleanup;
}
- BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
+ BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
break;
case ASSEM_SINT4_LVT4:
@@ -1579,16 +1675,16 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
goto cleanup;
}
- BBEmitInstInt4(assemEnvPtr, tblind, opnd, 0);
+ BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
TclEmitInt4(localVar, envPtr);
break;
default:
Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
- Tcl_GetString(instNameObj));
+ Tcl_GetString(instNameObj));
}
status = TCL_OK;
@@ -1609,18 +1705,17 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
*
* Compile an embedded 'eval' or 'expr' that appears in assembly code.
*
- * This procedure is called when the 'eval' or 'expr' assembly directive
- * is encountered, and the argument to the directive is a simple word that
+ * This procedure is called when the 'eval' or 'expr' assembly directive is
+ * encountered, and the argument to the directive is a simple word that
* requires no substitution. The appropriate compiler (TclCompileScript or
* TclCompileExpr) is invoked recursively, and emits bytecode.
*
* Before the compiler is invoked, the compilation environment's stack
- * consumption is reset to zero. Upon return from the compilation, the
- * net stack effect of the compilation is in the compiler env, and this
- * stack effect is posted to the assembler environment. The compile
- * environment's stack consumption is then restored to what it was
- * before (which is actually the state of the stack on entry to the block
- * of assembly code).
+ * consumption is reset to zero. Upon return from the compilation, the net
+ * stack effect of the compilation is in the compiler env, and this stack
+ * effect is posted to the assembler environment. The compile environment's
+ * stack consumption is then restored to what it was before (which is actually
+ * the state of the stack on entry to the block of assembly code).
*
* Any exception ranges pushed by the compilation are copied to the basic
* block and removed from the compiler environment. They will be rebuilt at
@@ -1630,25 +1725,22 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
*/
static void
-CompileEmbeddedScript(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- Tcl_Token* tokenPtr,
- /* Tcl_Token containing the script */
- TalInstDesc* instPtr)
- /* Instruction that determines whether
+CompileEmbeddedScript(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token* tokenPtr, /* Tcl_Token containing the script */
+ TalInstDesc* instPtr) /* Instruction that determines whether
* the script is 'expr' or 'eval' */
{
- /*
- * The expression or script is not only known at compile time,
- * but actually a "simple word". It can be compiled inline by
- * invoking the compiler recursively.
- */
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
- /*
+ /*
+ * The expression or script is not only known at compile time, but
+ * actually a "simple word". It can be compiled inline by invoking the
+ * compiler recursively.
+ *
* Save away the stack depth and reset it before compiling the script.
* We'll record the stack usage of the script in the BasicBlock, and
* accumulate it together with the stack usage of the enclosing assembly
@@ -1673,26 +1765,29 @@ CompileEmbeddedScript(AssemblyEnv* assemEnvPtr,
break;
default:
Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen",
- instPtr->name, instPtr->tclInstCode);
+ instPtr->name, instPtr->tclInstCode);
}
- /*
+ /*
* Roll up the stack usage of the embedded block into the assembler
* environment.
*/
+
SyncStackDepth(assemEnvPtr);
envPtr->currStackDepth = savedStackDepth;
envPtr->maxStackDepth = savedMaxStackDepth;
- /*
- * Save any exception ranges that were pushed by the compiler, They
- * will need to be fixed up once the stack depth is known.
+ /*
+ * Save any exception ranges that were pushed by the compiler; they will
+ * need to be fixed up once the stack depth is known.
*/
- MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex,
- savedExceptArrayNext);
+ MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex,
+ savedExceptArrayNext);
- /* Flush the current basic block */
+ /*
+ * Flush the current basic block.
+ */
StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
}
@@ -1702,24 +1797,21 @@ CompileEmbeddedScript(AssemblyEnv* assemEnvPtr,
*
* SyncStackDepth --
*
- * Copies the stack depth from the compile environment to a basic
- * block.
+ * Copies the stack depth from the compile environment to a basic block.
*
* Side effects:
- * Current and max stack depth in the current basic block are
- * adjusted.
+ * Current and max stack depth in the current basic block are adjusted.
*
- * This procedure is called on return from invoking the compiler for
- * the 'eval' and 'expr' operations. It adjusts the stack depth of the
- * current basic block to reflect the stack required by the just-compiled
- * code.
+ * This procedure is called on return from invoking the compiler for the
+ * 'eval' and 'expr' operations. It adjusts the stack depth of the current
+ * basic block to reflect the stack required by the just-compiled code.
*
*-----------------------------------------------------------------------------
*/
static void
-SyncStackDepth(AssemblyEnv* assemEnvPtr)
- /* Assembly environment */
+SyncStackDepth(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -1748,12 +1840,10 @@ SyncStackDepth(AssemblyEnv* assemEnvPtr)
*/
static void
-MoveExceptionRangesToBasicBlock(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- int savedCodeIndex,
- /* Start of the embedded code */
- int savedExceptArrayNext)
- /* Saved index of the end of the exception
+MoveExceptionRangesToBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int savedCodeIndex, /* Start of the embedded code */
+ int savedExceptArrayNext) /* Saved index of the end of the exception
* range array */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
@@ -1769,59 +1859,56 @@ MoveExceptionRangesToBasicBlock(AssemblyEnv* assemEnvPtr,
return;
}
- /*
- * Save the exception ranges in the basic block. They will be re-added
- * at the conclusion of assembly; at this time, the INST_BEGIN_CATCH
- * instructions in the block will be adjusted from whatever range
- * indices they have [savedExceptArrayNext .. envPtr->exceptArrayNext)
- * to the indices that the exceptions acquire. The saved exception ranges
- * are converted to a relative nesting depth. The depth will be recomputed
+ /*
+ * Save the exception ranges in the basic block. They will be re-added at
+ * the conclusion of assembly; at this time, the INST_BEGIN_CATCH
+ * instructions in the block will be adjusted from whatever range indices
+ * they have [savedExceptArrayNext .. envPtr->exceptArrayNext) to the
+ * indices that the exceptions acquire. The saved exception ranges are
+ * converted to a relative nesting depth. The depth will be recomputed
* once flow analysis has determined the actual stack depth of the block.
*/
- /*fprintf(stderr, "basic block %p has %d exceptions starting at %d\n",
- curr_bb, exceptionCount, savedExceptArrayNext); */
+ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n",
+ curr_bb, exceptionCount, savedExceptArrayNext);
curr_bb->foreignExceptionBase = savedExceptArrayNext;
curr_bb->foreignExceptionCount = exceptionCount;
curr_bb->foreignExceptions = (ExceptionRange*)
- ckalloc(exceptionCount * sizeof(ExceptionRange));
+ ckalloc(exceptionCount * sizeof(ExceptionRange));
memcpy(curr_bb->foreignExceptions,
- envPtr->exceptArrayPtr + savedExceptArrayNext,
- exceptionCount * sizeof(ExceptionRange));
+ envPtr->exceptArrayPtr + savedExceptArrayNext,
+ exceptionCount * sizeof(ExceptionRange));
for (i = 0; i < exceptionCount; ++i) {
curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth;
}
envPtr->exceptArrayNext = savedExceptArrayNext;
-
}
/*
*-----------------------------------------------------------------------------
- *
+ *
* CreateMirrorJumpTable --
*
* Makes a jump table with comparison values and assembly code labels.
*
* Results:
- * Returns a standard Tcl status, with an error message in the interpreter
- * on error.
+ * Returns a standard Tcl status, with an error message in the
+ * interpreter on error.
*
* Side effects:
- * Initializes the jump table pointer in the current basic block to
- * a JumptableInfo. The keys in the JumptableInfo are the comparison
+ * Initializes the jump table pointer in the current basic block to a
+ * JumptableInfo. The keys in the JumptableInfo are the comparison
* strings. The values, instead of being jump displacements, are
* Tcl_Obj's with the code labels.
*/
static int
-CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- Tcl_Obj* jumps)
- /* List of alternating keywords and labels */
+CreateMirrorJumpTable(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Obj* jumps) /* List of alternating keywords and labels */
{
int objc; /* Number of elements in the 'jumps' list */
Tcl_Obj** objv; /* Pointers to the elements in the list */
-
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
@@ -1831,7 +1918,8 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
JumptableInfo* jtPtr;
Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */
Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */
- int isNew; /* Flag==1 if the key is not yet in the table */
+ int isNew; /* Flag==1 if the key is not yet in the
+ * table. */
Tcl_Obj* result; /* Error message */
int i;
@@ -1840,33 +1928,36 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
}
if (objc % 2 != 0) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("jump table must have an "
- "even number of list "
- "elements", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "jump table must have an even number of list elements",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
}
return TCL_ERROR;
}
-
- /* Allocate the jumptable */
+
+ /*
+ * Allocate the jumptable.
+ */
jtPtr = (JumptableInfo*) ckalloc(sizeof(JumptableInfo));
- jtHashPtr = &(jtPtr->hashTable);
+ jtHashPtr = &jtPtr->hashTable;
Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);
- /* Fill the keys and labels into the table */
+ /*
+ * Fill the keys and labels into the table.
+ */
- /* fprintf(stderr, "jump table {\n"); */
+ DEBUG_PRINT("jump table {\n");
for (i = 0; i < objc; i+=2) {
- /* fprintf(stderr, " %s -> %s\n", Tcl_GetString(objv[i]),
- Tcl_GetString(objv[i+1])); fflush(stderr); */
+ DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]),
+ Tcl_GetString(objv[i+1]));
hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]),
- &isNew);
+ &isNew);
if (!isNew) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- result = Tcl_NewStringObj("duplicate entry in jump table for "
- "\"", -1);
+ result = Tcl_NewStringObj(
+ "duplicate entry in jump table for \"", -1);
Tcl_AppendObjToObj(result, objv[i]);
Tcl_AppendToObj(result, "\"", -1);
Tcl_SetObjResult(interp, result);
@@ -1878,13 +1969,13 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
Tcl_SetHashValue(hashEntry, (ClientData) objv[i+1]);
Tcl_IncrRefCount(objv[i+1]);
}
- /* fprintf(stderr, "}\n"); fflush(stderr); */
-
+ DEBUG_PRINT("}\n");
- /* Put the mirror jumptable in the basic block struct */
+ /*
+ * Put the mirror jumptable in the basic block struct.
+ */
bbPtr->jtPtr = jtPtr;
-
return TCL_OK;
}
@@ -1899,7 +1990,8 @@ CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
*/
static void
-DeleteMirrorJumpTable(JumptableInfo* jtPtr)
+DeleteMirrorJumpTable(
+ JumptableInfo* jtPtr)
{
Tcl_HashTable* jtHashPtr = &jtPtr->hashTable;
/* Hash table pointer */
@@ -1908,30 +2000,28 @@ DeleteMirrorJumpTable(JumptableInfo* jtPtr)
Tcl_Obj* label; /* Jump label from the hash table */
for (entry = Tcl_FirstHashEntry(jtHashPtr, &search);
- entry != NULL;
- entry = Tcl_NextHashEntry(&search)) {
- label = (Tcl_Obj*) Tcl_GetHashValue(entry);
+ entry != NULL;
+ entry = Tcl_NextHashEntry(&search)) {
+ label = Tcl_GetHashValue(entry);
Tcl_DecrRefCount(label);
Tcl_SetHashValue(entry, NULL);
}
Tcl_DeleteHashTable(jtHashPtr);
- ckfree((char*)jtPtr);
+ ckfree((char*) jtPtr);
}
-
/*
*-----------------------------------------------------------------------------
*
* GetNextOperand --
*
- * Retrieves the next operand in sequence from an assembly
- * instruction, and makes sure that its value is known at
- * compile time.
+ * Retrieves the next operand in sequence from an assembly instruction,
+ * and makes sure that its value is known at compile time.
*
* Results:
- * If successful, returns TCL_OK and leaves a Tcl_Obj with
- * the operand text in *operandObjPtr. In case of failure,
- * returns TCL_ERROR and leaves *operandObjPtr untouched.
+ * If successful, returns TCL_OK and leaves a Tcl_Obj with the operand
+ * text in *operandObjPtr. In case of failure, returns TCL_ERROR and
+ * leaves *operandObjPtr untouched.
*
* Side effects:
* Advances *tokenPtrPtr around the token just processed.
@@ -1940,24 +2030,21 @@ DeleteMirrorJumpTable(JumptableInfo* jtPtr)
*/
static int
-GetNextOperand(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- Tcl_Token** tokenPtrPtr,
- /* INPUT/OUTPUT: Pointer to the token
- * holding the operand */
- Tcl_Obj** operandObjPtr)
- /* OUTPUT: Tcl object holding the
- * operand text with \-substitutions
- * done. */
+GetNextOperand(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* INPUT/OUTPUT: Pointer to the token holding
+ * the operand */
+ Tcl_Obj** operandObjPtr) /* OUTPUT: Tcl object holding the operand text
+ * with \-substitutions done. */
{
Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr;
Tcl_Obj* operandObj = Tcl_NewObj();
+
if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
Tcl_DecrRefCount(operandObj);
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("assembly code may not "
- "contain substitutions", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "assembly code may not contain substitutions", -1));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
}
return TCL_ERROR;
@@ -1988,33 +2075,35 @@ GetNextOperand(AssemblyEnv* assemEnvPtr,
*/
static int
-GetBooleanOperand(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- Tcl_Token** tokenPtrPtr,
- /* Current token from the parser */
- int* result)
- /* OUTPUT: Integer extracted from the token */
+GetBooleanOperand(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* Current token from the parser */
+ int* result) /* OUTPUT: Integer extracted from the token */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Token* tokenPtr = *tokenPtrPtr;
- /* INOUT: Pointer to the next token
- * in the source code */
+ /* INOUT: Pointer to the next token in the
+ * source code */
Tcl_Obj* intObj = Tcl_NewObj();
/* Integer from the source code */
int status; /* Tcl status return */
- /* Extract the next token as a string */
+ /*
+ * Extract the next token as a string.
+ */
Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
-
- /* Convert to an integer, advance to the next token and return */
+
+ /*
+ * Convert to an integer, advance to the next token and return.
+ */
status = Tcl_GetBooleanFromObj(interp, intObj, result);
Tcl_DecrRefCount(intObj);
@@ -2027,48 +2116,50 @@ GetBooleanOperand(AssemblyEnv* assemEnvPtr,
*
* GetIntegerOperand --
*
- * Retrieves an integer operand from the input stream and advances
- * the token pointer.
+ * Retrieves an integer operand from the input stream and advances the
+ * token pointer.
*
* Results:
* Returns a standard Tcl result (with an error message in the
* interpreter on failure).
*
* Side effects:
- * Stores the integer value in (*result) and advances (*tokenPtrPtr)
- * to the next token.
+ * Stores the integer value in (*result) and advances (*tokenPtrPtr) to
+ * the next token.
*
*-----------------------------------------------------------------------------
*/
static int
-GetIntegerOperand(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- Tcl_Token** tokenPtrPtr,
- /* Current token from the parser */
- int* result)
- /* OUTPUT: Integer extracted from the token */
+GetIntegerOperand(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* Current token from the parser */
+ int* result) /* OUTPUT: Integer extracted from the token */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Token* tokenPtr = *tokenPtrPtr;
- /* INOUT: Pointer to the next token
- * in the source code */
+ /* INOUT: Pointer to the next token in the
+ * source code */
Tcl_Obj* intObj = Tcl_NewObj();
/* Integer from the source code */
int status; /* Tcl status return */
- /* Extract the next token as a string */
+ /*
+ * Extract the next token as a string.
+ */
Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
-
- /* Convert to an integer, advance to the next token and return */
+
+ /*
+ * Convert to an integer, advance to the next token and return.
+ */
status = Tcl_GetIntFromObj(interp, intObj, result);
Tcl_DecrRefCount(intObj);
@@ -2084,8 +2175,8 @@ GetIntegerOperand(AssemblyEnv* assemEnvPtr,
* Gets the value of an operand intended to serve as a list index.
*
* Results:
- * Returns a standard Tcl result: TCL_OK if the parse is successful
- * and TCL_ERROR (with an appropriate error message) if the parse fails.
+ * Returns a standard Tcl result: TCL_OK if the parse is successful and
+ * TCL_ERROR (with an appropriate error message) if the parse fails.
*
* Side effects:
* Stores the list index at '*index'. Values between -1 and 0x7fffffff
@@ -2097,25 +2188,24 @@ GetIntegerOperand(AssemblyEnv* assemEnvPtr,
static int
GetListIndexOperand(
- AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- Tcl_Token** tokenPtrPtr,
- /* Current token from the parser */
- int* result)
- /* OUTPUT: Integer extracted from the token */
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr, /* Current token from the parser */
+ int* result) /* OUTPUT: Integer extracted from the token */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Token* tokenPtr = *tokenPtrPtr;
- /* INOUT: Pointer to the next token
- * in the source code */
+ /* INOUT: Pointer to the next token in the
+ * source code */
Tcl_Obj* intObj = Tcl_NewObj();
/* Integer from the source code */
int status; /* Tcl status return */
- /* Extract the next token as a string */
+ /*
+ * Extract the next token as a string.
+ */
Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
@@ -2123,7 +2213,9 @@ GetListIndexOperand(
return TCL_ERROR;
}
- /* Convert to an integer, advance to the next token and return */
+ /*
+ * Convert to an integer, advance to the next token and return.
+ */
status = TclGetIntForIndex(interp, intObj, -2, result);
Tcl_DecrRefCount(intObj);
@@ -2140,22 +2232,22 @@ GetListIndexOperand(
* the token pointer.
*
* Results:
- * Returns the LVT index of the local variable. Returns -1 if
- * the variable is non-local, not known at compile time, or
- * cannot be installed in the LVT (leaving an error message in
- * the interpreter result if necessary).
+ * Returns the LVT index of the local variable. Returns -1 if the
+ * variable is non-local, not known at compile time, or cannot be
+ * installed in the LVT (leaving an error message in the interpreter
+ * result if necessary).
*
* Side effects:
- * Advances the token pointer. May define a new LVT slot if the
- * variable has not yet been seen and the execution context allows
- * for it.
+ * Advances the token pointer. May define a new LVT slot if the variable
+ * has not yet been seen and the execution context allows for it.
*
*-----------------------------------------------------------------------------
*/
static int
-FindLocalVar(AssemblyEnv* assemEnvPtr,
- Tcl_Token** tokenPtrPtr)
+FindLocalVar(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ Tcl_Token** tokenPtrPtr)
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -2183,10 +2275,9 @@ FindLocalVar(AssemblyEnv* assemEnvPtr,
Tcl_DecrRefCount(varNameObj);
if (localVar == -1) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("cannot use this instruction"
- " to create a variable"
- " in a non-proc context", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot use this instruction to create a variable"
+ " in a non-proc context", -1));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
}
return -1;
@@ -2204,30 +2295,27 @@ FindLocalVar(AssemblyEnv* assemEnvPtr,
* attempting to install it in the LVT.
*
* Results:
- * On success, returns TCL_OK. On failure, returns TCL_ERROR and
- * stores an error message in the interpreter result.
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
*
*-----------------------------------------------------------------------------
*/
static int
-CheckNamespaceQualifiers(Tcl_Interp* interp,
- /* Tcl interpreter for error reporting */
- const char* name,
- /* Variable name to check */
- int nameLen)
- /* Length of the variable */
+CheckNamespaceQualifiers(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ const char* name, /* Variable name to check */
+ int nameLen) /* Length of the variable */
{
Tcl_Obj* result; /* Error message */
const char* p;
- for (p = name; p+2 < name+nameLen; p++) {
+ for (p = name; p+2 < name+nameLen; p++) {
if ((*p == ':') && (p[1] == ':')) {
result = Tcl_NewStringObj("variable \"", -1);
Tcl_AppendToObj(result, name, -1);
Tcl_AppendToObj(result, "\" is not local", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name,
- NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
return TCL_ERROR;
}
}
@@ -2239,11 +2327,12 @@ CheckNamespaceQualifiers(Tcl_Interp* interp,
*
* CheckOneByte --
*
- * Verify that a constant fits in a single byte in the instruction stream.
+ * Verify that a constant fits in a single byte in the instruction
+ * stream.
*
* Results:
- * On success, returns TCL_OK. On failure, returns TCL_ERROR and
- * stores an error message in the interpreter result.
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
*
* This code is here primarily to verify that instructions like INCR_SCALAR1
* are possible on a given local variable. The fact that there is no
@@ -2253,11 +2342,12 @@ CheckNamespaceQualifiers(Tcl_Interp* interp,
*/
static int
-CheckOneByte(Tcl_Interp* interp,
- /* Tcl interpreter for error reporting */
- int value) /* Value to check */
+CheckOneByte(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
{
Tcl_Obj* result; /* Error message */
+
if (value < 0 || value > 0xff) {
result = Tcl_NewStringObj("operand does not fit in one byte", -1);
Tcl_SetObjResult(interp, result);
@@ -2273,11 +2363,11 @@ CheckOneByte(Tcl_Interp* interp,
* CheckSignedOneByte --
*
* Verify that a constant fits in a single signed byte in the instruction
- * stream.
+ * stream.
*
* Results:
- * On success, returns TCL_OK. On failure, returns TCL_ERROR and
- * stores an error message in the interpreter result.
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
*
* This code is here primarily to verify that instructions like INCR_SCALAR1
* are possible on a given local variable. The fact that there is no
@@ -2287,11 +2377,12 @@ CheckOneByte(Tcl_Interp* interp,
*/
static int
-CheckSignedOneByte(Tcl_Interp* interp,
- /* Tcl interpreter for error reporting */
- int value) /* Value to check */
+CheckSignedOneByte(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
{
Tcl_Obj* result; /* Error message */
+
if (value > 0x7f || value < -0x80) {
result = Tcl_NewStringObj("operand does not fit in one byte", -1);
Tcl_SetObjResult(interp, result);
@@ -2309,8 +2400,8 @@ CheckSignedOneByte(Tcl_Interp* interp,
* Verify that a constant is nonnegative
*
* Results:
- * On success, returns TCL_OK. On failure, returns TCL_ERROR and
- * stores an error message in the interpreter result.
+ * On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
+ * an error message in the interpreter result.
*
* This code is here primarily to verify that instructions like INCR_INVOKE
* are consuming a positive number of operands
@@ -2319,11 +2410,12 @@ CheckSignedOneByte(Tcl_Interp* interp,
*/
static int
-CheckNonNegative(Tcl_Interp* interp,
- /* Tcl interpreter for error reporting */
- int value) /* Value to check */
+CheckNonNegative(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
{
Tcl_Obj* result; /* Error message */
+
if (value < 0) {
result = Tcl_NewStringObj("operand must be nonnegative", -1);
Tcl_SetObjResult(interp, result);
@@ -2351,11 +2443,12 @@ CheckNonNegative(Tcl_Interp* interp,
*/
static int
-CheckStrictlyPositive(Tcl_Interp* interp,
- /* Tcl interpreter for error reporting */
- int value) /* Value to check */
+CheckStrictlyPositive(
+ Tcl_Interp* interp, /* Tcl interpreter for error reporting */
+ int value) /* Value to check */
{
Tcl_Obj* result; /* Error message */
+
if (value <= 0) {
result = Tcl_NewStringObj("operand must be positive", -1);
Tcl_SetObjResult(interp, result);
@@ -2373,16 +2466,17 @@ CheckStrictlyPositive(Tcl_Interp* interp,
* Defines a label appearing in the assembly sequence.
*
* Results:
- * Returns a standard Tcl result. Returns TCL_OK and an empty result
- * if the definition succeeds; returns TCL_ERROR and an appropriate
- * message if a duplicate definition is found.
+ * Returns a standard Tcl result. Returns TCL_OK and an empty result if
+ * the definition succeeds; returns TCL_ERROR and an appropriate message
+ * if a duplicate definition is found.
*
*-----------------------------------------------------------------------------
*/
static int
-DefineLabel(AssemblyEnv* assemEnvPtr, /* Assembly environment */
- const char* labelName) /* Label being defined */
+DefineLabel(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ const char* labelName) /* Label being defined */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -2397,31 +2491,33 @@ DefineLabel(AssemblyEnv* assemEnvPtr, /* Assembly environment */
StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
- /* Look up the newly-defined label in the symbol table */
+ /*
+ * Look up the newly-defined label in the symbol table.
+ */
entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
- if (isNew) {
-
- /* This is the first appearance of the label in the code */
-
- Tcl_SetHashValue(entry, assemEnvPtr->curr_bb);
-
- } else {
-
- /* This is a duplicate label */
+ if (!isNew) {
+ /*
+ * This is a duplicate label.
+ */
if (assemEnvPtr-> flags & (TCL_EVAL_DIRECT)) {
- result = Tcl_NewStringObj("duplicate definition "
- "of label \"", -1);
+ result = Tcl_NewStringObj(
+ "duplicate definition of label \"", -1);
Tcl_AppendToObj(result, labelName, -1);
Tcl_AppendToObj(result, "\"", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL",
- labelName, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL",
+ labelName, NULL);
}
return TCL_ERROR;
}
+ /*
+ * This is the first appearance of the label in the code.
+ */
+
+ Tcl_SetHashValue(entry, assemEnvPtr->curr_bb);
return TCL_OK;
}
@@ -2440,42 +2536,51 @@ DefineLabel(AssemblyEnv* assemEnvPtr, /* Assembly environment */
*/
static BasicBlock*
-StartBasicBlock(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- int flags, /* Flags to apply to the basic block
- * being closed, if there is one. */
- Tcl_Obj* jumpLabel)
- /* Label of the location that the
- * block jumps to, or NULL if the block
- * does not jump */
+StartBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int flags, /* Flags to apply to the basic block being
+ * closed, if there is one. */
+ Tcl_Obj* jumpLabel) /* Label of the location that the block jumps
+ * to, or NULL if the block does not jump */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
BasicBlock* newBB; /* BasicBlock structure for the new block */
BasicBlock* currBB = assemEnvPtr->curr_bb;
- /* Coalesce zero-length blocks */
+ /*
+ * Coalesce zero-length blocks.
+ */
if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) {
currBB->startLine = assemEnvPtr->cmdLine;
return currBB;
}
- /* Make the new basic block */
+ /*
+ * Make the new basic block.
+ */
newBB = AllocBB(assemEnvPtr);
- /* Record the jump target if there is one. */
+ /*
+ * Record the jump target if there is one.
+ */
- if ((currBB->jumpTarget = jumpLabel) != NULL) {
+ currBB->jumpTarget = jumpLabel;
+ if (jumpLabel != NULL) {
Tcl_IncrRefCount(currBB->jumpTarget);
}
- /* Record the fallthrough if there is one. */
+ /*
+ * Record the fallthrough if there is one.
+ */
currBB->flags |= flags;
- /* Record the successor block */
+ /*
+ * Record the successor block.
+ */
currBB->successor1 = newBB;
assemEnvPtr->curr_bb = newBB;
@@ -2496,15 +2601,15 @@ StartBasicBlock(AssemblyEnv* assemEnvPtr,
*-----------------------------------------------------------------------------
*/
-static BasicBlock *
-AllocBB(AssemblyEnv* assemEnvPtr)
- /* Assembly environment */
+static BasicBlock *
+AllocBB(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
BasicBlock * bb = (BasicBlock *) ckalloc(sizeof(BasicBlock));
bb->originalStartOffset =
- bb->startOffset = envPtr->codeNext - envPtr->codeStart;
+ bb->startOffset = envPtr->codeNext - envPtr->codeStart;
bb->startLine = assemEnvPtr->cmdLine + 1;
bb->jumpOffset = -1;
bb->jumpLine = -1;
@@ -2531,50 +2636,55 @@ AllocBB(AssemblyEnv* assemEnvPtr)
*
* FinishAssembly --
*
- * Postprocessing after all bytecode has been generated for a block
- * of assembly code.
+ * Postprocessing after all bytecode has been generated for a block of
+ * assembly code.
*
* Results:
* Returns a standard Tcl result, with an error message left in the
* interpreter if appropriate.
*
* Side effects:
- * The program is checked to see if any undefined labels remain.
- * The initial stack depth of all the basic blocks in the flow graph
- * is calculated and saved. The stack balance on exit is computed,
- * checked and saved.
+ * The program is checked to see if any undefined labels remain. The
+ * initial stack depth of all the basic blocks in the flow graph is
+ * calculated and saved. The stack balance on exit is computed, checked
+ * and saved.
*
*-----------------------------------------------------------------------------
*/
-static int
-FinishAssembly(AssemblyEnv* assemEnvPtr)
- /* Assembly environment */
+static int
+FinishAssembly(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
+ int mustMove; /* Amount by which the code needs to be grown
+ * because of expanding jumps */
- int mustMove; /* Amount by which the code needs to be
- * grown because of expanding jumps */
-
- /*
- * Resolve the targets of all jumps and determine whether code needs
- * to be moved around.
+ /*
+ * Resolve the targets of all jumps and determine whether code needs to be
+ * moved around.
*/
if (CalculateJumpRelocations(assemEnvPtr, &mustMove)) {
return TCL_ERROR;
}
- /* Move the code if necessary */
+ /*
+ * Move the code if necessary.
+ */
if (mustMove) {
MoveCodeForJumps(assemEnvPtr, mustMove);
}
- /* Resolve jump target labels to bytecode offsets */
+ /*
+ * Resolve jump target labels to bytecode offsets.
+ */
FillInJumpOffsets(assemEnvPtr);
- /* Label each basic block with its catch context. Quit on inconsistency */
+ /*
+ * Label each basic block with its catch context. Quit on inconsistency.
+ */
if (ProcessCatches(assemEnvPtr) != TCL_OK) {
return TCL_ERROR;
@@ -2589,7 +2699,9 @@ FinishAssembly(AssemblyEnv* assemEnvPtr)
return TCL_ERROR;
}
- /* Compute stack balance throughout the program */
+ /*
+ * Compute stack balance throughout the program.
+ */
if (CheckStack(assemEnvPtr) != TCL_OK) {
return TCL_ERROR;
@@ -2607,33 +2719,31 @@ FinishAssembly(AssemblyEnv* assemEnvPtr)
* CalculateJumpRelocations --
*
* Calculate any movement that has to be done in the assembly code to
- * expand JUMP1 instructions to JUMP4 (because they jump more than
- * a 1-byte range).
+ * expand JUMP1 instructions to JUMP4 (because they jump more than a
+ * 1-byte range).
*
* Results:
- * Returns a standard Tcl result, with an appropriate error message
- * if anything fails.
+ * Returns a standard Tcl result, with an appropriate error message if
+ * anything fails.
*
* Side effects:
- * Sets the 'startOffset' pointer in every basic block to the new
- * origin of the block, and turns off JUMP1 flags on instructions that
- * must be expanded (and adjusts them to the corresponding JUMP4's)
- * Does *not* store the jump offsets at this point.
+ * Sets the 'startOffset' pointer in every basic block to the new origin
+ * of the block, and turns off JUMP1 flags on instructions that must be
+ * expanded (and adjusts them to the corresponding JUMP4's). Does *not*
+ * store the jump offsets at this point.
*
* Sets *mustMove to 1 if and only if at least one instruction changed
* size so the code must be moved.
- *
- * As a side effect, also checks for undefined labels
- * and reports them.
+ *
+ * As a side effect, also checks for undefined labels and reports them.
*
*-----------------------------------------------------------------------------
*/
-
+
static int
-CalculateJumpRelocations(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- int* mustMove)
- /* OUTPUT: Number of bytes that have been
+CalculateJumpRelocations(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ int* mustMove) /* OUTPUT: Number of bytes that have been
* added to the code */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
@@ -2641,56 +2751,59 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr,
BasicBlock* bbPtr; /* Pointer to a basic block being checked */
Tcl_HashEntry* entry; /* Exit label's entry in the symbol table */
BasicBlock* jumpTarget; /* Basic block where the jump goes */
- int motion; /* Amount by which the code has expanded */
+ int motion; /* Amount by which the code has expanded */
int offset; /* Offset in the bytecode from a jump
* instruction to its target */
unsigned opcode; /* Opcode in the bytecode being adjusted */
- /* Iterate through basic blocks as long as a change results in
- * code expansion */
+ /*
+ * Iterate through basic blocks as long as a change results in code
+ * expansion.
+ */
*mustMove = 0;
do {
motion = 0;
for (bbPtr = assemEnvPtr->head_bb;
- bbPtr != NULL;
- bbPtr=bbPtr->successor1) {
-
- /*
- * Advance the basic block start offset by however many bytes
- * we have inserted in the code up to this point
+ bbPtr != NULL;
+ bbPtr=bbPtr->successor1) {
+ /*
+ * Advance the basic block start offset by however many bytes we
+ * have inserted in the code up to this point
*/
+
bbPtr->startOffset += motion;
- /*
- * If the basic block references a label (and hence performs
- * a jump), find the location of the label. Report an error if
- * the label is missing.
+ /*
+ * If the basic block references a label (and hence performs a
+ * jump), find the location of the label. Report an error if the
+ * label is missing.
*/
+
if (bbPtr->jumpTarget != NULL) {
- entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(bbPtr->jumpTarget));
if (entry == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr,
- bbPtr->jumpTarget);
+ bbPtr->jumpTarget);
return TCL_ERROR;
}
- /*
+ /*
* If the instruction is a JUMP1, turn it into a JUMP4 if its
* target is out of range.
*/
- jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+
+ jumpTarget = Tcl_GetHashValue(entry);
if (bbPtr->flags & BB_JUMP1) {
offset = jumpTarget->startOffset
- - (bbPtr->jumpOffset + motion);
+ - (bbPtr->jumpOffset + motion);
if (offset < -0x80 || offset > 0x7f) {
opcode = TclGetUInt1AtPtr(envPtr->codeStart
- + bbPtr->jumpOffset);
+ + bbPtr->jumpOffset);
++opcode;
- TclStoreInt1AtPtr(opcode,
- envPtr->codeStart
- + bbPtr->jumpOffset);
+ TclStoreInt1AtPtr(opcode,
+ envPtr->codeStart + bbPtr->jumpOffset);
motion += 3;
bbPtr->flags &= ~BB_JUMP1;
}
@@ -2698,9 +2811,9 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr,
}
/*
- * If the basic block references a jump table, that doesn't
- * affect the code locations, but resolve the labels now, and
- * store basic block pointers in the jumptable hash.
+ * If the basic block references a jump table, that doesn't affect
+ * the code locations, but resolve the labels now, and store basic
+ * block pointers in the jumptable hash.
*/
if (bbPtr->flags & BB_JUMPTABLE) {
@@ -2729,10 +2842,9 @@ CalculateJumpRelocations(AssemblyEnv* assemEnvPtr,
*/
static int
-CheckJumpTableLabels(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- BasicBlock* bbPtr)
- /* Basic block that ends in a jump table */
+CheckJumpTableLabels(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr) /* Basic block that ends in a jump table */
{
Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
/* Hash table with the symbols */
@@ -2741,25 +2853,27 @@ CheckJumpTableLabels(AssemblyEnv* assemEnvPtr,
Tcl_Obj* symbolObj; /* Jump target */
Tcl_HashEntry* valEntryPtr; /* Hash entry for the resolutions */
- /* Look up every jump target in the jump hash */
+ /*
+ * Look up every jump target in the jump hash.
+ */
- /* fprintf(stderr, "check jump table labels %p {\n", bbPtr); */
+ DEBUG_PRINT("check jump table labels %p {\n", bbPtr);
for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
- symEntryPtr != NULL;
- symEntryPtr = Tcl_NextHashEntry(&search)) {
- symbolObj = (Tcl_Obj*) Tcl_GetHashValue(symEntryPtr);
- valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(symbolObj));
- /* fprintf(stderr, " %s -> %s (%d)\n",
- (char*)Tcl_GetHashKey(symHash, symEntryPtr),
+ symEntryPtr != NULL;
+ symEntryPtr = Tcl_NextHashEntry(&search)) {
+ symbolObj = Tcl_GetHashValue(symEntryPtr);
+ valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(symbolObj));
+ DEBUG_PRINT(" %s -> %s (%d)\n",
+ (char*) Tcl_GetHashKey(symHash, symEntryPtr),
Tcl_GetString(symbolObj),
- (valEntryPtr != NULL)); fflush(stderr); */
+ (valEntryPtr != NULL));
if (valEntryPtr == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
return TCL_ERROR;
}
}
- /* fprintf(stderr, "}\n"); fflush(stderr); */
+ DEBUG_PRINT("}\n");
return TCL_OK;
}
@@ -2777,13 +2891,11 @@ CheckJumpTableLabels(AssemblyEnv* assemEnvPtr,
*-----------------------------------------------------------------------------
*/
static void
-ReportUndefinedLabel(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- BasicBlock* bbPtr,
- /* Basic block that contains the
- * undefined label */
- Tcl_Obj* jumpTarget)
- /* Label of a jump target */
+ReportUndefinedLabel(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr, /* Basic block that contains the undefined
+ * label */
+ Tcl_Obj* jumpTarget) /* Label of a jump target */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -2797,7 +2909,7 @@ ReportUndefinedLabel(AssemblyEnv* assemEnvPtr,
Tcl_AppendToObj(result, "\"", -1);
Tcl_SetObjResult(interp, result);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
- Tcl_GetString(jumpTarget), NULL);
+ Tcl_GetString(jumpTarget), NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
}
}
@@ -2814,35 +2926,34 @@ ReportUndefinedLabel(AssemblyEnv* assemEnvPtr,
*/
static void
-MoveCodeForJumps(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- int mustMove) /* Number of bytes of added code */
+MoveCodeForJumps(
+ AssemblyEnv* assemEnvPtr, /* Assembler environment */
+ int mustMove) /* Number of bytes of added code */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
BasicBlock* bbPtr; /* Pointer to a basic block being checked */
- int topOffset; /* Bytecode offset of the following
- * basic block before code motion */
+ int topOffset; /* Bytecode offset of the following basic
+ * block before code motion */
- /*
- * Make sure that there is enough space in the bytecode array to accommodate
- * the expanded code.
+ /*
+ * Make sure that there is enough space in the bytecode array to
+ * accommodate the expanded code.
*/
while (envPtr->codeEnd < envPtr->codeNext + mustMove) {
TclExpandCodeArray(envPtr);
}
- /*
- * Iterate through the bytecodes in reverse order, and move them
- * upward to their new homes.
+ /*
+ * Iterate through the bytecodes in reverse order, and move them upward to
+ * their new homes.
*/
topOffset = envPtr->codeNext - envPtr->codeStart;
for (bbPtr = assemEnvPtr->curr_bb; bbPtr != NULL; bbPtr = bbPtr->prevPtr) {
- /* fprintf(stderr, "move code from %d to %d\n",
- bbPtr->originalStartOffset, bbPtr->startOffset); fflush(stderr);
- */
+ DEBUG_PRINT("move code from %d to %d\n",
+ bbPtr->originalStartOffset, bbPtr->startOffset);
memmove(envPtr->codeStart + bbPtr->startOffset,
envPtr->codeStart + bbPtr->originalStartOffset,
topOffset - bbPtr->originalStartOffset);
@@ -2864,7 +2975,8 @@ MoveCodeForJumps(AssemblyEnv* assemEnvPtr,
*/
static void
-FillInJumpOffsets(AssemblyEnv* assemEnvPtr)
+FillInJumpOffsets(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -2876,27 +2988,26 @@ FillInJumpOffsets(AssemblyEnv* assemEnvPtr)
* target */
for (bbPtr = assemEnvPtr->head_bb;
- bbPtr != NULL;
- bbPtr = bbPtr->successor1) {
+ bbPtr != NULL;
+ bbPtr = bbPtr->successor1) {
if (bbPtr->jumpTarget != NULL) {
- entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
- jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+ entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(bbPtr->jumpTarget));
+ jumpTarget = Tcl_GetHashValue(entry);
fromOffset = bbPtr->jumpOffset;
targetOffset = jumpTarget->startOffset;
if (bbPtr->flags & BB_JUMP1) {
TclStoreInt1AtPtr(targetOffset - fromOffset,
- envPtr->codeStart + fromOffset + 1);
+ envPtr->codeStart + fromOffset + 1);
} else {
TclStoreInt4AtPtr(targetOffset - fromOffset,
- envPtr->codeStart + fromOffset + 1);
+ envPtr->codeStart + fromOffset + 1);
}
}
if (bbPtr->flags & BB_JUMPTABLE) {
ResolveJumpTableTargets(assemEnvPtr, bbPtr);
}
}
-
}
/*
@@ -2914,10 +3025,9 @@ FillInJumpOffsets(AssemblyEnv* assemEnvPtr)
*/
static void
-ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- BasicBlock* bbPtr)
- /* Basic block that ends in a jump table */
+ResolveJumpTableTargets(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr) /* Basic block that ends in a jump table */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -2933,44 +3043,45 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr,
Tcl_HashTable* realJumpHashPtr;
/* Jump table hash in the actual code */
Tcl_HashEntry* realJumpEntryPtr;
- /* Entry in the jump table hash in
+ /* Entry in the jump table hash in
* the actual code */
BasicBlock* jumpTargetBBPtr;
/* Basic block that the jump proceeds to */
int junk;
-
+
auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
- /* fprintf(stderr, "bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
- bbPtr, bbPtr->jumpOffset, auxDataIndex); */
+ DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
+ bbPtr, bbPtr->jumpOffset, auxDataIndex);
realJumpTablePtr = (JumptableInfo*)
- envPtr->auxDataArrayPtr[auxDataIndex].clientData;
- realJumpHashPtr = &(realJumpTablePtr->hashTable);
+ envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+ realJumpHashPtr = &realJumpTablePtr->hashTable;
- /* Look up every jump target in the jump hash */
+ /*
+ * Look up every jump target in the jump hash.
+ */
- /* fprintf(stderr, "resolve jump table {\n"); fflush(stderr); */
+ DEBUG_PRINT("resolve jump table {\n");
for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
- symEntryPtr != NULL;
- symEntryPtr = Tcl_NextHashEntry(&search)) {
- symbolObj = (Tcl_Obj*) Tcl_GetHashValue(symEntryPtr);
- /* fprintf(stderr, " symbol %s\n", Tcl_GetString(symbolObj)); */
+ symEntryPtr != NULL;
+ symEntryPtr = Tcl_NextHashEntry(&search)) {
+ symbolObj = Tcl_GetHashValue(symEntryPtr);
+ DEBUG_PRINT(" symbol %s\n", Tcl_GetString(symbolObj));
+
valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(symbolObj));
- jumpTargetBBPtr = (BasicBlock*) Tcl_GetHashValue(valEntryPtr);
- realJumpEntryPtr =
- Tcl_CreateHashEntry(realJumpHashPtr,
- Tcl_GetHashKey(symHash, symEntryPtr),
- &junk);
- /* fprintf(stderr, " %s -> %s -> bb %p (pc %d) hash entry %p\n",
- (char*)Tcl_GetHashKey(symHash, symEntryPtr),
+ Tcl_GetString(symbolObj));
+ jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr);
+
+ realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
+ Tcl_GetHashKey(symHash, symEntryPtr), &junk);
+ DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n",
+ (char*) Tcl_GetHashKey(symHash, symEntryPtr),
Tcl_GetString(symbolObj), jumpTargetBBPtr,
jumpTargetBBPtr->startOffset, realJumpEntryPtr);
- fflush(stderr); */
+
Tcl_SetHashValue(realJumpEntryPtr,
- (ClientData) (jumpTargetBBPtr->startOffset
- - bbPtr->jumpOffset));
+ INT2PTR(jumpTargetBBPtr->startOffset - bbPtr->jumpOffset));
}
- /* fprintf(stderr, "}\n"); fflush(stderr); */
+ DEBUG_PRINT("}\n");
}
/*
@@ -2979,8 +3090,8 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr,
* CheckForThrowInWrongContext --
*
* Verify that no beginCatch/endCatch sequence can throw an exception
- * after an original exception is caught and before its exception
- * context is removed from the stack.
+ * after an original exception is caught and before its exception context
+ * is removed from the stack.
*
* Results:
* Returns a standard Tcl result.
@@ -2992,28 +3103,27 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr,
*/
static int
-CheckForThrowInWrongContext(AssemblyEnv* assemEnvPtr)
- /* Assembler environment */
+CheckForThrowInWrongContext(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
BasicBlock* blockPtr; /* Current basic block */
- /*
- * Walk through the basic blocks in turn, checking all the ones
- * that have caught an exception and not disposed of it properly.
+ /*
+ * Walk through the basic blocks in turn, checking all the ones that have
+ * caught an exception and not disposed of it properly.
*/
for (blockPtr = assemEnvPtr->head_bb;
- blockPtr != NULL;
- blockPtr = blockPtr->successor1) {
-
+ blockPtr != NULL;
+ blockPtr = blockPtr->successor1) {
if (blockPtr->catchState == BBCS_CAUGHT) {
-
- /* Walk through the instructions in the basic block */
+ /*
+ * Walk through the instructions in the basic block.
+ */
if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) {
return TCL_ERROR;
}
-
}
}
return TCL_OK;
@@ -3036,25 +3146,27 @@ CheckForThrowInWrongContext(AssemblyEnv* assemEnvPtr)
*/
static int
-CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- BasicBlock* blockPtr)
- /* Basic block where exceptions are
- * not allowed */
+CheckNonThrowingBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* blockPtr) /* Basic block where exceptions are not
+ * allowed */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
BasicBlock* nextPtr; /* Pointer to the succeeding basic block */
- int offset; /* Bytecode offset of the current instruction */
+ int offset; /* Bytecode offset of the current
+ * instruction */
int bound; /* Bytecode offset following the last
* instruction of the block. */
unsigned char opcode; /* Current bytecode instruction */
Tcl_Obj* retval; /* Error message */
- /* Determine where in the code array the basic block ends */
-
+ /*
+ * Determine where in the code array the basic block ends.
+ */
+
nextPtr = blockPtr->successor1;
if (nextPtr == NULL) {
bound = envPtr->codeNext - envPtr->codeStart;
@@ -3062,26 +3174,28 @@ CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr,
bound = nextPtr->startOffset;
}
- /* Walk through the instructions of the block */
+ /*
+ * Walk through the instructions of the block.
+ */
offset = blockPtr->startOffset;
while (offset < bound) {
+ /*
+ * Determine whether an instruction is nonthrowing.
+ */
- /* Determine whether an instruction is nonthrowing */
-
opcode = (envPtr->codeStart)[offset];
-
if (BytecodeMightThrow(opcode)) {
-
- /* Report an error for a throw in the wrong context */
+ /*
+ * Report an error for a throw in the wrong context.
+ */
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
retval = Tcl_NewStringObj("\"", -1);
- Tcl_AppendToObj(retval, tclInstructionTable[opcode].name,
- -1);
+ Tcl_AppendToObj(retval, tclInstructionTable[opcode].name, -1);
Tcl_AppendToObj(retval, "\" instruction may not appear in "
- "a context where an exception has been "
- "caught and not disposed of.", -1);
+ "a context where an exception has been "
+ "caught and not disposed of.", -1);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
Tcl_SetObjResult(interp, retval);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
@@ -3108,15 +3222,18 @@ CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr,
*/
static int
-BytecodeMightThrow(unsigned char opcode)
+BytecodeMightThrow(
+ unsigned char opcode)
{
-
- /* Binary search on the non-throwing bytecode list */
+ /*
+ * Binary search on the non-throwing bytecode list.
+ */
int min = 0;
int max = sizeof(NonThrowingByteCodes)-1;
int mid;
unsigned char c;
+
while (max >= min) {
mid = (min + max) / 2;
c = NonThrowingByteCodes[mid];
@@ -3125,8 +3242,9 @@ BytecodeMightThrow(unsigned char opcode)
} else if (opcode > c) {
min = mid+1;
} else {
-
- /* Opcode is nonthrowing */
+ /*
+ * Opcode is nonthrowing.
+ */
return 0;
}
@@ -3154,39 +3272,46 @@ BytecodeMightThrow(unsigned char opcode)
*/
static int
-CheckStack(AssemblyEnv* assemEnvPtr)
- /* Assembly environment */
+CheckStack(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
int maxDepth; /* Maximum stack depth overall */
- /* Checking the head block will check all the other blocks recursively. */
+ /*
+ * Checking the head block will check all the other blocks recursively.
+ */
assemEnvPtr->maxDepth = 0;
- if (StackCheckBasicBlock(assemEnvPtr,
- assemEnvPtr->head_bb, NULL, 0) == TCL_ERROR) {
- return TCL_ERROR;
+ if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL,
+ 0) == TCL_ERROR) {
+ return TCL_ERROR;
}
- /* Post the max stack depth back to the compilation environment */
+ /*
+ * Post the max stack depth back to the compilation environment.
+ */
maxDepth = assemEnvPtr->maxDepth + envPtr->currStackDepth;
if (maxDepth > envPtr->maxStackDepth) {
envPtr->maxStackDepth = maxDepth;
}
- /* If the exit is reachable, make sure that the program exits with
- * 1 operand on the stack. */
+ /*
+ * If the exit is reachable, make sure that the program exits with 1
+ * operand on the stack.
+ */
if (StackCheckExit(assemEnvPtr) != TCL_OK) {
return TCL_ERROR;
}
- /* Reset the visited state on all basic blocks */
+ /*
+ * Reset the visited state on all basic blocks.
+ */
ResetVisitedBasicBlocks(assemEnvPtr);
-
return TCL_OK;
}
@@ -3195,34 +3320,31 @@ CheckStack(AssemblyEnv* assemEnvPtr)
*
* StackCheckBasicBlock --
*
- * Checks stack consumption for a basic block (and recursively for
- * its successors).
+ * Checks stack consumption for a basic block (and recursively for its
+ * successors).
*
* Results:
* Returns a standard Tcl result.
*
* Side effects:
- * Updates initial stack depth for the basic block and its
- * successors. (Final and maximum stack depth are relative to
- * initial, and are not touched).
+ * Updates initial stack depth for the basic block and its successors.
+ * (Final and maximum stack depth are relative to initial, and are not
+ * touched).
*
- * This procedure eventually checks, for the entire flow graph, whether
- * stack balance is consistent. It is an error for a given basic block
- * to be reachable along multiple flow paths with different stack depths.
+ * This procedure eventually checks, for the entire flow graph, whether stack
+ * balance is consistent. It is an error for a given basic block to be
+ * reachable along multiple flow paths with different stack depths.
*
*-----------------------------------------------------------------------------
*/
static int
-StackCheckBasicBlock(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- BasicBlock* blockPtr,
- /* Pointer to the basic block being checked */
- BasicBlock* predecessor,
- /* Pointer to the block that passed control
- * to this one. */
- int initialStackDepth)
- /* Stack depth on entry to the block */
+StackCheckBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* blockPtr, /* Pointer to the basic block being checked */
+ BasicBlock* predecessor, /* Pointer to the block that passed control to
+ * this one. */
+ int initialStackDepth) /* Stack depth on entry to the block */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -3238,44 +3360,42 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr,
Tcl_HashEntry* entry; /* Hash entry in the label table */
if (blockPtr->flags & BB_VISITED) {
-
- /*
+ /*
* If the block is already visited, check stack depth for consistency
* among the paths that reach it.
*/
- if (blockPtr->initialStackDepth != initialStackDepth) {
- if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("inconsistent stack depths "
- "on two execution paths",
- -1));
- /* TODO - add execution trace of both paths */
- Tcl_SetErrorLine(interp, blockPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
- }
- return TCL_ERROR;
- } else {
- return TCL_OK;
- }
+
+ if (blockPtr->initialStackDepth == initialStackDepth) {
+ return TCL_OK;
+ }
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "inconsistent stack depths on two execution paths", -1));
+ /* TODO - add execution trace of both paths */
+ Tcl_SetErrorLine(interp, blockPtr->startLine);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ }
+ return TCL_ERROR;
}
/*
- * If the block is not already visited, set the 'predecessor'
- * link to indicate how control got to it. Set the initial stack
- * depth to the current stack depth in the flow of control.
+ * If the block is not already visited, set the 'predecessor' link to
+ * indicate how control got to it. Set the initial stack depth to the
+ * current stack depth in the flow of control.
*/
+
blockPtr->flags |= BB_VISITED;
blockPtr->predecessor = predecessor;
blockPtr->initialStackDepth = initialStackDepth;
- /*
+ /*
* Calculate minimum stack depth, and flag an error if the block
* underflows the stack.
*/
+
if (initialStackDepth + blockPtr->minStackDepth < 0) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("stack underflow", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
Tcl_SetErrorLine(interp, blockPtr->startLine);
@@ -3284,17 +3404,17 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr,
}
/*
- * Make sure that the block doesn't try to pop below the stack level
- * of an enclosing catch.
+ * Make sure that the block doesn't try to pop below the stack level of an
+ * enclosing catch.
*/
- if (blockPtr->enclosingCatch != 0
- && initialStackDepth + blockPtr->minStackDepth
- < (blockPtr->enclosingCatch->initialStackDepth
- + blockPtr->enclosingCatch->finalStackDepth)) {
+
+ if (blockPtr->enclosingCatch != 0 &&
+ initialStackDepth + blockPtr->minStackDepth
+ < (blockPtr->enclosingCatch->initialStackDepth
+ + blockPtr->enclosingCatch->finalStackDepth)) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("code pops stack below level of"
- " enclosing catch", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "code pops stack below level of enclosing catch", -1));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
Tcl_SetErrorLine(interp, blockPtr->startLine);
@@ -3305,47 +3425,50 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr,
/*
* Update maximum stgack depth.
*/
+
maxDepth = initialStackDepth + blockPtr->maxStackDepth;
if (maxDepth > assemEnvPtr->maxDepth) {
assemEnvPtr->maxDepth = maxDepth;
}
-
+
/*
- * Calculate stack depth on exit from the block, and invoke this
- * procedure recursively to check successor blocks
+ * Calculate stack depth on exit from the block, and invoke this procedure
+ * recursively to check successor blocks.
*/
stackDepth = initialStackDepth + blockPtr->finalStackDepth;
result = TCL_OK;
if (blockPtr->flags & BB_FALLTHRU) {
- result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1,
- blockPtr, stackDepth);
-
+ result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1,
+ blockPtr, stackDepth);
}
+
if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(blockPtr->jumpTarget));
- jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
- result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
- blockPtr, stackDepth);
+ Tcl_GetString(blockPtr->jumpTarget));
+ jumpTarget = Tcl_GetHashValue(entry);
+ result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
+ stackDepth);
}
- /* All blocks referenced in a jump table are successors */
+ /*
+ * All blocks referenced in a jump table are successors.
+ */
if (blockPtr->flags & BB_JUMPTABLE) {
- for (jtEntry = Tcl_FirstHashEntry(&(blockPtr->jtPtr->hashTable),
- &jtSearch);
- result == TCL_OK && jtEntry != NULL;
- jtEntry = Tcl_NextHashEntry(&jtSearch)) {
- targetLabel = (Tcl_Obj*) Tcl_GetHashValue(jtEntry);
+ for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable,
+ &jtSearch);
+ result == TCL_OK && jtEntry != NULL;
+ jtEntry = Tcl_NextHashEntry(&jtSearch)) {
+ targetLabel = Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(targetLabel));
- jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+ Tcl_GetString(targetLabel));
+ jumpTarget = Tcl_GetHashValue(entry);
result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
- blockPtr, stackDepth);
+ blockPtr, stackDepth);
}
}
-
+
return result;
}
@@ -3358,62 +3481,72 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr,
* script is to push 1 result.
*
* Results:
- * Returns a standard Tcl result, with an error message in the interpreter
- * result if the stack is wrong.
+ * Returns a standard Tcl result, with an error message in the
+ * interpreter result if the stack is wrong.
*
* Side effects:
- * If the assembly code had a net stack effect of zero, emits code
- * to the concluding block to push a null result. In any case,
- * updates the stack depth in the compile environment to reflect
- * the net effect of the assembly code.
+ * If the assembly code had a net stack effect of zero, emits code to the
+ * concluding block to push a null result. In any case, updates the stack
+ * depth in the compile environment to reflect the net effect of the
+ * assembly code.
*
*-----------------------------------------------------------------------------
*/
static int
-StackCheckExit(AssemblyEnv* assemEnvPtr)
- /* Assembler environment */
+StackCheckExit(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
-
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
int depth; /* Net stack effect */
- int litIndex; /* Index in the literal pool of the empty
+ int litIndex; /* Index in the literal pool of the empty
* string */
Tcl_Obj* depthObj; /* Net stack effect for an error message */
Tcl_Obj* resultObj; /* Error message from this procedure */
BasicBlock* curr_bb = assemEnvPtr->curr_bb;
/* Final basic block in the assembly */
- /*
- * Don't perform these checks if execution doesn't reach the
- * exit (either because of an infinite loop or because the only
- * return is from the middle.
+ /*
+ * Don't perform these checks if execution doesn't reach the exit (either
+ * because of an infinite loop or because the only return is from the
+ * middle.
*/
if (curr_bb->flags & BB_VISITED) {
-
- /* Exit with no operands; push an empty one. */
+ /*
+ * Exit with no operands; push an empty one.
+ */
depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
if (depth == 0) {
- /* Emit a 'push' of the empty literal */
+ /*
+ * Emit a 'push' of the empty literal.
+ */
+
litIndex = TclRegisterNewLiteral(envPtr, "", 0);
- /* Assumes that 'push' is at slot 0 in TalInstructionTable */
+
+ /*
+ * Assumes that 'push' is at slot 0 in TalInstructionTable.
+ */
+
BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
++depth;
}
- /* Exit with unbalanced stack */
+ /*
+ * Exit with unbalanced stack.
+ */
if (depth != 1) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
depthObj = Tcl_NewIntObj(depth);
Tcl_IncrRefCount(depthObj);
- resultObj = Tcl_NewStringObj("stack is unbalanced on exit "
- "from the code (depth=", -1);
+ resultObj = Tcl_NewStringObj(
+ "stack is unbalanced on exit from the code (depth=",
+ -1);
Tcl_AppendObjToObj(resultObj, depthObj);
Tcl_DecrRefCount(depthObj);
Tcl_AppendToObj(resultObj, ")", -1);
@@ -3423,7 +3556,9 @@ StackCheckExit(AssemblyEnv* assemEnvPtr)
return TCL_ERROR;
}
- /* Record stack usage */
+ /*
+ * Record stack usage.
+ */
envPtr->currStackDepth += depth;
}
@@ -3436,11 +3571,11 @@ StackCheckExit(AssemblyEnv* assemEnvPtr)
*
* ProcessCatches --
*
- * First pass of 'catch' processing.
+ * First pass of 'catch' processing.
*
* Results:
- * Returns a standard Tcl result, with an appropriate error message
- * if the result is TCL_ERROR.
+ * Returns a standard Tcl result, with an appropriate error message if
+ * the result is TCL_ERROR.
*
* Side effects:
* Labels all basic blocks with their enclosing catches.
@@ -3449,48 +3584,53 @@ StackCheckExit(AssemblyEnv* assemEnvPtr)
*/
static int
-ProcessCatches(AssemblyEnv* assemEnvPtr)
- /* Assembler environment */
+ProcessCatches(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
BasicBlock* blockPtr; /* Pointer to a basic block */
/*
- * Clear the catch state of all basic blocks
+ * Clear the catch state of all basic blocks.
*/
for (blockPtr = assemEnvPtr->head_bb;
- blockPtr != NULL;
- blockPtr = blockPtr->successor1) {
+ blockPtr != NULL;
+ blockPtr = blockPtr->successor1) {
blockPtr->catchState = BBCS_UNKNOWN;
blockPtr->enclosingCatch = NULL;
}
- /*
- * Start the check recursively from the first basic block, which
- * is outside any exception context
+ /*
+ * Start the check recursively from the first basic block, which is
+ * outside any exception context
*/
if (ProcessCatchesInBasicBlock(assemEnvPtr, assemEnvPtr->head_bb,
- NULL, BBCS_NONE, 0) != TCL_OK) {
+ NULL, BBCS_NONE, 0) != TCL_OK) {
return TCL_ERROR;
}
- /* Check for unclosed catch on exit */
+ /*
+ * Check for unclosed catch on exit.
+ */
if (CheckForUnclosedCatches(assemEnvPtr) != TCL_OK) {
return TCL_ERROR;
}
- /* Now there's enough information to build the exception ranges. */
+ /*
+ * Now there's enough information to build the exception ranges.
+ */
if (BuildExceptionRanges(assemEnvPtr) != TCL_OK) {
return TCL_ERROR;
}
- /* Finally, restore any exception ranges from embedded scripts */
+ /*
+ * Finally, restore any exception ranges from embedded scripts.
+ */
RestoreEmbeddedExceptionRanges(assemEnvPtr);
-
return TCL_OK;
}
@@ -3506,23 +3646,19 @@ ProcessCatches(AssemblyEnv* assemEnvPtr)
* result if an error occurs.
*
* This procedure checks consistency of the exception context through the
- * assembler program, and records the enclosing 'catch' for every basic
- * block.
+ * assembler program, and records the enclosing 'catch' for every basic block.
*
*-----------------------------------------------------------------------------
*/
static int
-ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
- /* Assembler environment */
- BasicBlock* bbPtr,
- /* Basic block being processed */
- BasicBlock* enclosing,
- /* Start basic block of the enclosing catch */
- enum BasicBlockCatchState state,
+ProcessCatchesInBasicBlock(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr, /* Basic block being processed */
+ BasicBlock* enclosing, /* Start basic block of the enclosing catch */
+ enum BasicBlockCatchState state,
/* BBCS_NONE, BBCS_INCATCH, or BBCS_CAUGHT */
- int catchDepth)
- /* Depth of nesting of catches */
+ int catchDepth) /* Depth of nesting of catches */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -3533,48 +3669,45 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
/* Enclosing catch if execution falls thru */
enum BasicBlockCatchState fallThruState;
/* Catch state of the successor block */
- BasicBlock* jumpEnclosing;
- /* Enclosing catch if execution goes to
- * jump target */
+ BasicBlock* jumpEnclosing; /* Enclosing catch if execution goes to jump
+ * target */
enum BasicBlockCatchState jumpState;
/* Catch state of the jump target */
- int changed = 0; /* Flag == 1 iff successor blocks need
- * to be checked because the state of this
- * block has changed. */
+ int changed = 0; /* Flag == 1 iff successor blocks need to be
+ * checked because the state of this block has
+ * changed. */
BasicBlock* jumpTarget; /* Basic block where a jump goes */
Tcl_HashSearch jtSearch; /* Hash search control for a jumptable */
Tcl_HashEntry* jtEntry; /* Entry in a jumptable */
Tcl_Obj* targetLabel; /* Target label from a jumptable */
Tcl_HashEntry* entry; /* Entry from the label table */
- /*
- * Update the state of the current block, checking for consistency.
- * Set 'changed' to 1 if the state changes and successor blocks
- * need to be rechecked.
+ /*
+ * Update the state of the current block, checking for consistency. Set
+ * 'changed' to 1 if the state changes and successor blocks need to be
+ * rechecked.
*/
if (bbPtr->catchState == BBCS_UNKNOWN) {
bbPtr->enclosingCatch = enclosing;
} else if (bbPtr->enclosingCatch != enclosing) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("execution reaches an "
- "instruction in "
- "inconsistent exception contexts",
- -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "execution reaches an instruction in inconsistent "
+ "exception contexts", -1));
Tcl_SetErrorLine(interp, bbPtr->startLine);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
}
return TCL_ERROR;
- }
+ }
if (state > bbPtr->catchState) {
bbPtr->catchState = state;
changed = 1;
}
- /*
- * If this block has been visited before, and its state hasn't
- * changed, we're done with it for now.
+ /*
+ * If this block has been visited before, and its state hasn't changed,
+ * we're done with it for now.
*/
if (!changed) {
@@ -3583,8 +3716,8 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
bbPtr->catchDepth = catchDepth;
/*
- * Determine enclosing catch and 'caught' state for the fallthrough
- * and the jump target. Default for both is the state of the current block.
+ * Determine enclosing catch and 'caught' state for the fallthrough and
+ * the jump target. Default for both is the state of the current block.
*/
fallThruEnclosing = enclosing;
@@ -3596,29 +3729,29 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
* that a natural loop can't include 'beginCatch' or 'endCatch' */
if (bbPtr->flags & BB_BEGINCATCH) {
- /*
- * If the block begins a catch, the state for the successor is
- * 'in catch'. The jump target is the exception exit, and the state
- * of the jump target is 'caught.'
+ /*
+ * If the block begins a catch, the state for the successor is 'in
+ * catch'. The jump target is the exception exit, and the state of the
+ * jump target is 'caught.'
*/
+
fallThruEnclosing = bbPtr;
fallThruState = BBCS_INCATCH;
jumpEnclosing = bbPtr;
jumpState = BBCS_CAUGHT;
++catchDepth;
- }
+ }
if (bbPtr->flags & BB_ENDCATCH) {
/*
- * If the block ends a catch, the state for the successor is
- * whatever the state was on entry to the catch.
+ * If the block ends a catch, the state for the successor is whatever
+ * the state was on entry to the catch.
*/
+
if (enclosing == NULL) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("endCatch without a "
- "corresponding beginCatch",
- -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "endCatch without a corresponding beginCatch", -1));
Tcl_SetErrorLine(interp, bbPtr->startLine);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
}
@@ -3635,46 +3768,44 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
result = TCL_OK;
if (bbPtr->flags & BB_FALLTHRU) {
- result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1,
- fallThruEnclosing, fallThruState,
- catchDepth);
+ result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1,
+ fallThruEnclosing, fallThruState, catchDepth);
}
if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
- jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
- result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
- jumpEnclosing, jumpState,
- catchDepth);
+ Tcl_GetString(bbPtr->jumpTarget));
+ jumpTarget = Tcl_GetHashValue(entry);
+ result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
+ jumpEnclosing, jumpState, catchDepth);
}
-
- /* All blocks referenced in a jump table are successors */
+
+ /*
+ * All blocks referenced in a jump table are successors.
+ */
if (bbPtr->flags & BB_JUMPTABLE) {
- for (jtEntry = Tcl_FirstHashEntry(&(bbPtr->jtPtr->hashTable),
- &jtSearch);
- result == TCL_OK && jtEntry != NULL;
- jtEntry = Tcl_NextHashEntry(&jtSearch)) {
- targetLabel = (Tcl_Obj*) Tcl_GetHashValue(jtEntry);
+ for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch);
+ result == TCL_OK && jtEntry != NULL;
+ jtEntry = Tcl_NextHashEntry(&jtSearch)) {
+ targetLabel = Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(targetLabel));
- jumpTarget = (BasicBlock*) Tcl_GetHashValue(entry);
+ Tcl_GetString(targetLabel));
+ jumpTarget = Tcl_GetHashValue(entry);
result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
- jumpEnclosing, jumpState,
- catchDepth);
+ jumpEnclosing, jumpState, catchDepth);
}
}
-
+
return result;
}
/*
*-----------------------------------------------------------------------------
*
- * CheckForUnclosedCatches --
+ * CheckForUnclosedCatches --
*
- * Checks that a sequence of assembly code has no unclosed catches
- * on exit.
+ * Checks that a sequence of assembly code has no unclosed catches on
+ * exit.
*
* Results:
* Returns a standard Tcl result, with an error message for unclosed
@@ -3684,7 +3815,8 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
*/
static int
-CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr)
+CheckForUnclosedCatches(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -3693,11 +3825,10 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr)
if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("catch still active on "
- "exit from assembly "
- "code", -1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "catch still active on exit from assembly code", -1));
Tcl_SetErrorLine(interp,
- assemEnvPtr->curr_bb->enclosingCatch->startLine);
+ assemEnvPtr->curr_bb->enclosingCatch->startLine);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
}
return TCL_ERROR;
@@ -3710,18 +3841,18 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr)
*
* BuildExceptionRanges --
*
- * Walks through the assembly code and builds exception ranges for
- * the catches embedded therein.
+ * Walks through the assembly code and builds exception ranges for the
+ * catches embedded therein.
*
* Results:
* Returns a standard Tcl result with an error message in the interpreter
* if anything is unsuccessful.
*
* Side effects:
- * Each contiguous block of code with a given catch exit is assigned
- * an exception range at the appropriate level.
- * Exception ranges in embedded blocks have their levels corrected
- * and collated into the table.
+ * Each contiguous block of code with a given catch exit is assigned an
+ * exception range at the appropriate level.
+ * Exception ranges in embedded blocks have their levels corrected and
+ * collated into the table.
* Blocks that end with 'beginCatch' are associated with the innermost
* exception range of the following block.
*
@@ -3729,31 +3860,34 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr)
*/
static int
-BuildExceptionRanges(AssemblyEnv* assemEnvPtr)
- /* Assembler environment */
+BuildExceptionRanges(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
BasicBlock* bbPtr; /* Current basic block */
BasicBlock* prevPtr = NULL; /* Previous basic block */
int catchDepth = 0; /* Current catch depth */
- int maxCatchDepth= 0; /* Maximum catch depth in the program */
+ int maxCatchDepth = 0; /* Maximum catch depth in the program */
BasicBlock** catches; /* Stack of catches in progress */
int* catchIndices; /* Indices of the exception ranges
* of catches in progress */
int i;
- /*
+ /*
* Determine the max catch depth for the entire assembly script
* (excluding embedded eval's and expr's, which will be handled later).
*/
- for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
+
+ for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
if (bbPtr->catchDepth > maxCatchDepth) {
maxCatchDepth = bbPtr->catchDepth;
}
}
- /* Allocate memory for a stack of active catches */
+ /*
+ * Allocate memory for a stack of active catches.
+ */
catches = (BasicBlock**) ckalloc(maxCatchDepth * sizeof(BasicBlock*));
catchIndices = (int*) ckalloc(maxCatchDepth * sizeof(int));
@@ -3762,23 +3896,25 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr)
catchIndices[i] = -1;
}
- /* Walk through the basic blocks and manage exception ranges. */
-
- for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
+ /*
+ * Walk through the basic blocks and manage exception ranges.
+ */
- UnstackExpiredCatches(envPtr, bbPtr, catchDepth,
- catches, catchIndices);
+ for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
+ UnstackExpiredCatches(envPtr, bbPtr, catchDepth, catches,
+ catchIndices);
LookForFreshCatches(bbPtr, catches);
- StackFreshCatches(assemEnvPtr, bbPtr, catchDepth,
- catches, catchIndices);
+ StackFreshCatches(assemEnvPtr, bbPtr, catchDepth, catches,
+ catchIndices);
- /* If the last block was a 'begin catch', fill in the exception range */
+ /*
+ * If the last block was a 'begin catch', fill in the exception range.
+ */
catchDepth = bbPtr->catchDepth;
- if (prevPtr != NULL
- && (prevPtr->flags & BB_BEGINCATCH)) {
+ if (prevPtr != NULL && (prevPtr->flags & BB_BEGINCATCH)) {
TclStoreInt4AtPtr(catchIndices[catchDepth-1],
- envPtr->codeStart + bbPtr->startOffset - 4);
+ envPtr->codeStart + bbPtr->startOffset - 4);
}
prevPtr = bbPtr;
@@ -3786,7 +3922,7 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr)
if (catchDepth != 0) {
Tcl_Panic("unclosed catch at end of code in "
- "tclAssembly.c:BuildExceptionRanges, can't happen");
+ "tclAssembly.c:BuildExceptionRanges, can't happen");
}
return TCL_OK;
@@ -3805,32 +3941,27 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr)
*/
static void
-UnstackExpiredCatches(CompileEnv* envPtr,
- /* Compilation environment */
- BasicBlock* bbPtr,
- /* Basic block being processed */
- int catchDepth,
- /* Depth of nesting of catches prior to
- * entry to this block */
- BasicBlock** catches,
- /* Array of catch contexts */
- int* catchIndices)
- /* Indices of the exception ranges
+UnstackExpiredCatches(
+ CompileEnv* envPtr, /* Compilation environment */
+ BasicBlock* bbPtr, /* Basic block being processed */
+ int catchDepth, /* Depth of nesting of catches prior to entry
+ * to this block */
+ BasicBlock** catches, /* Array of catch contexts */
+ int* catchIndices) /* Indices of the exception ranges
* corresponding to the catch contexts */
{
-
ExceptionRange* range; /* Exception range for a specific catch */
BasicBlock* catch; /* Catch block being examined */
BasicBlockCatchState catchState;
- /* State of the code relative to
- * the catch block being examined
- * ("in catch" or "caught") */
+ /* State of the code relative to the catch
+ * block being examined ("in catch" or
+ * "caught"). */
- /*
- * Unstack any catches that are deeper than the nesting level of
- * the basic block being entered.
+ /*
+ * Unstack any catches that are deeper than the nesting level of the basic
+ * block being entered.
*/
-
+
while (catchDepth > bbPtr->catchDepth) {
--catchDepth;
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
@@ -3839,19 +3970,18 @@ UnstackExpiredCatches(CompileEnv* envPtr,
catchIndices[catchDepth] = -1;
}
- /*
+ /*
* Unstack any catches that don't match the basic block being entered,
- * either because they are no longer part of the context, or because
- * the context has changed from INCATCH to CAUGHT.
+ * either because they are no longer part of the context, or because the
+ * context has changed from INCATCH to CAUGHT.
*/
-
+
catchState = bbPtr->catchState;
catch = bbPtr->enclosingCatch;
while (catchDepth > 0) {
--catchDepth;
if (catches[catchDepth] != NULL) {
- if (catches[catchDepth] != catch
- || catchState >= BBCS_CAUGHT) {
+ if (catches[catchDepth] != catch || catchState >= BBCS_CAUGHT) {
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
catches[catchDepth] = NULL;
@@ -3879,15 +4009,14 @@ UnstackExpiredCatches(CompileEnv* envPtr,
*/
static void
-LookForFreshCatches(BasicBlock* bbPtr,
- /* Basic block being entered */
- BasicBlock** catches)
- /* Array of catch contexts that are
- * already entered */
+LookForFreshCatches(
+ BasicBlock* bbPtr, /* Basic block being entered */
+ BasicBlock** catches) /* Array of catch contexts that are already
+ * entered */
{
BasicBlockCatchState catchState;
- /* State ("in catch" or "caught" of
- * the current catch. */
+ /* State ("in catch" or "caught") of the
+ * current catch. */
BasicBlock* catch; /* Current enclosing catch */
int catchDepth; /* Nesting depth of the current catch */
@@ -3905,27 +4034,24 @@ LookForFreshCatches(BasicBlock* bbPtr,
}
/*
- *-----------------------------------------------------------------------------\ *
+ *-----------------------------------------------------------------------------
+ *
* StackFreshCatches --
*
- * Make ExceptionRange records for any catches that are in the
- * basic block being entered and were not in the previous basic block.
+ * Make ExceptionRange records for any catches that are in the basic
+ * block being entered and were not in the previous basic block.
*
*-----------------------------------------------------------------------------
*/
static void
-StackFreshCatches(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- BasicBlock* bbPtr,
- /* Basic block being processed */
- int catchDepth,
- /* Depth of nesting of catches prior to
- * entry to this block */
- BasicBlock** catches,
- /* Array of catch contexts */
- int* catchIndices)
- /* Indices of the exception ranges
+StackFreshCatches(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr, /* Basic block being processed */
+ int catchDepth, /* Depth of nesting of catches prior to entry
+ * to this block */
+ BasicBlock** catches, /* Array of catch contexts */
+ int* catchIndices) /* Indices of the exception ranges
* corresponding to the catch contexts */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
@@ -3943,29 +4069,29 @@ StackFreshCatches(AssemblyEnv* assemEnvPtr,
*/
for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) {
- if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) {
-
- /* Create an exception range for a block that needs one. */
+ if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) {
+ /*
+ * Create an exception range for a block that needs one.
+ */
catch = catches[catchDepth];
catchIndices[catchDepth] =
- TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
range->nestingLevel = envPtr->exceptDepth + catchDepth;
envPtr->maxExceptDepth =
- TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth);
+ TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth);
range->codeOffset = bbPtr->startOffset;
-
- if ((entryPtr =
- Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(catch->jumpTarget)))
- == NULL) {
+
+ entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
+ Tcl_GetString(catch->jumpTarget));
+ if (entryPtr == NULL) {
Tcl_Panic("undefined label in tclAssembly.c:"
- "BuildExceptionRanges, can't happen");
- } else {
- errorExit = (BasicBlock*) Tcl_GetHashValue(entryPtr);
- range->catchOffset = errorExit->startOffset;
+ "BuildExceptionRanges, can't happen");
}
+
+ errorExit = Tcl_GetHashValue(entryPtr);
+ range->catchOffset = errorExit->startOffset;
}
}
}
@@ -3982,39 +4108,41 @@ StackFreshCatches(AssemblyEnv* assemEnvPtr,
*/
static void
-RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr)
- /* Assembler environment */
+RestoreEmbeddedExceptionRanges(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
BasicBlock* bbPtr; /* Current basic block */
- int rangeBase; /* Base of the foreign exception ranges
- * when they are reinstalled */
+ int rangeBase; /* Base of the foreign exception ranges when
+ * they are reinstalled */
int rangeIndex; /* Index of the current foreign exception
* range as reinstalled */
- ExceptionRange* range; /* Current foreign exception range */
+ ExceptionRange* range; /* Current foreign exception range */
unsigned char opcode; /* Current instruction's opcode */
- unsigned int catchIndex; /* Index of the exception range to which
- * the current instruction refers */
+ unsigned int catchIndex; /* Index of the exception range to which the
+ * current instruction refers */
int i;
- /* Walk the basic blocks looking for exceptions in embedded scripts */
+ /*
+ * Walk the basic blocks looking for exceptions in embedded scripts.
+ */
for (bbPtr = assemEnvPtr->head_bb;
- bbPtr != NULL;
- bbPtr = bbPtr->successor1) {
+ bbPtr != NULL;
+ bbPtr = bbPtr->successor1) {
if (bbPtr->foreignExceptionCount != 0) {
- /*
- * Reinstall the embedded exceptions and track their
- * nesting level
+ /*
+ * Reinstall the embedded exceptions and track their nesting level
*/
+
rangeBase = envPtr->exceptArrayNext;
for (i = 0; i < bbPtr->foreignExceptionCount; ++i) {
range = bbPtr->foreignExceptions + i;
rangeIndex = TclCreateExceptRange(range->type, envPtr);
range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth;
memcpy(envPtr->exceptArrayPtr + rangeIndex, range,
- sizeof(ExceptionRange));
+ sizeof(ExceptionRange));
if (range->nestingLevel >= envPtr->maxExceptDepth) {
envPtr->maxExceptDepth = range->nestingLevel + 1;
}
@@ -4024,25 +4152,24 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr)
* Walk through the bytecode of the basic block, and relocate
* INST_BEGIN_CATCH4 instructions to the new locations
*/
+
i = bbPtr->startOffset;
while (i < bbPtr->successor1->startOffset) {
opcode = envPtr->codeStart[i];
if (opcode == INST_BEGIN_CATCH4) {
catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1);
if (catchIndex >= bbPtr->foreignExceptionBase
- && catchIndex < (bbPtr->foreignExceptionBase +
- bbPtr->foreignExceptionCount)) {
+ && catchIndex < (bbPtr->foreignExceptionBase +
+ bbPtr->foreignExceptionCount)) {
catchIndex -= bbPtr->foreignExceptionBase;
catchIndex += rangeBase;
- TclStoreInt4AtPtr(catchIndex,
- envPtr->codeStart + i + 1);
+ TclStoreInt4AtPtr(catchIndex, envPtr->codeStart+i+1);
}
}
i += tclInstructionTable[opcode].numBytes;
}
}
}
-
}
/*
@@ -4057,11 +4184,13 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr)
*/
static void
-ResetVisitedBasicBlocks(AssemblyEnv* assemEnvPtr)
+ResetVisitedBasicBlocks(
+ AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
BasicBlock* block;
- for (block = assemEnvPtr->head_bb; block != NULL;
- block = block->successor1) {
+
+ for (block = assemEnvPtr->head_bb; block != NULL;
+ block = block->successor1) {
block->flags &= ~BB_VISITED;
}
}
@@ -4071,8 +4200,8 @@ ResetVisitedBasicBlocks(AssemblyEnv* assemEnvPtr)
*
* AddBasicBlockRangeToErrorInfo --
*
- * Updates the error info of the Tcl interpreter to show a given
- * basic block in the code.
+ * Updates the error info of the Tcl interpreter to show a given basic
+ * block in the code.
*
* This procedure is used to label the callstack with source location
* information when reporting an error in stack checking.
@@ -4081,11 +4210,9 @@ ResetVisitedBasicBlocks(AssemblyEnv* assemEnvPtr)
*/
static void
-AddBasicBlockRangeToErrorInfo(AssemblyEnv* assemEnvPtr,
- /* Assembly environment */
- BasicBlock* bbPtr)
- /* Basic block in which the error is
- * found */
+AddBasicBlockRangeToErrorInfo(
+ AssemblyEnv* assemEnvPtr, /* Assembly environment */
+ BasicBlock* bbPtr) /* Basic block in which the error is found */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
@@ -4133,7 +4260,7 @@ AddBasicBlockRangeToErrorInfo(AssemblyEnv* assemEnvPtr,
*
*-----------------------------------------------------------------------------
*/
-
+
static void
DupAssembleCodeInternalRep(
Tcl_Obj *srcPtr,
@@ -4164,7 +4291,7 @@ static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
@@ -4173,4 +4300,11 @@ FreeAssembleCodeInternalRep(
objPtr->typePtr = NULL;
objPtr->internalRep.otherValuePtr = NULL;
}
-
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tests/assemble.test b/tests/assemble.test
index b9178ec..761b36b 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -5,23 +5,21 @@
# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
# Copyright (c) 2010 by Kevin B. Kenny.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: assemble.test,v 1.1.2.16 2010/12/16 01:40:42 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#-----------------------------------------------------------------------------
# Commands covered: assemble
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2.2
namespace import -force ::tcltest::*
}
namespace eval tcl::unsupported {namespace export assemble}
namespace import tcl::unsupported::assemble
-# Procedure to make code that fills the literal and local variable tables,
-# to force instructions to spill to four bytes.
+# Procedure to make code that fills the literal and local variable tables, to
+# force instructions to spill to four bytes.
proc fillTables {} {
set s {}
@@ -32,7 +30,7 @@ proc fillTables {} {
}
return $s
}
-
+
# assemble-1 - TclNRAssembleObjCmd
test assemble-1.1 {wrong # args, direct eval} {
@@ -43,7 +41,6 @@ test assemble-1.1 {wrong # args, direct eval} {
-result {wrong # args*}
-match glob
}
-
test assemble-1.2 {wrong # args, direct eval} {
-body {
eval [list assemble too many]
@@ -52,7 +49,6 @@ test assemble-1.2 {wrong # args, direct eval} {
-result {wrong # args*}
-match glob
}
-
test assemble-1.3 {error reporting, direct eval} {
-body {
list [catch {
@@ -69,7 +65,6 @@ test assemble-1.3 {error reporting, direct eval} {
("assemble" body, line 3)*}}
-cleanup {unset result}
}
-
test assemble-1.4 {simple direct eval} {
-body {
eval [list assemble {push {this is a test}}]
@@ -87,7 +82,6 @@ test assemble-2.1 {bytecode reuse, direct eval} {
}
-result {{this is a test} {this is a test}}
}
-
test assemble-2.2 {bytecode discard, direct eval} {
-body {
set x {load value}
@@ -109,7 +103,6 @@ test assemble-2.2 {bytecode discard, direct eval} {
rename p2 {}
}
}
-
test assemble-2.3 {null script, direct eval} {
-body {
set x {}
@@ -132,7 +125,6 @@ test assemble-3.1 {wrong # args, compiled path} {
-match glob
-result {wrong # args:*}
}
-
test assemble-3.2 {wrong # args, compiled path} {
-body {
proc x {} {
@@ -170,7 +162,6 @@ test assemble-4.1 {syntax error} {
"
("assemble" body, line 2)*}}
}
-
test assemble-4.2 {null command} {
-body {
proc x {} {
@@ -203,7 +194,6 @@ test assemble-5.1 {unsupported expansion} {
unset result
}
}
-
test assemble-5.2 {unsupported substitution} {
-body {
proc x {y} {
@@ -219,7 +209,6 @@ test assemble-5.2 {unsupported substitution} {
}
-result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}
-
test assemble-5.3 {unsupported substitution} {
-body {
proc x {} {
@@ -231,7 +220,6 @@ test assemble-5.3 {unsupported substitution} {
}
-result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}
-
test assemble-5.4 {backslash substitution} {
-body {
proc x {} {
@@ -258,7 +246,6 @@ test assemble-6.1 {push, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-6.2 {push, wrong # args} {
-body {
assemble {push too many}
@@ -267,22 +254,19 @@ test assemble-6.2 {push, wrong # args} {
-match glob
-result {wrong # args*}
}
-
-
test assemble-6.3 {push} {
-body {
eval [list assemble {push hello}]
}
-result hello
}
-
test assemble-6.4 {push4} {
-body {
proc x {} "
[fillTables]
assemble {push hello}
"
- x
+ x
}
-cleanup {
rename x {}
@@ -300,7 +284,6 @@ test assemble-7.1 {add, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-7.2 {add} {
-body {
assemble {
@@ -311,7 +294,6 @@ test assemble-7.2 {add} {
}
-result {4}
}
-
test assemble-7.3 {appendArrayStk} {
-body {
set a(b) {hello, }
@@ -326,7 +308,6 @@ test assemble-7.3 {appendArrayStk} {
-result {hello, world}
-cleanup {unset a}
}
-
test assemble-7.4 {appendStk} {
-body {
set a {hello, }
@@ -340,7 +321,6 @@ test assemble-7.4 {appendStk} {
-result {hello, world}
-cleanup {unset a}
}
-
test assemble-7.5 {bitwise ops} {
-body {
list \
@@ -351,14 +331,12 @@ test assemble-7.5 {bitwise ops} {
}
-result {8 -13 14 6}
}
-
test assemble-7.6 {div} {
-body {
assemble {push 999999; push 7; div}
}
-result 142857
}
-
test assemble-7.7 {dup} {
-body {
assemble {
@@ -367,7 +345,6 @@ test assemble-7.7 {dup} {
}
-result 9
}
-
test assemble-7.8 {eq} {
-body {
list \
@@ -376,8 +353,6 @@ test assemble-7.8 {eq} {
}
-result {0 1}
}
-
-
test assemble-7.9 {evalStk} {
-body {
assemble {
@@ -387,7 +362,6 @@ test assemble-7.9 {evalStk} {
}
-result {test 7.3}
}
-
test assemble-7.9a {evalStk, syntax} {
-body {
assemble {
@@ -398,7 +372,6 @@ test assemble-7.9a {evalStk, syntax} {
-returnCodes error
-result {extra characters after close-brace}
}
-
test assemble-7.9b {evalStk, backtrace} {
-body {
proc y {z} {
@@ -427,7 +400,6 @@ test assemble-7.9b {evalStk, backtrace} {
rename x {}
}
}
-
test assemble-7.10 {existArrayStk} {
-body {
proc x {name key} {
@@ -441,7 +413,6 @@ test assemble-7.10 {existArrayStk} {
-result {0 1 0 0}
-cleanup {rename x {}}
}
-
test assemble-7.11 {existStk} {
-body {
proc x {name} {
@@ -455,14 +426,12 @@ test assemble-7.11 {existStk} {
-result {1 0}
-cleanup {rename x {}}
}
-
test assemble-7.12 {expon} {
-body {
assemble {push 3; push 4; expon}
}
-result 81
}
-
test assemble-7.13 {exprStk} {
-body {
assemble {
@@ -472,7 +441,6 @@ test assemble-7.13 {exprStk} {
}
-result 3.141592653589793
}
-
test assemble-7.13a {exprStk, syntax} {
-body {
assemble {
@@ -484,7 +452,6 @@ test assemble-7.13a {exprStk, syntax} {
-result {missing operand at _@_
in expression "2+_@_"}
}
-
test assemble-7.13b {exprStk, backtrace} {
-body {
proc y {z} {
@@ -510,7 +477,6 @@ test assemble-7.13b {exprStk, backtrace} {
rename x {}
}
}
-
test assemble-7.14 {ge gt le lt} {
-body {
proc x {a b} {
@@ -524,7 +490,6 @@ test assemble-7.14 {ge gt le lt} {
-result {{1 0 1 0} {0 0 1 1} {1 1 0 0}}
-cleanup {rename x {}}
}
-
test assemble-7.15 {incrArrayStk} {
-body {
proc x {} {
@@ -538,7 +503,6 @@ test assemble-7.15 {incrArrayStk} {
-result 12
-cleanup {rename x {}}
}
-
test assemble-7.16 {incrStk} {
-body {
proc x {} {
@@ -552,7 +516,6 @@ test assemble-7.16 {incrStk} {
-result 12
-cleanup {rename x {}}
}
-
test assemble-7.17 {land/lor} {
-body {
proc x {a b} {
@@ -565,7 +528,6 @@ test assemble-7.17 {land/lor} {
-result {{0 0} {0 1} {0 1} {1 1}}
-cleanup {rename x {}}
}
-
test assemble-7.18 {lappendArrayStk} {
-body {
proc x {} {
@@ -582,7 +544,6 @@ test assemble-7.18 {lappendArrayStk} {
-result {charlie dog}
-cleanup {rename x {}}
}
-
test assemble-7.19 {lappendStk} {
-body {
proc x {} {
@@ -598,7 +559,6 @@ test assemble-7.19 {lappendStk} {
-result {baker charlie}
-cleanup {rename x {}}
}
-
test assemble-7.20 {listIndex} {
-body {
assemble {
@@ -609,7 +569,6 @@ test assemble-7.20 {listIndex} {
}
-result c
}
-
test assemble-7.21 {listLength} {
-body {
assemble {
@@ -619,7 +578,6 @@ test assemble-7.21 {listLength} {
}
-result 4
}
-
test assemble-7.22 {loadArrayStk} {
-body {
proc x {} {
@@ -635,7 +593,6 @@ test assemble-7.22 {loadArrayStk} {
-result charlie
-cleanup {rename x {}}
}
-
test assemble-7.23 {loadStk} {
-body {
proc x {} {
@@ -650,7 +607,6 @@ test assemble-7.23 {loadStk} {
-result baker
-cleanup {rename x {}}
}
-
test assemble-7.24 {lsetList} {
-body {
proc x {} {
@@ -663,28 +619,24 @@ test assemble-7.24 {lsetList} {
}
-result {{a b} {c d} {e i} {g h}}
}
-
test assemble-7.25 {lshift} {
-body {
assemble {push 16; push 4; lshift}
}
-result 256
}
-
test assemble-7.26 {mod} {
-body {
assemble {push 123456; push 1000; mod}
}
-result 456
}
-
test assemble-7.27 {mult} {
-body {
assemble {push 12345679; push 9; mult}
}
-result 111111111
}
-
test assemble-7.28 {neq} {
-body {
list \
@@ -693,7 +645,6 @@ test assemble-7.28 {neq} {
}
-result {1 0}
}
-
test assemble-7.29 {not} {
-body {
list \
@@ -702,21 +653,18 @@ test assemble-7.29 {not} {
}
-result {0 1}
}
-
test assemble-7.30 {pop} {
-body {
assemble {push this; pop; push that}
}
-result that
}
-
test assemble-7.31 {rshift} {
-body {
assemble {push 257; push 4; rshift}
}
-result 16
}
-
test assemble-7.32 {storeArrayStk} {
-body {
proc x {} {
@@ -730,7 +678,6 @@ test assemble-7.32 {storeArrayStk} {
-result {baker charlie}
-cleanup {rename x {}}
}
-
test assemble-7.33 {storeStk} {
-body {
proc x {} {
@@ -744,7 +691,6 @@ test assemble-7.33 {storeStk} {
-result {baker}
-cleanup {rename x {}}
}
-
test assemble-7,34 {strcmp} {
-body {
proc x {a b} {
@@ -757,7 +703,6 @@ test assemble-7,34 {strcmp} {
-result {-1 1 0}
-cleanup {rename x {}}
}
-
test assemble-7.35 {streq/strneq} {
-body {
proc x {a b} {
@@ -770,28 +715,24 @@ test assemble-7.35 {streq/strneq} {
-result {{1 0} {0 1}}
-cleanup {rename x {}}
}
-
test assemble-7.36 {strindex} {
-body {
assemble {push testing; push 4; strindex}
}
-result i
}
-
test assemble-7.37 {strlen} {
-body {
assemble {push testing; strlen}
}
-result 7
}
-
test assemble-7.38 {sub} {
-body {
assemble {push 42; push 17; sub}
}
-result 25
}
-
test assemble-7.39 {tryCvtToNumeric} {
-body {
assemble {
@@ -800,7 +741,7 @@ test assemble-7.39 {tryCvtToNumeric} {
}
-result 42
}
-
+# assemble-7.40 absent
test assemble-7.41 {uminus} {
-body {
assemble {
@@ -809,7 +750,6 @@ test assemble-7.41 {uminus} {
}
-result -42
}
-
test assemble-7.42 {uplus} {
-body {
assemble {
@@ -827,7 +767,6 @@ test assemble-7.43 {uplus} {
-returnCodes error
-result {can't use non-numeric floating-point value as operand of "+"}
}
-
test assemble-7.43 {tryCvtToNumeric} {
-body {
assemble {
@@ -837,7 +776,6 @@ test assemble-7.43 {tryCvtToNumeric} {
-returnCodes error
-result {domain error: argument not in valid range}
}
-
test assemble-7.44 {listIn} {
-body {
assemble {
@@ -846,7 +784,6 @@ test assemble-7.44 {listIn} {
}
-result 1
}
-
test assemble-7.45 {listNotIn} {
-body {
assemble {
@@ -855,7 +792,6 @@ test assemble-7.45 {listNotIn} {
}
-result 1
}
-
test assemble-7.46 {nop} {
-body {
assemble { push x; nop; nop; nop}
@@ -873,7 +809,6 @@ test assemble-8.1 {load, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-8.2 {load, wrong # args} {
-body {
assemble {load too many}
@@ -882,7 +817,6 @@ test assemble-8.2 {load, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-8.3 {nonlocal var} {
-body {
list [catch {assemble {load ::env}} result] $result $errorCode
@@ -890,7 +824,6 @@ test assemble-8.3 {nonlocal var} {
-result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
-cleanup {unset result}
}
-
test assemble-8.4 {bad context} {
-body {
set x 1
@@ -899,7 +832,6 @@ test assemble-8.4 {bad context} {
-result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
-cleanup {unset result}
}
-
test assemble-8.5 {bad context} {
-body {
namespace eval assem {
@@ -910,7 +842,6 @@ test assemble-8.5 {bad context} {
-result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
-cleanup {namespace delete assem}
}
-
test assemble-8.6 {load1} {
-body {
proc x {a} {
@@ -923,7 +854,6 @@ test assemble-8.6 {load1} {
-result able
-cleanup {rename x {}}
}
-
test assemble-8.7 {load4} {
-body {
proc x {a} "
@@ -936,7 +866,6 @@ test assemble-8.7 {load4} {
-result able
-cleanup {rename x {}}
}
-
test assemble-8.8 {loadArray1} {
-body {
proc x {} {
@@ -951,7 +880,6 @@ test assemble-8.8 {loadArray1} {
-result charlie
-cleanup {rename x {}}
}
-
test assemble-8.9 {loadArray4} {
-body "
proc x {} {
@@ -967,7 +895,6 @@ test assemble-8.9 {loadArray4} {
-result charlie
-cleanup {rename x {}}
}
-
test assemble-8.10 {append1} {
-body {
proc x {} {
@@ -981,7 +908,6 @@ test assemble-8.10 {append1} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.11 {append4} {
-body {
proc x {} "
@@ -996,7 +922,6 @@ test assemble-8.11 {append4} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.12 {appendArray1} {
-body {
proc x {} {
@@ -1010,7 +935,6 @@ test assemble-8.12 {appendArray1} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.13 {appendArray4} {
-body {
proc x {} "
@@ -1025,7 +949,6 @@ test assemble-8.13 {appendArray4} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.14 {lappend1} {
-body {
proc x {} {
@@ -1039,7 +962,6 @@ test assemble-8.14 {lappend1} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.15 {lappend4} {
-body {
proc x {} "
@@ -1054,7 +976,6 @@ test assemble-8.15 {lappend4} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.16 {lappendArray1} {
-body {
proc x {} {
@@ -1068,7 +989,6 @@ test assemble-8.16 {lappendArray1} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.17 {lappendArray4} {
-body {
proc x {} "
@@ -1083,7 +1003,6 @@ test assemble-8.17 {lappendArray4} {
-result {hello, world}
-cleanup {rename x {}}
}
-
test assemble-8.18 {store1} {
-body {
proc x {} {
@@ -1097,7 +1016,6 @@ test assemble-8.18 {store1} {
-result {test}
-cleanup {rename x {}}
}
-
test assemble-8.19 {store4} {
-body {
proc x {} "
@@ -1112,7 +1030,6 @@ test assemble-8.19 {store4} {
-result test
-cleanup {rename x {}}
}
-
test assemble-8.20 {storeArray1} {
-body {
proc x {} {
@@ -1126,7 +1043,6 @@ test assemble-8.20 {storeArray1} {
-result test
-cleanup {rename x {}}
}
-
test assemble-8.21 {storeArray4} {
-body {
proc x {} "
@@ -1149,14 +1065,12 @@ test assemble-9.1 {wrong # args} {
-match glob
-returnCodes error
}
-
test assemble-9.2 {wrong # args} {
-body {assemble {concat too many}}
-result {wrong # args*}
-match glob
-returnCodes error
}
-
test assemble-9.3 {not a number} {
-body {assemble {concat rubbish}}
-result {expected integer but got "rubbish"}
@@ -1196,7 +1110,6 @@ test assemble-10.1 {eval - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-10.2 {eval - wrong # args} {
-body {
assemble {eval too many}
@@ -1205,7 +1118,6 @@ test assemble-10.2 {eval - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-10.3 {eval} {
-body {
proc x {} {
@@ -1223,7 +1135,6 @@ test assemble-10.3 {eval} {
-result 11
-cleanup {rename x {}}
}
-
test assemble-10.4 {expr} {
-body {
proc x {} {
@@ -1241,7 +1152,6 @@ test assemble-10.4 {expr} {
-result 11
-cleanup {rename x {}}
}
-
test assemble-10.5 {eval and expr - nonsimple} {
-body {
proc x {} {
@@ -1260,14 +1170,12 @@ test assemble-10.5 {eval and expr - nonsimple} {
rename x {}
}
}
-
test assemble-10.6 {eval - noncompilable} {
-body {
list [catch {assemble {eval $x}} result] $result $::errorCode
}
-result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}
-
test assemble-10.7 {expr - noncompilable} {
-body {
list [catch {assemble {expr $x}} result] $result $::errorCode
@@ -1286,7 +1194,6 @@ test assemble-11.1 {exist - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-11.2 {exist - wrong # args} {
-body {
assemble {exist too many}
@@ -1295,7 +1202,6 @@ test assemble-11.2 {exist - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-11.3 {nonlocal var} {
-body {
list [catch {assemble {exist ::env}} result] $result $errorCode
@@ -1303,7 +1209,6 @@ test assemble-11.3 {nonlocal var} {
-result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
-cleanup {unset result}
}
-
test assemble-11.4 {exist} {
-body {
proc x {} {
@@ -1316,7 +1221,6 @@ test assemble-11.4 {exist} {
-result {1 0}
-cleanup {rename x {}}
}
-
test assemble-11.5 {existArray} {
-body {
proc x {} {
@@ -1330,7 +1234,6 @@ test assemble-11.5 {existArray} {
-result {1 0 0}
-cleanup {rename x {}}
}
-
test assemble-11.6 {dictAppend} {
-body {
proc x {} {
@@ -1342,7 +1245,6 @@ test assemble-11.6 {dictAppend} {
-result {a 1 b 222 c 3}
-cleanup {rename x {}}
}
-
test assemble-11.7 {dictLappend} {
-body {
proc x {} {
@@ -1354,7 +1256,6 @@ test assemble-11.7 {dictLappend} {
-result {a 1 b {2 2} c 3}
-cleanup {rename x {}}
}
-
test assemble-11.8 {upvar} {
-body {
proc x {v} {
@@ -1369,7 +1270,6 @@ test assemble-11.8 {upvar} {
-result 123
-cleanup {rename x {}; rename y {}}
}
-
test assemble-11.9 {nsupvar} {
-body {
namespace eval q { variable v 123 }
@@ -1381,7 +1281,6 @@ test assemble-11.9 {nsupvar} {
-result 123
-cleanup {namespace delete q; rename x {}}
}
-
test assemble-11.10 {variable} {
-body {
namespace eval q { namespace eval r {variable v 123}}
@@ -1404,7 +1303,6 @@ test assemble-12.1 {incr - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-12.2 {incr - wrong # args} {
-body {
assemble {incr too many}
@@ -1413,7 +1311,6 @@ test assemble-12.2 {incr - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-12.3 {incr nonlocal var} {
-body {
list [catch {assemble {incr ::env}} result] $result $errorCode
@@ -1421,7 +1318,6 @@ test assemble-12.3 {incr nonlocal var} {
-result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
-cleanup {unset result}
}
-
test assemble-12.4 {incr} {
-body {
proc x {} {
@@ -1433,7 +1329,6 @@ test assemble-12.4 {incr} {
-result 8
-cleanup {rename x {}}
}
-
test assemble-12.5 {incrArray} {
-body {
proc x {} {
@@ -1445,7 +1340,6 @@ test assemble-12.5 {incrArray} {
-result 8
-cleanup {rename x {}}
}
-
test assemble-12.6 {incr, stupid stack restriction} {
-body {
proc x {} "
@@ -1469,7 +1363,6 @@ test assemble-13.1 {incrImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-13.2 {incrImm - wrong # args} {
-body {
assemble {incrImm too many args}
@@ -1478,7 +1371,6 @@ test assemble-13.2 {incrImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-13.3 {incrImm nonlocal var} {
-body {
list [catch {assemble {incrImm ::env 2}} result] $result $errorCode
@@ -1486,7 +1378,6 @@ test assemble-13.3 {incrImm nonlocal var} {
-result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
-cleanup {unset result}
}
-
test assemble-13.4 {incrImm not a number} {
-body {
proc x {} {
@@ -1498,7 +1389,6 @@ test assemble-13.4 {incrImm not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-13.5 {incrImm too big} {
-body {
proc x {} {
@@ -1509,7 +1399,6 @@ test assemble-13.5 {incrImm too big} {
-result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-13.6 {incrImm too small} {
-body {
proc x {} {
@@ -1520,7 +1409,6 @@ test assemble-13.6 {incrImm too small} {
-result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-13.7 {incrImm} {
-body {
proc x {} {
@@ -1532,7 +1420,6 @@ test assemble-13.7 {incrImm} {
-result {-127 0}
-cleanup {rename x {}}
}
-
test assemble-13.8 {incrArrayImm} {
-body {
proc x {} {
@@ -1544,7 +1431,6 @@ test assemble-13.8 {incrArrayImm} {
-result 8
-cleanup {rename x {}}
}
-
test assemble-13.9 {incrImm, stupid stack restriction} {
-body {
proc x {} "
@@ -1568,7 +1454,6 @@ test assemble-14.1 {incrStkImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-14.2 {incrStkImm - wrong # args} {
-body {
assemble {incrStkImm too many}
@@ -1577,7 +1462,6 @@ test assemble-14.2 {incrStkImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-14.3 {incrStkImm not a number} {
-body {
proc x {} {
@@ -1589,7 +1473,6 @@ test assemble-14.3 {incrStkImm not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-14.4 {incrStkImm too big} {
-body {
proc x {} {
@@ -1600,7 +1483,6 @@ test assemble-14.4 {incrStkImm too big} {
-result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-14.5 {incrStkImm too small} {
-body {
proc x {} {
@@ -1611,7 +1493,6 @@ test assemble-14.5 {incrStkImm too small} {
-result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-14.6 {incrStkImm} {
-body {
proc x {} {
@@ -1624,7 +1505,6 @@ test assemble-14.6 {incrStkImm} {
-result {-127 0}
-cleanup {rename x {}}
}
-
test assemble-14.7 {incrArrayStkImm} {
-body {
proc x {} {
@@ -1647,8 +1527,7 @@ test assemble-15.1 {listIndexImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
-test assemble-16.2 {listIndexImm - wrong # args} {
+test assemble-15.2 {listIndexImm - wrong # args} {
-body {
assemble {listIndexImm too many}
}
@@ -1656,16 +1535,14 @@ test assemble-16.2 {listIndexImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
-test assemble-16.3 {listIndexImm - bad substitution} {
+test assemble-15.3 {listIndexImm - bad substitution} {
-body {
list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode
}
-result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
-cleanup {unset result}
}
-
-test assemble-16.4 {listIndexImm - invalid index} {
+test assemble-15.4 {listIndexImm - invalid index} {
-body {
assemble {listIndexImm rubbish}
}
@@ -1673,22 +1550,19 @@ test assemble-16.4 {listIndexImm - invalid index} {
-match glob
-result {bad index "rubbish"*}
}
-
-test assemble-16.5 {listIndexImm} {
+test assemble-15.5 {listIndexImm} {
-body {
assemble {push {a b c}; listIndexImm 2}
}
-result c
}
-
-test assemble-16.6 {listIndexImm} {
+test assemble-15.6 {listIndexImm} {
-body {
assemble {push {a b c}; listIndexImm end-1}
}
-result b
}
-
-test assemble-16.6 {listIndexImm} {
+test assemble-15.6 {listIndexImm} {
-body {
assemble {push {a b c}; listIndexImm end}
}
@@ -1705,7 +1579,6 @@ test assemble-16.1 {invokeStk - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-16.2 {invokeStk - wrong # args} {
-body {
assemble {invokeStk too many}
@@ -1714,7 +1587,6 @@ test assemble-16.2 {invokeStk - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-16.3 {invokeStk - not a number} {
-body {
proc x {} {
@@ -1726,7 +1598,6 @@ test assemble-16.3 {invokeStk - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-16.4 {invokeStk - no operands} {
-body {
proc x {} {
@@ -1737,14 +1608,12 @@ test assemble-16.4 {invokeStk - no operands} {
-result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-16.5 {invokeStk1} {
-body {
tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3}
}
-result {1 2}
}
-
test assemble-16.6 {invokeStk4} {
-body {
proc x {n} {
@@ -1774,7 +1643,6 @@ test assemble-17.1 {label, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-17.2 {label, wrong # args} {
-body {
assemble {label too many}
@@ -1783,7 +1651,6 @@ test assemble-17.2 {label, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-17.3 {label, bad subst} {
-body {
list [catch {assemble {label $foo}} result] $result $::errorCode
@@ -1791,7 +1658,6 @@ test assemble-17.3 {label, bad subst} {
-result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
-cleanup {unset result}
}
-
test assemble-17.4 {duplicate label} {
-body {
list [catch {assemble {label foo; label foo}} result] \
@@ -1799,7 +1665,6 @@ test assemble-17.4 {duplicate label} {
}
-result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}}
}
-
test assemble-17.5 {jump, wrong # args} {
-body {
assemble {jump}
@@ -1808,7 +1673,6 @@ test assemble-17.5 {jump, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-17.6 {jump, wrong # args} {
-body {
assemble {jump too many}
@@ -1817,7 +1681,6 @@ test assemble-17.6 {jump, wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-17.7 {jump, bad subst} {
-body {
list [catch {assemble {jump $foo}} result] $result $::errorCode
@@ -1825,7 +1688,6 @@ test assemble-17.7 {jump, bad subst} {
-result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
-cleanup {unset result}
}
-
test assemble-17.8 {jump - ahead and back} {
-body {
assemble {
@@ -1858,7 +1720,6 @@ test assemble-17.8 {jump - ahead and back} {
}
-result ceadbf
}
-
test assemble-17.9 {jump - resolve a label multiple times} {
-body {
proc x {} {
@@ -1926,7 +1787,6 @@ test assemble-17.9 {jump - resolve a label multiple times} {
-result abcd
-cleanup {rename x {}}
}
-
test assemble-17.10 {jump4 needed} {
-body {
assemble "push x; jump one; label two; [string repeat {dup; pop;} 128]
@@ -1934,7 +1794,6 @@ test assemble-17.10 {jump4 needed} {
}
-result x
}
-
test assemble-17.11 {jumpTrue} {
-body {
proc x {y} {
@@ -1953,7 +1812,6 @@ test assemble-17.11 {jumpTrue} {
-result {no yes}
-cleanup {rename x {}}
}
-
test assemble-17.12 {jumpFalse} {
-body {
proc x {y} {
@@ -1972,14 +1830,12 @@ test assemble-17.12 {jumpFalse} {
-result {yes no}
-cleanup {rename x {}}
}
-
test assemble-17.13 {jump to undefined label} {
-body {
list [catch {assemble {jump nowhere}} result] $result $::errorCode
}
-result {1 {undefined label "nowhere"} {TCL ASSEM NOLABEL nowhere}}
}
-
test assemble-17.14 {jump to undefined label, line number correct?} {
-body {
catch {assemble {#1
@@ -1994,7 +1850,6 @@ test assemble-17.14 {jump to undefined label, line number correct?} {
-match glob
-result {*"assemble" body, line 4*}
}
-
test assemble-17.15 {multiple passes of code resizing} {
-setup {
set body {
@@ -2037,7 +1892,6 @@ test assemble-18.1 {lindexMulti - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-18.2 {lindexMulti - wrong # args} {
-body {
assemble {lindexMulti too many}
@@ -2046,7 +1900,6 @@ test assemble-18.2 {lindexMulti - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-18.3 {lindexMulti - bad subst} {
-body {
assemble {lindexMulti $foo}
@@ -2055,7 +1908,6 @@ test assemble-18.3 {lindexMulti - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-18.4 {lindexMulti - not a number} {
-body {
proc x {} {
@@ -2067,7 +1919,6 @@ test assemble-18.4 {lindexMulti - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-18.5 {lindexMulti - bad operand count} {
-body {
proc x {} {
@@ -2078,21 +1929,18 @@ test assemble-18.5 {lindexMulti - bad operand count} {
-result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-18.6 {lindexMulti} {
-body {
assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1}
}
-result {{a b c} {d e f} {g h j}}
}
-
test assemble-18.7 {lindexMulti} {
-body {
assemble {push {{a b c} {d e f} {g h j}}; push 1; lindexMulti 2}
}
-result {d e f}
}
-
test assemble-18.8 {lindexMulti} {
-body {
assemble {push {{a b c} {d e f} {g h j}}; push 2; push 1; lindexMulti 3}
@@ -2110,7 +1958,6 @@ test assemble-19.1 {list - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-19.2 {list - wrong # args} {
-body {
assemble {list too many}
@@ -2119,7 +1966,6 @@ test assemble-19.2 {list - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-19.3 {list - bad subst} {
-body {
assemble {list $foo}
@@ -2128,7 +1974,6 @@ test assemble-19.3 {list - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-19.4 {list - not a number} {
-body {
proc x {} {
@@ -2140,7 +1985,6 @@ test assemble-19.4 {list - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-19.5 {list - negative operand count} {
-body {
proc x {} {
@@ -2151,21 +1995,18 @@ test assemble-19.5 {list - negative operand count} {
-result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-19.6 {list - no args} {
-body {
assemble {list 0}
}
-result {}
}
-
test assemble-19.7 {list - 1 arg} {
-body {
assemble {push hello; list 1}
}
-result hello
}
-
test assemble-19.8 {list - 2 args} {
-body {
assemble {push hello; push world; list 2}
@@ -2183,7 +2024,6 @@ test assemble-20.1 {lsetFlat - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-20.2 {lsetFlat - wrong # args} {
-body {
assemble {lsetFlat too many}
@@ -2192,7 +2032,6 @@ test assemble-20.2 {lsetFlat - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-20.3 {lsetFlat - bad subst} {
-body {
assemble {lsetFlat $foo}
@@ -2201,7 +2040,6 @@ test assemble-20.3 {lsetFlat - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-20.4 {lsetFlat - not a number} {
-body {
proc x {} {
@@ -2213,7 +2051,6 @@ test assemble-20.4 {lsetFlat - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-20.5 {lsetFlat - negative operand count} {
-body {
proc x {} {
@@ -2224,14 +2061,12 @@ test assemble-20.5 {lsetFlat - negative operand count} {
-result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}}
-cleanup {rename x {}; unset result}
}
-
test assemble-20.6 {lsetFlat} {
-body {
assemble {push b; push a; lsetFlat 2}
}
-result b
}
-
test assemble-20.7 {lsetFlat} {
-body {
assemble {push 1; push d; push {a b c}; lsetFlat 3}
@@ -2249,7 +2084,6 @@ test assemble-21.1 {over - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-21.2 {over - wrong # args} {
-body {
assemble {over too many}
@@ -2258,7 +2092,6 @@ test assemble-21.2 {over - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-21.3 {over - bad subst} {
-body {
assemble {over $foo}
@@ -2267,7 +2100,6 @@ test assemble-21.3 {over - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-21.4 {over - not a number} {
-body {
proc x {} {
@@ -2279,7 +2111,6 @@ test assemble-21.4 {over - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-21.5 {over - negative operand count} {
-body {
proc x {} {
@@ -2290,7 +2121,6 @@ test assemble-21.5 {over - negative operand count} {
-result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-21.6 {over} {
-body {
proc x {} {
@@ -2312,7 +2142,6 @@ test assemble-21.6 {over} {
-result 3
-cleanup {rename x {}}
}
-
test assemble-21.7 {over} {
-body {
proc x {} {
@@ -2345,7 +2174,6 @@ test assemble-22.1 {reverse - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-22.2 {reverse - wrong # args} {
-body {
assemble {reverse too many}
@@ -2375,7 +2203,6 @@ test assemble-22.4 {reverse - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-22.5 {reverse - negative operand count} {
-body {
proc x {} {
@@ -2386,7 +2213,6 @@ test assemble-22.5 {reverse - negative operand count} {
-result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-22.6 {reverse - zero operand count} {
-body {
proc x {} {
@@ -2397,7 +2223,6 @@ test assemble-22.6 {reverse - zero operand count} {
-result 1
-cleanup {rename x {}}
}
-
test assemble-22.7 {reverse} {
-body {
proc x {} {
@@ -2418,7 +2243,6 @@ test assemble-22.7 {reverse} {
-result 3
-cleanup {rename x {}}
}
-
test assemble-22.8 {reverse} {
-body {
proc x {} {
@@ -2450,7 +2274,6 @@ test assemble-23.1 {strmatch - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-23.2 {strmatch - wrong # args} {
-body {
assemble {strmatch too many}
@@ -2459,7 +2282,6 @@ test assemble-23.2 {strmatch - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-23.3 {strmatch - bad subst} {
-body {
assemble {strmatch $foo}
@@ -2468,7 +2290,6 @@ test assemble-23.3 {strmatch - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-23.4 {strmatch - not a boolean} {
-body {
proc x {} {
@@ -2480,7 +2301,6 @@ test assemble-23.4 {strmatch - not a boolean} {
-result {expected boolean value but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-23.5 {strmatch} {
-body {
proc x {a b} {
@@ -2492,7 +2312,6 @@ test assemble-23.5 {strmatch} {
-result {{0 0} {1 1} {0 1}}
-cleanup {rename x {}}
}
-
test assemble-23.6 {unsetStk} {
-body {
proc x {} {
@@ -2505,7 +2324,6 @@ test assemble-23.6 {unsetStk} {
-result 0
-cleanup {rename x {}}
}
-
test assemble-23.7 {unsetStk} {
-body {
proc x {} {
@@ -2529,7 +2347,6 @@ test assemble-23.8 {unsetStk} {
-result {can't unset "a": no such variable}
-cleanup {rename x {}}
}
-
test assemble-23.9 {unsetArrayStk} {
-body {
proc x {} {
@@ -2542,7 +2359,6 @@ test assemble-23.9 {unsetArrayStk} {
-result 0
-cleanup {rename x {}}
}
-
test assemble-23.10 {unsetArrayStk} {
-body {
proc x {} {
@@ -2577,7 +2393,6 @@ test assemble-24.1 {unset - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-24.2 {unset - wrong # args} {
-body {
assemble {unset too many args}
@@ -2586,7 +2401,6 @@ test assemble-24.2 {unset - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-24.3 {unset - bad subst -arg 1} {
-body {
assemble {unset $foo bar}
@@ -2595,7 +2409,6 @@ test assemble-24.3 {unset - bad subst -arg 1} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-24.4 {unset - not a boolean} {
-body {
proc x {} {
@@ -2607,7 +2420,6 @@ test assemble-24.4 {unset - not a boolean} {
-result {expected boolean value but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-24.5 {unset - bad subst - arg 2} {
-body {
assemble {unset true $bar}
@@ -2615,7 +2427,6 @@ test assemble-24.5 {unset - bad subst - arg 2} {
-returnCodes error
-result {assembly code may not contain substitutions}
}
-
test assemble-24.6 {unset - nonlocal var} {
-body {
assemble {unset true ::foo::bar}
@@ -2623,7 +2434,6 @@ test assemble-24.6 {unset - nonlocal var} {
-returnCodes error
-result {variable "::foo::bar" is not local}
}
-
test assemble-24.7 {unset} {
-body {
proc x {} {
@@ -2636,7 +2446,6 @@ test assemble-24.7 {unset} {
-result 0
-cleanup {rename x {}}
}
-
test assemble-24.8 {unset} {
-body {
proc x {} {
@@ -2660,7 +2469,6 @@ test assemble-24.9 {unset} {
-result {can't unset "a": no such variable}
-cleanup {rename x {}}
}
-
test assemble-24.10 {unsetArray} {
-body {
proc x {} {
@@ -2673,7 +2481,6 @@ test assemble-24.10 {unsetArray} {
-result 0
-cleanup {rename x {}}
}
-
test assemble-24.11 {unsetArray} {
-body {
proc x {} {
@@ -2685,7 +2492,6 @@ test assemble-24.11 {unsetArray} {
-result 0
-cleanup {rename x {}}
}
-
test assemble-24.12 {unsetArray} {
-body {
proc x {} {
@@ -2709,7 +2515,6 @@ test assemble-25.1 {dict get - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-25.2 {dict get - wrong # args} {
-body {
assemble {dictGet too many}
@@ -2718,7 +2523,6 @@ test assemble-25.2 {dict get - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-25.3 {dictGet - bad subst} {
-body {
assemble {dictGet $foo}
@@ -2727,7 +2531,6 @@ test assemble-25.3 {dictGet - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-25.4 {dict get - not a number} {
-body {
proc x {} {
@@ -2739,7 +2542,6 @@ test assemble-25.4 {dict get - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-25.5 {dictGet - negative operand count} {
-body {
proc x {} {
@@ -2750,7 +2552,6 @@ test assemble-25.5 {dictGet - negative operand count} {
-result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-25.6 {dictGet - 1 index} {
-body {
assemble {push {a 1 b 2}; push a; dictGet 1}
@@ -2768,7 +2569,6 @@ test assemble-26.1 {dict set - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-26.2 {dict get - wrong # args} {
-body {
assemble {dictSet too many args}
@@ -2777,7 +2577,6 @@ test assemble-26.2 {dict get - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-26.3 {dictSet - bad subst} {
-body {
assemble {dictSet 1 $foo}
@@ -2786,7 +2585,6 @@ test assemble-26.3 {dictSet - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-26.4 {dictSet - not a number} {
-body {
proc x {} {
@@ -2798,7 +2596,6 @@ test assemble-26.4 {dictSet - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-26.5 {dictSet - zero operand count} {
-body {
proc x {} {
@@ -2809,7 +2606,6 @@ test assemble-26.5 {dictSet - zero operand count} {
-result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-26.6 {dictSet - bad local} {
-body {
proc x {} {
@@ -2820,7 +2616,6 @@ test assemble-26.6 {dictSet - bad local} {
-result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
-cleanup {rename x {}; unset result}
}
-
test assemble-26.7 {dictSet} {
-body {
proc x {} {
@@ -2843,7 +2638,6 @@ test assemble-27.1 {dictUnset - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-27.2 {dictUnset - wrong # args} {
-body {
assemble {dictUnset too many args}
@@ -2852,7 +2646,6 @@ test assemble-27.2 {dictUnset - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-27.3 {dictUnset - bad subst} {
-body {
assemble {dictUnset 1 $foo}
@@ -2861,7 +2654,6 @@ test assemble-27.3 {dictUnset - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-27.4 {dictUnset - not a number} {
-body {
proc x {} {
@@ -2873,7 +2665,6 @@ test assemble-27.4 {dictUnset - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-27.5 {dictUnset - zero operand count} {
-body {
proc x {} {
@@ -2884,7 +2675,6 @@ test assemble-27.5 {dictUnset - zero operand count} {
-result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
-cleanup {rename x {}; unset result}
}
-
test assemble-27.6 {dictUnset - bad local} {
-body {
proc x {} {
@@ -2895,7 +2685,6 @@ test assemble-27.6 {dictUnset - bad local} {
-result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
-cleanup {rename x {}; unset result}
}
-
test assemble-27.7 {dictUnset} {
-body {
proc x {} {
@@ -2918,7 +2707,6 @@ test assemble-28.1 {dictIncrImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-28.2 {dictIncrImm - wrong # args} {
-body {
assemble {dictIncrImm too many args}
@@ -2927,7 +2715,6 @@ test assemble-28.2 {dictIncrImm - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-28.3 {dictIncrImm - bad subst} {
-body {
assemble {dictIncrImm 1 $foo}
@@ -2936,7 +2723,6 @@ test assemble-28.3 {dictIncrImm - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-28.4 {dictIncrImm - not a number} {
-body {
proc x {} {
@@ -2948,7 +2734,6 @@ test assemble-28.4 {dictIncrImm - not a number} {
-result {expected integer but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-28.5 {dictIncrImm - bad local} {
-body {
proc x {} {
@@ -2959,7 +2744,6 @@ test assemble-28.5 {dictIncrImm - bad local} {
-result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
-cleanup {rename x {}; unset result}
}
-
test assemble-28.6 {dictIncrImm} {
-body {
proc x {} {
@@ -2982,7 +2766,6 @@ test assemble-29.1 {regexp - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-29.2 {regexp - wrong # args} {
-body {
assemble {regexp too many}
@@ -2991,7 +2774,6 @@ test assemble-29.2 {regexp - wrong # args} {
-match glob
-result {wrong # args*}
}
-
test assemble-29.3 {regexp - bad subst} {
-body {
assemble {regexp $foo}
@@ -3000,7 +2782,6 @@ test assemble-29.3 {regexp - bad subst} {
-match glob
-result {assembly code may not contain substitutions}
}
-
test assemble-29.4 {regexp - not a boolean} {
-body {
proc x {} {
@@ -3012,21 +2793,18 @@ test assemble-29.4 {regexp - not a boolean} {
-result {expected boolean value but got "rubbish"}
-cleanup {rename x {}}
}
-
test assemble-29.5 {regexp} {
-body {
assemble {push br.*br; push abracadabra; regexp false}
}
-result 1
}
-
test assemble-29.6 {regexp} {
-body {
assemble {push br.*br; push aBRacadabra; regexp false}
}
-result 0
}
-
test assemble-29.7 {regexp} {
-body {
assemble {push br.*br; push aBRacadabra; regexp true}
@@ -3058,7 +2836,6 @@ test assemble-30.1 {simplest possible catch} {
-result 1
-cleanup {rename x {}}
}
-
test assemble-30.2 {catch in external catch conntext} {
-body {
proc x {} {
@@ -3083,7 +2860,6 @@ test assemble-30.2 {catch in external catch conntext} {
-result {0 1}
-cleanup {rename x {}}
}
-
test assemble-30.3 {embedded catches} {
-body {
proc x {} {
@@ -3110,7 +2886,6 @@ test assemble-30.3 {embedded catches} {
-result {0 {1 {1 whatever}}}
-cleanup {rename x {}}
}
-
test assemble-30.4 {throw in wrong context} {
-body {
proc x {} {
@@ -3140,7 +2915,6 @@ test assemble-30.4 {throw in wrong context} {
-result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} { in assembly code between lines 10 and 15}*}}
-cleanup {rename x {}}
}
-
test assemble-30.5 {unclosed catch} {
-body {
proc x {} {
@@ -3162,7 +2936,6 @@ test assemble-30.5 {unclosed catch} {
("assemble" body, line 2)*}}
-cleanup {rename x {}}
}
-
test assemble-30.6 {inconsistent catch contexts} {
-body {
proc x {y} {
@@ -3241,7 +3014,6 @@ test assemble-31.6 {jumpTable, missing symbol} {
-match glob
-result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}}
}
-
test assemble-31.7 {jumptable, actual example} {
-setup {
proc x {} {
@@ -3293,7 +3065,6 @@ test assemble-40.1 {unbalanced stack} {
-match glob
-returnCodes ok
}
-
test assemble-40.2 {unbalanced stack} {*}{
-body {
list \
@@ -3338,7 +3109,6 @@ test assemble-41.1 {Inconsistent stack usage} {*}{
-result {inconsistent stack depths on two execution paths
("assemble" body, line 10)*}
}
-
test assemble-41.2 {Inconsistent stack, jumptable and default} {
-body {
proc x {y} {
@@ -3357,7 +3127,6 @@ test assemble-41.2 {Inconsistent stack, jumptable and default} {
-result {inconsistent stack depths on two execution paths
("assemble" body, line 6)*}
}
-
test assemble-41.3 {Inconsistent stack, two legs of jumptable} {
-body {
proc x {y} {
@@ -3429,7 +3198,7 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
}
-result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
}
-
+
rename fillTables {}
rename assemble {}
@@ -3438,4 +3207,5 @@ return
# Local Variables:
# mode: tcl
-# End: \ No newline at end of file
+# fill-column: 78
+# End:
generated by cgit v0.12 at 2024-11-07 10:17:14 (GMT)