summaryrefslogtreecommitdiffstats
path: root/tcl8.6/generic/tclCompile.h
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2016-12-21 22:56:22 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2016-12-21 22:56:22 (GMT)
commitd1a6de55efc90f190dee42ab8c4fa9070834e77d (patch)
treeec633f5608ef498bee52a5f42c12c49493ec8bf8 /tcl8.6/generic/tclCompile.h
parent5514e37335c012cc70f5b9aee3cedfe3d57f583f (diff)
parent98acd3f494b28ddd8c345a2bb9311e41e2d56ddd (diff)
downloadblt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.zip
blt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.tar.gz
blt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.tar.bz2
Merge commit '98acd3f494b28ddd8c345a2bb9311e41e2d56ddd' as 'tcl8.6'
Diffstat (limited to 'tcl8.6/generic/tclCompile.h')
-rw-r--r--tcl8.6/generic/tclCompile.h1908
1 files changed, 1908 insertions, 0 deletions
diff --git a/tcl8.6/generic/tclCompile.h b/tcl8.6/generic/tclCompile.h
new file mode 100644
index 0000000..d5bc86b
--- /dev/null
+++ b/tcl8.6/generic/tclCompile.h
@@ -0,0 +1,1908 @@
+/*
+ * tclCompile.h --
+ *
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
+ * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef _TCLCOMPILATION
+#define _TCLCOMPILATION 1
+
+#include "tclInt.h"
+
+struct ByteCode; /* Forward declaration. */
+
+/*
+ *------------------------------------------------------------------------
+ * Variables related to compilation. These are used in tclCompile.c,
+ * tclExecute.c, tclBasic.c, and their clients.
+ *------------------------------------------------------------------------
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ * Variable that controls whether compilation tracing is enabled and, if so,
+ * what level of tracing is desired:
+ * 0: no compilation tracing
+ * 1: summarize compilation of top level cmds and proc bodies
+ * 2: display all instructions of each ByteCode compiled
+ * This variable is linked to the Tcl variable "tcl_traceCompile".
+ */
+
+MODULE_SCOPE int tclTraceCompile;
+
+/*
+ * Variable that controls whether execution tracing is enabled and, if so,
+ * what level of tracing is desired:
+ * 0: no execution tracing
+ * 1: trace invocations of Tcl procs only
+ * 2: trace invocations of all (not compiled away) commands
+ * 3: display each instruction executed
+ * This variable is linked to the Tcl variable "tcl_traceExec".
+ */
+
+MODULE_SCOPE int tclTraceExec;
+#endif
+
+/*
+ * The type of lambda expressions. Note that every lambda will *always* have a
+ * string representation.
+ */
+
+MODULE_SCOPE const Tcl_ObjType tclLambdaType;
+
+/*
+ *------------------------------------------------------------------------
+ * Data structures related to compilation.
+ *------------------------------------------------------------------------
+ */
+
+/*
+ * The structure used to implement Tcl "exceptions" (exceptional returns): for
+ * example, those generated in loops by the break and continue commands, and
+ * those generated by scripts and caught by the catch command. This
+ * ExceptionRange structure describes a range of code (e.g., a loop body), the
+ * kind of exceptions (e.g., a break or continue) that might occur, and the PC
+ * offsets to jump to if a matching exception does occur. Exception ranges can
+ * nest so this structure includes a nesting level that is used at runtime to
+ * find the closest exception range surrounding a PC. For example, when a
+ * break command is executed, the ExceptionRange structure for the most deeply
+ * nested loop, if any, is found and used. These structures are also generated
+ * for the "next" subcommands of for loops since a break there terminates the
+ * for command. This means a for command actually generates two LoopInfo
+ * structures.
+ */
+
+typedef enum {
+ LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break
+ * and continue "exceptions" cause jumps to
+ * appropriate PC offsets. */
+ CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch
+ * command. Errors in the range cause a jump
+ * to a catch PC offset. */
+} ExceptionRangeType;
+
+typedef struct ExceptionRange {
+ ExceptionRangeType type; /* The kind of ExceptionRange. */
+ int nestingLevel; /* Static depth of the exception range. Used
+ * to find the most deeply-nested range
+ * surrounding a PC at runtime. */
+ int codeOffset; /* Offset of the first instruction byte of the
+ * code range. */
+ int numCodeBytes; /* Number of bytes in the code range. */
+ int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC
+ * offset for a break command in the range. */
+ int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the
+ * target PC offset for a continue command in
+ * the code range. Otherwise, ignore this
+ * range when processing a continue
+ * command. */
+ int catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC
+ * offset for any "exception" in range. */
+} ExceptionRange;
+
+/*
+ * Auxiliary data used when issuing (currently just loop) exception ranges,
+ * but which is not required during execution.
+ */
+
+typedef struct ExceptionAux {
+ int supportsContinue; /* Whether this exception range will have a
+ * continueOffset created for it; if it is a
+ * loop exception range that *doesn't* have
+ * one (see [for] next-clause) then we must
+ * not pick up the range when scanning for a
+ * target to continue to. */
+ int stackDepth; /* The stack depth at the point where the
+ * exception range was created. This is used
+ * to calculate the number of POPs required to
+ * restore the stack to its prior state. */
+ int expandTarget; /* The number of expansions expected on the
+ * auxData stack at the time the loop starts;
+ * we can't currently discard them except by
+ * doing INST_INVOKE_EXPANDED; this is a known
+ * problem. */
+ int expandTargetDepth; /* The stack depth expected at the outermost
+ * expansion within the loop. Not meaningful
+ * if there are no open expansions between the
+ * looping level and the point of jump
+ * issue. */
+ int numBreakTargets; /* The number of [break]s that want to be
+ * targeted to the place where this loop
+ * exception will be bound to. */
+ unsigned int *breakTargets; /* The offsets of the INST_JUMP4 instructions
+ * issued by the [break]s that we must
+ * update. Note that resizing a jump (via
+ * TclFixupForwardJump) can cause the contents
+ * of this array to be updated. When
+ * numBreakTargets==0, this is NULL. */
+ int allocBreakTargets; /* The size of the breakTargets array. */
+ int numContinueTargets; /* The number of [continue]s that want to be
+ * targeted to the place where this loop
+ * exception will be bound to. */
+ unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
+ * issued by the [continue]s that we must
+ * update. Note that resizing a jump (via
+ * TclFixupForwardJump) can cause the contents
+ * of this array to be updated. When
+ * numContinueTargets==0, this is NULL. */
+ int allocContinueTargets; /* The size of the continueTargets array. */
+} ExceptionAux;
+
+/*
+ * Structure used to map between instruction pc and source locations. It
+ * defines for each compiled Tcl command its code's starting offset and its
+ * source's starting offset and length. Note that the code offset increases
+ * monotonically: that is, the table is sorted in code offset order. The
+ * source offset is not monotonic.
+ */
+
+typedef struct CmdLocation {
+ int codeOffset; /* Offset of first byte of command code. */
+ int numCodeBytes; /* Number of bytes for command's code. */
+ int srcOffset; /* Offset of first char of the command. */
+ int numSrcBytes; /* Number of command source chars. */
+} CmdLocation;
+
+/*
+ * TIP #280
+ * Structure to record additional location information for byte code. This
+ * information is internal and not saved. i.e. tbcload'ed code will not have
+ * this information. It records the lines for all words of all commands found
+ * in the byte code. The association with a ByteCode structure BC is done
+ * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
+ * Also recorded is information coming from the context, i.e. type of the
+ * frame and associated information, like the path of a sourced file.
+ */
+
+typedef struct ECL {
+ int srcOffset; /* Command location to find the entry. */
+ int nline; /* Number of words in the command */
+ int *line; /* Line information for all words in the
+ * command. */
+ int **next; /* Transient information used by the compiler
+ * for tracking of hidden continuation
+ * lines. */
+} ECL;
+
+typedef struct ExtCmdLoc {
+ int type; /* Context type. */
+ int start; /* Starting line for compiled script. Needed
+ * for the extended recompile check in
+ * tclCompileObj. */
+ Tcl_Obj *path; /* Path of the sourced file the command is
+ * in. */
+ ECL *loc; /* Command word locations (lines). */
+ int nloc; /* Number of allocated entries in 'loc'. */
+ int nuloc; /* Number of used entries in 'loc'. */
+} ExtCmdLoc;
+
+/*
+ * CompileProcs need the ability to record information during compilation that
+ * can be used by bytecode instructions during execution. The AuxData
+ * structure provides this "auxiliary data" mechanism. An arbitrary number of
+ * these structures can be stored in the ByteCode record (during compilation
+ * they are stored in a CompileEnv structure). Each AuxData record holds one
+ * word of client-specified data (often a pointer) and is given an index that
+ * instructions can later use to look up the structure and its data.
+ *
+ * The following definitions declare the types of procedures that are called
+ * to duplicate or free this auxiliary data when the containing ByteCode
+ * objects are duplicated and freed. Pointers to these procedures are kept in
+ * the AuxData structure.
+ */
+
+typedef ClientData (AuxDataDupProc) (ClientData clientData);
+typedef void (AuxDataFreeProc) (ClientData clientData);
+typedef void (AuxDataPrintProc)(ClientData clientData,
+ Tcl_Obj *appendObj, struct ByteCode *codePtr,
+ unsigned int pcOffset);
+
+/*
+ * We define a separate AuxDataType struct to hold type-related information
+ * for the AuxData structure. This separation makes it possible for clients
+ * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
+ * example, it makes it possible to pickle and unpickle AuxData structs.
+ */
+
+typedef struct AuxDataType {
+ const char *name; /* The name of the type. Types can be
+ * registered and found by name */
+ AuxDataDupProc *dupProc; /* Callback procedure to invoke when the aux
+ * data is duplicated (e.g., when the ByteCode
+ * structure containing the aux data is
+ * duplicated). NULL means just copy the
+ * source clientData bits; no proc need be
+ * called. */
+ AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the aux
+ * data is freed. NULL means no proc need be
+ * called. */
+ AuxDataPrintProc *printProc;/* Callback function to invoke when printing
+ * the aux data as part of debugging. NULL
+ * means that the data can't be printed. */
+ AuxDataPrintProc *disassembleProc;
+ /* Callback function to invoke when doing a
+ * disassembly of the aux data (like the
+ * printProc, except that the output is
+ * intended to be script-readable). The
+ * appendObj argument should be filled in with
+ * a descriptive dictionary; it will start out
+ * with "name" mapped to the content of the
+ * name field. NULL means that the printProc
+ * should be used instead. */
+} AuxDataType;
+
+/*
+ * The definition of the AuxData structure that holds information created
+ * during compilation by CompileProcs and used by instructions during
+ * execution.
+ */
+
+typedef struct AuxData {
+ const AuxDataType *type; /* Pointer to the AuxData type associated with
+ * this ClientData. */
+ ClientData clientData; /* The compilation data itself. */
+} AuxData;
+
+/*
+ * Structure defining the compilation environment. After compilation, fields
+ * describing bytecode instructions are copied out into the more compact
+ * ByteCode structure defined below.
+ */
+
+#define COMPILEENV_INIT_CODE_BYTES 250
+#define COMPILEENV_INIT_NUM_OBJECTS 60
+#define COMPILEENV_INIT_EXCEPT_RANGES 5
+#define COMPILEENV_INIT_CMD_MAP_SIZE 40
+#define COMPILEENV_INIT_AUX_DATA_SIZE 5
+
+typedef struct CompileEnv {
+ Interp *iPtr; /* Interpreter containing the code being
+ * compiled. Commands and their compile procs
+ * are specific to an interpreter so the code
+ * emitted will depend on the interpreter. */
+ const char *source; /* The source string being compiled by
+ * SetByteCodeFromAny. This pointer is not
+ * owned by the CompileEnv and must not be
+ * freed or changed by it. */
+ int numSrcBytes; /* Number of bytes in source. */
+ Proc *procPtr; /* If a procedure is being compiled, a pointer
+ * to its Proc structure; otherwise NULL. Used
+ * to compile local variables. Set from
+ * information provided by ObjInterpProc in
+ * tclProc.c. */
+ int numCommands; /* Number of commands compiled. */
+ int exceptDepth; /* Current exception range nesting level; -1
+ * if not in any range currently. */
+ int maxExceptDepth; /* Max nesting level of exception ranges; -1
+ * if no ranges have been compiled. */
+ int maxStackDepth; /* Maximum number of stack elements needed to
+ * execute the code. Set by compilation
+ * procedures before returning. */
+ int currStackDepth; /* Current stack depth. */
+ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl
+ * objects referenced by this compiled code.
+ * Indexed by the string representations of
+ * the literals. Used to avoid creating
+ * duplicate objects. */
+ unsigned char *codeStart; /* Points to the first byte of the code. */
+ unsigned char *codeNext; /* Points to next code array byte to use. */
+ unsigned char *codeEnd; /* Points just after the last allocated code
+ * array byte. */
+ int mallocedCodeArray; /* Set 1 if code array was expanded and
+ * codeStart points into the heap.*/
+ LiteralEntry *literalArrayPtr;
+ /* Points to start of LiteralEntry array. */
+ int literalArrayNext; /* Index of next free object array entry. */
+ int literalArrayEnd; /* Index just after last obj array entry. */
+ int mallocedLiteralArray; /* 1 if object array was expanded and objArray
+ * points into the heap, else 0. */
+ ExceptionRange *exceptArrayPtr;
+ /* Points to start of the ExceptionRange
+ * array. */
+ int exceptArrayNext; /* Next free ExceptionRange array index.
+ * exceptArrayNext is the number of ranges and
+ * (exceptArrayNext-1) is the index of the
+ * current range's array entry. */
+ int exceptArrayEnd; /* Index after the last ExceptionRange array
+ * entry. */
+ int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
+ * exceptArrayPtr points in heap, else 0. */
+ ExceptionAux *exceptAuxArrayPtr;
+ /* Array of information used to restore the
+ * state when processing BREAK/CONTINUE
+ * exceptions. Must be the same size as the
+ * exceptArrayPtr. */
+ CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array.
+ * numCommands is the index of the next entry
+ * to use; (numCommands-1) is the entry index
+ * for the last command. */
+ int cmdMapEnd; /* Index after last CmdLocation entry. */
+ int mallocedCmdMap; /* 1 if command map array was expanded and
+ * cmdMapPtr points in the heap, else 0. */
+ AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */
+ int auxDataArrayNext; /* Next free compile aux data array index.
+ * auxDataArrayNext is the number of aux data
+ * items and (auxDataArrayNext-1) is index of
+ * current aux data array entry. */
+ int auxDataArrayEnd; /* Index after last aux data array entry. */
+ int mallocedAuxDataArray; /* 1 if aux data array was expanded and
+ * auxDataArrayPtr points in heap else 0. */
+ unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
+ /* Initial storage for code. */
+ LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
+ /* Initial storage of LiteralEntry array. */
+ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+ /* Initial ExceptionRange array storage. */
+ ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+ /* Initial static except auxiliary info array
+ * storage. */
+ CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
+ /* Initial storage for cmd location map. */
+ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
+ /* Initial storage for aux data array. */
+ /* TIP #280 */
+ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for
+ * 'info frame'. */
+ int line; /* First line of the script, based on the
+ * invoking context, then the line of the
+ * command currently compiled. */
+ int atCmdStart; /* Flag to say whether an INST_START_CMD
+ * should be issued; they should never be
+ * issued repeatedly, as that is significantly
+ * inefficient. If set to 2, that instruction
+ * should not be issued at all (by the generic
+ * part of the command compiler). */
+ int expandCount; /* Number of INST_EXPAND_START instructions
+ * encountered that have not yet been paired
+ * with a corresponding
+ * INST_INVOKE_EXPANDED. */
+ int *clNext; /* If not NULL, it refers to the next slot in
+ * clLoc to check for an invisible
+ * continuation line. */
+} CompileEnv;
+
+/*
+ * The structure defining the bytecode instructions resulting from compiling a
+ * Tcl script. Note that this structure is variable length: a single heap
+ * object is allocated to hold the ByteCode structure immediately followed by
+ * the code bytes, the literal object array, the ExceptionRange array, the
+ * CmdLocation map, and the compilation AuxData array.
+ */
+
+/*
+ * A PRECOMPILED bytecode struct is one that was generated from a compiled
+ * image rather than implicitly compiled from source
+ */
+
+#define TCL_BYTECODE_PRECOMPILED 0x0001
+
+/*
+ * When a bytecode is compiled, interp or namespace resolvers have not been
+ * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
+ */
+
+#define TCL_BYTECODE_RESOLVE_VARS 0x0002
+
+#define TCL_BYTECODE_RECOMPILE 0x0004
+
+typedef struct ByteCode {
+ TclHandle interpHandle; /* Handle for interpreter containing the
+ * compiled code. Commands and their compile
+ * procs are specific to an interpreter so the
+ * code emitted will depend on the
+ * interpreter. */
+ int compileEpoch; /* Value of iPtr->compileEpoch when this
+ * ByteCode was compiled. Used to invalidate
+ * code when, e.g., commands with compile
+ * procs are redefined. */
+ Namespace *nsPtr; /* Namespace context in which this code was
+ * compiled. If the code is executed if a
+ * different namespace, it must be
+ * recompiled. */
+ int nsEpoch; /* Value of nsPtr->resolverEpoch when this
+ * ByteCode was compiled. Used to invalidate
+ * code when new namespace resolution rules
+ * are put into effect. */
+ int refCount; /* Reference count: set 1 when created plus 1
+ * for each execution of the code currently
+ * active. This structure can be freed when
+ * refCount becomes zero. */
+ unsigned int flags; /* flags describing state for the codebyte.
+ * this variable holds ORed values from the
+ * TCL_BYTECODE_ masks defined above */
+ const char *source; /* The source string from which this ByteCode
+ * was compiled. Note that this pointer is not
+ * owned by the ByteCode and must not be freed
+ * or modified by it. */
+ Proc *procPtr; /* If the ByteCode was compiled from a
+ * procedure body, this is a pointer to its
+ * Proc structure; otherwise NULL. This
+ * pointer is also not owned by the ByteCode
+ * and must not be freed by it. */
+ size_t structureSize; /* Number of bytes in the ByteCode structure
+ * itself. Does not include heap space for
+ * literal Tcl objects or storage referenced
+ * by AuxData entries. */
+ int numCommands; /* Number of commands compiled. */
+ int numSrcBytes; /* Number of source bytes compiled. */
+ int numCodeBytes; /* Number of code bytes. */
+ int numLitObjects; /* Number of objects in literal array. */
+ int numExceptRanges; /* Number of ExceptionRange array elems. */
+ int numAuxDataItems; /* Number of AuxData items. */
+ int numCmdLocBytes; /* Number of bytes needed for encoded command
+ * location information. */
+ int maxExceptDepth; /* Maximum nesting level of ExceptionRanges;
+ * -1 if no ranges were compiled. */
+ int maxStackDepth; /* Maximum number of stack elements needed to
+ * execute the code. */
+ unsigned char *codeStart; /* Points to the first byte of the code. This
+ * is just after the final ByteCode member
+ * cmdMapPtr. */
+ Tcl_Obj **objArrayPtr; /* Points to the start of the literal object
+ * array. This is just after the last code
+ * byte. */
+ ExceptionRange *exceptArrayPtr;
+ /* Points to the start of the ExceptionRange
+ * array. This is just after the last object
+ * in the object array. */
+ AuxData *auxDataArrayPtr; /* Points to the start of the auxiliary data
+ * array. This is just after the last entry in
+ * the ExceptionRange array. */
+ unsigned char *codeDeltaStart;
+ /* Points to the first of a sequence of bytes
+ * that encode the change in the starting
+ * offset of each command's code. If -127 <=
+ * delta <= 127, it is encoded as 1 byte,
+ * otherwise 0xFF (128) appears and the delta
+ * is encoded by the next 4 bytes. Code deltas
+ * are always positive. This sequence is just
+ * after the last entry in the AuxData
+ * array. */
+ unsigned char *codeLengthStart;
+ /* Points to the first of a sequence of bytes
+ * that encode the length of each command's
+ * code. The encoding is the same as for code
+ * deltas. Code lengths are always positive.
+ * This sequence is just after the last entry
+ * in the code delta sequence. */
+ unsigned char *srcDeltaStart;
+ /* Points to the first of a sequence of bytes
+ * that encode the change in the starting
+ * offset of each command's source. The
+ * encoding is the same as for code deltas.
+ * Source deltas can be negative. This
+ * sequence is just after the last byte in the
+ * code length sequence. */
+ unsigned char *srcLengthStart;
+ /* Points to the first of a sequence of bytes
+ * that encode the length of each command's
+ * source. The encoding is the same as for
+ * code deltas. Source lengths are always
+ * positive. This sequence is just after the
+ * last byte in the source delta sequence. */
+ LocalCache *localCachePtr; /* Pointer to the start of the cached variable
+ * names and initialisation data for local
+ * variables. */
+#ifdef TCL_COMPILE_STATS
+ Tcl_Time createTime; /* Absolute time when the ByteCode was
+ * created. */
+#endif /* TCL_COMPILE_STATS */
+} ByteCode;
+
+/*
+ * Opcodes for the Tcl bytecode instructions. These must correspond to the
+ * entries in the table of instruction descriptions, tclInstructionTable, in
+ * tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
+ * INST_LOR) must match the entries in the array operatorStrings in
+ * tclExecute.c.
+ */
+
+/* Opcodes 0 to 9 */
+#define INST_DONE 0
+#define INST_PUSH1 1
+#define INST_PUSH4 2
+#define INST_POP 3
+#define INST_DUP 4
+#define INST_STR_CONCAT1 5
+#define INST_INVOKE_STK1 6
+#define INST_INVOKE_STK4 7
+#define INST_EVAL_STK 8
+#define INST_EXPR_STK 9
+
+/* Opcodes 10 to 23 */
+#define INST_LOAD_SCALAR1 10
+#define INST_LOAD_SCALAR4 11
+#define INST_LOAD_SCALAR_STK 12
+#define INST_LOAD_ARRAY1 13
+#define INST_LOAD_ARRAY4 14
+#define INST_LOAD_ARRAY_STK 15
+#define INST_LOAD_STK 16
+#define INST_STORE_SCALAR1 17
+#define INST_STORE_SCALAR4 18
+#define INST_STORE_SCALAR_STK 19
+#define INST_STORE_ARRAY1 20
+#define INST_STORE_ARRAY4 21
+#define INST_STORE_ARRAY_STK 22
+#define INST_STORE_STK 23
+
+/* Opcodes 24 to 33 */
+#define INST_INCR_SCALAR1 24
+#define INST_INCR_SCALAR_STK 25
+#define INST_INCR_ARRAY1 26
+#define INST_INCR_ARRAY_STK 27
+#define INST_INCR_STK 28
+#define INST_INCR_SCALAR1_IMM 29
+#define INST_INCR_SCALAR_STK_IMM 30
+#define INST_INCR_ARRAY1_IMM 31
+#define INST_INCR_ARRAY_STK_IMM 32
+#define INST_INCR_STK_IMM 33
+
+/* Opcodes 34 to 39 */
+#define INST_JUMP1 34
+#define INST_JUMP4 35
+#define INST_JUMP_TRUE1 36
+#define INST_JUMP_TRUE4 37
+#define INST_JUMP_FALSE1 38
+#define INST_JUMP_FALSE4 39
+
+/* Opcodes 40 to 64 */
+#define INST_LOR 40
+#define INST_LAND 41
+#define INST_BITOR 42
+#define INST_BITXOR 43
+#define INST_BITAND 44
+#define INST_EQ 45
+#define INST_NEQ 46
+#define INST_LT 47
+#define INST_GT 48
+#define INST_LE 49
+#define INST_GE 50
+#define INST_LSHIFT 51
+#define INST_RSHIFT 52
+#define INST_ADD 53
+#define INST_SUB 54
+#define INST_MULT 55
+#define INST_DIV 56
+#define INST_MOD 57
+#define INST_UPLUS 58
+#define INST_UMINUS 59
+#define INST_BITNOT 60
+#define INST_LNOT 61
+#define INST_CALL_BUILTIN_FUNC1 62
+#define INST_CALL_FUNC1 63
+#define INST_TRY_CVT_TO_NUMERIC 64
+
+/* Opcodes 65 to 66 */
+#define INST_BREAK 65
+#define INST_CONTINUE 66
+
+/* Opcodes 67 to 68 */
+#define INST_FOREACH_START4 67 /* DEPRECATED */
+#define INST_FOREACH_STEP4 68 /* DEPRECATED */
+
+/* Opcodes 69 to 72 */
+#define INST_BEGIN_CATCH4 69
+#define INST_END_CATCH 70
+#define INST_PUSH_RESULT 71
+#define INST_PUSH_RETURN_CODE 72
+
+/* Opcodes 73 to 78 */
+#define INST_STR_EQ 73
+#define INST_STR_NEQ 74
+#define INST_STR_CMP 75
+#define INST_STR_LEN 76
+#define INST_STR_INDEX 77
+#define INST_STR_MATCH 78
+
+/* Opcodes 78 to 81 */
+#define INST_LIST 79
+#define INST_LIST_INDEX 80
+#define INST_LIST_LENGTH 81
+
+/* Opcodes 82 to 87 */
+#define INST_APPEND_SCALAR1 82
+#define INST_APPEND_SCALAR4 83
+#define INST_APPEND_ARRAY1 84
+#define INST_APPEND_ARRAY4 85
+#define INST_APPEND_ARRAY_STK 86
+#define INST_APPEND_STK 87
+
+/* Opcodes 88 to 93 */
+#define INST_LAPPEND_SCALAR1 88
+#define INST_LAPPEND_SCALAR4 89
+#define INST_LAPPEND_ARRAY1 90
+#define INST_LAPPEND_ARRAY4 91
+#define INST_LAPPEND_ARRAY_STK 92
+#define INST_LAPPEND_STK 93
+
+/* TIP #22 - LINDEX operator with flat arg list */
+
+#define INST_LIST_INDEX_MULTI 94
+
+/*
+ * TIP #33 - 'lset' command. Code gen also required a Forth-like
+ * OVER operation.
+ */
+
+#define INST_OVER 95
+#define INST_LSET_LIST 96
+#define INST_LSET_FLAT 97
+
+/* TIP#90 - 'return' command. */
+
+#define INST_RETURN_IMM 98
+
+/* TIP#123 - exponentiation operator. */
+
+#define INST_EXPON 99
+
+/* TIP #157 - {*}... (word expansion) language syntax support. */
+
+#define INST_EXPAND_START 100
+#define INST_EXPAND_STKTOP 101
+#define INST_INVOKE_EXPANDED 102
+
+/*
+ * TIP #57 - 'lassign' command. Code generation requires immediate
+ * LINDEX and LRANGE operators.
+ */
+
+#define INST_LIST_INDEX_IMM 103
+#define INST_LIST_RANGE_IMM 104
+
+#define INST_START_CMD 105
+
+#define INST_LIST_IN 106
+#define INST_LIST_NOT_IN 107
+
+#define INST_PUSH_RETURN_OPTIONS 108
+#define INST_RETURN_STK 109
+
+/*
+ * Dictionary (TIP#111) related commands.
+ */
+
+#define INST_DICT_GET 110
+#define INST_DICT_SET 111
+#define INST_DICT_UNSET 112
+#define INST_DICT_INCR_IMM 113
+#define INST_DICT_APPEND 114
+#define INST_DICT_LAPPEND 115
+#define INST_DICT_FIRST 116
+#define INST_DICT_NEXT 117
+#define INST_DICT_DONE 118
+#define INST_DICT_UPDATE_START 119
+#define INST_DICT_UPDATE_END 120
+
+/*
+ * Instruction to support jumps defined by tables (instead of the classic
+ * [switch] technique of chained comparisons).
+ */
+
+#define INST_JUMP_TABLE 121
+
+/*
+ * Instructions to support compilation of global, variable, upvar and
+ * [namespace upvar].
+ */
+
+#define INST_UPVAR 122
+#define INST_NSUPVAR 123
+#define INST_VARIABLE 124
+
+/* Instruction to support compiling syntax error to bytecode */
+
+#define INST_SYNTAX 125
+
+/* Instruction to reverse N items on top of stack */
+
+#define INST_REVERSE 126
+
+/* regexp instruction */
+
+#define INST_REGEXP 127
+
+/* For [info exists] compilation */
+#define INST_EXIST_SCALAR 128
+#define INST_EXIST_ARRAY 129
+#define INST_EXIST_ARRAY_STK 130
+#define INST_EXIST_STK 131
+
+/* For [subst] compilation */
+#define INST_NOP 132
+#define INST_RETURN_CODE_BRANCH 133
+
+/* For [unset] compilation */
+#define INST_UNSET_SCALAR 134
+#define INST_UNSET_ARRAY 135
+#define INST_UNSET_ARRAY_STK 136
+#define INST_UNSET_STK 137
+
+/* For [dict with], [dict exists], [dict create] and [dict merge] */
+#define INST_DICT_EXPAND 138
+#define INST_DICT_RECOMBINE_STK 139
+#define INST_DICT_RECOMBINE_IMM 140
+#define INST_DICT_EXISTS 141
+#define INST_DICT_VERIFY 142
+
+/* For [string map] and [regsub] compilation */
+#define INST_STR_MAP 143
+#define INST_STR_FIND 144
+#define INST_STR_FIND_LAST 145
+#define INST_STR_RANGE_IMM 146
+#define INST_STR_RANGE 147
+
+/* For operations to do with coroutines and other NRE-manipulators */
+#define INST_YIELD 148
+#define INST_COROUTINE_NAME 149
+#define INST_TAILCALL 150
+
+/* For compilation of basic information operations */
+#define INST_NS_CURRENT 151
+#define INST_INFO_LEVEL_NUM 152
+#define INST_INFO_LEVEL_ARGS 153
+#define INST_RESOLVE_COMMAND 154
+
+/* For compilation relating to TclOO */
+#define INST_TCLOO_SELF 155
+#define INST_TCLOO_CLASS 156
+#define INST_TCLOO_NS 157
+#define INST_TCLOO_IS_OBJECT 158
+
+/* For compilation of [array] subcommands */
+#define INST_ARRAY_EXISTS_STK 159
+#define INST_ARRAY_EXISTS_IMM 160
+#define INST_ARRAY_MAKE_STK 161
+#define INST_ARRAY_MAKE_IMM 162
+
+#define INST_INVOKE_REPLACE 163
+
+#define INST_LIST_CONCAT 164
+
+#define INST_EXPAND_DROP 165
+
+/* New foreach implementation */
+#define INST_FOREACH_START 166
+#define INST_FOREACH_STEP 167
+#define INST_FOREACH_END 168
+#define INST_LMAP_COLLECT 169
+
+/* For compilation of [string trim] and related */
+#define INST_STR_TRIM 170
+#define INST_STR_TRIM_LEFT 171
+#define INST_STR_TRIM_RIGHT 172
+
+#define INST_CONCAT_STK 173
+
+#define INST_STR_UPPER 174
+#define INST_STR_LOWER 175
+#define INST_STR_TITLE 176
+#define INST_STR_REPLACE 177
+
+#define INST_ORIGIN_COMMAND 178
+
+#define INST_TCLOO_NEXT 179
+#define INST_TCLOO_NEXT_CLASS 180
+
+#define INST_YIELD_TO_INVOKE 181
+
+#define INST_NUM_TYPE 182
+#define INST_TRY_CVT_TO_BOOLEAN 183
+#define INST_STR_CLASS 184
+
+#define INST_LAPPEND_LIST 185
+#define INST_LAPPEND_LIST_ARRAY 186
+#define INST_LAPPEND_LIST_ARRAY_STK 187
+#define INST_LAPPEND_LIST_STK 188
+
+/* The last opcode */
+#define LAST_INST_OPCODE 188
+
+/*
+ * Table describing the Tcl bytecode instructions: their name (for displaying
+ * code), total number of code bytes required (including operand bytes), and a
+ * description of the type of each operand. These operand types include signed
+ * and unsigned integers of length one and four bytes. The unsigned integers
+ * are used for indexes or for, e.g., the count of objects to push in a "push"
+ * instruction.
+ */
+
+#define MAX_INSTRUCTION_OPERANDS 2
+
+typedef enum InstOperandType {
+ OPERAND_NONE,
+ OPERAND_INT1, /* One byte signed integer. */
+ OPERAND_INT4, /* Four byte signed integer. */
+ OPERAND_UINT1, /* One byte unsigned integer. */
+ OPERAND_UINT4, /* Four byte unsigned integer. */
+ OPERAND_IDX4, /* Four byte signed index (actually an
+ * integer, but displayed differently.) */
+ OPERAND_LVT1, /* One byte unsigned index into the local
+ * variable table. */
+ OPERAND_LVT4, /* Four byte unsigned index into the local
+ * variable table. */
+ OPERAND_AUX4, /* Four byte unsigned index into the aux data
+ * table. */
+ OPERAND_OFFSET1, /* One byte signed jump offset. */
+ OPERAND_OFFSET4, /* Four byte signed jump offset. */
+ OPERAND_LIT1, /* One byte unsigned index into table of
+ * literals. */
+ OPERAND_LIT4, /* Four byte unsigned index into table of
+ * literals. */
+ OPERAND_SCLS1 /* Index into tclStringClassTable. */
+} InstOperandType;
+
+typedef struct InstructionDesc {
+ const char *name; /* Name of instruction. */
+ int numBytes; /* Total number of bytes for instruction. */
+ int stackEffect; /* The worst-case balance stack effect of the
+ * instruction, used for stack requirements
+ * computations. The value INT_MIN signals
+ * that the instruction's worst case effect is
+ * (1-opnd1). */
+ int numOperands; /* Number of operands. */
+ InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
+ /* The type of each operand. */
+} InstructionDesc;
+
+MODULE_SCOPE InstructionDesc const tclInstructionTable[];
+
+/*
+ * Constants used by INST_STRING_CLASS to indicate character classes. These
+ * correspond closely by name with what [string is] can support, but there is
+ * no requirement to keep the values the same.
+ */
+
+typedef enum InstStringClassType {
+ STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
+ STR_CLASS_ALPHA, /* Unicode alphabet characters. */
+ STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
+ STR_CLASS_CONTROL, /* Unicode control characters. */
+ STR_CLASS_DIGIT, /* Unicode digit characters. */
+ STR_CLASS_GRAPH, /* Unicode printing characters, excluding
+ * space. */
+ STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
+ STR_CLASS_PRINT, /* Unicode printing characters, including
+ * spaces. */
+ STR_CLASS_PUNCT, /* Unicode punctuation characters. */
+ STR_CLASS_SPACE, /* Unicode space characters. */
+ STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
+ STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
+ * punctuation) characters. */
+ STR_CLASS_XDIGIT /* Characters that can be used as digits in
+ * hexadecimal numbers ([0-9A-Fa-f]). */
+} InstStringClassType;
+
+typedef struct StringClassDesc {
+ const char *name; /* Name of the class. */
+ int (*comparator)(int); /* Function to test if a single unicode
+ * character is a member of the class. */
+} StringClassDesc;
+
+MODULE_SCOPE StringClassDesc const tclStringClassTable[];
+
+/*
+ * Compilation of some Tcl constructs such as if commands and the logical or
+ * (||) and logical and (&&) operators in expressions requires the generation
+ * of forward jumps. Since the PC target of these jumps isn't known when the
+ * jumps are emitted, we record the offset of each jump in an array of
+ * JumpFixup structures. There is one array for each sequence of jumps to one
+ * target PC. When we learn the target PC, we update the jumps with the
+ * correct distance. Also, if the distance is too great (> 127 bytes), we
+ * replace the single-byte jump with a four byte jump instruction, move the
+ * instructions after the jump down, and update the code offsets for any
+ * commands between the jump and the target.
+ */
+
+typedef enum {
+ TCL_UNCONDITIONAL_JUMP,
+ TCL_TRUE_JUMP,
+ TCL_FALSE_JUMP
+} TclJumpType;
+
+typedef struct JumpFixup {
+ TclJumpType jumpType; /* Indicates the kind of jump. */
+ unsigned int codeOffset; /* Offset of the first byte of the one-byte
+ * forward jump's code. */
+ int cmdIndex; /* Index of the first command after the one
+ * for which the jump was emitted. Used to
+ * update the code offsets for subsequent
+ * commands if the two-byte jump at jumpPc
+ * must be replaced with a five-byte one. */
+ int exceptIndex; /* Index of the first range entry in the
+ * ExceptionRange array after the current one.
+ * This field is used to adjust the code
+ * offsets in subsequent ExceptionRange
+ * records when a jump is grown from 2 bytes
+ * to 5 bytes. */
+} JumpFixup;
+
+#define JUMPFIXUP_INIT_ENTRIES 10
+
+typedef struct JumpFixupArray {
+ JumpFixup *fixup; /* Points to start of jump fixup array. */
+ int next; /* Index of next free array entry. */
+ int end; /* Index of last usable entry in array. */
+ int mallocedArray; /* 1 if array was expanded and fixups points
+ * into the heap, else 0. */
+ JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
+ /* Initial storage for jump fixup array. */
+} JumpFixupArray;
+
+/*
+ * The structure describing one variable list of a foreach command. Note that
+ * only foreach commands inside procedure bodies are compiled inline so a
+ * ForeachVarList structure always describes local variables. Furthermore,
+ * only scalar variables are supported for inline-compiled foreach loops.
+ */
+
+typedef struct ForeachVarList {
+ int numVars; /* The number of variables in the list. */
+ int varIndexes[1]; /* An array of the indexes ("slot numbers")
+ * for each variable in the procedure's array
+ * of local variables. Only scalar variables
+ * are supported. The actual size of this
+ * field will be large enough to numVars
+ * indexes. THIS MUST BE THE LAST FIELD IN THE
+ * STRUCTURE! */
+} ForeachVarList;
+
+/*
+ * Structure used to hold information about a foreach command that is needed
+ * during program execution. These structures are stored in CompileEnv and
+ * ByteCode structures as auxiliary data.
+ */
+
+typedef struct ForeachInfo {
+ int numLists; /* The number of both the variable and value
+ * lists of the foreach command. */
+ int firstValueTemp; /* Index of the first temp var in a proc frame
+ * used to point to a value list. */
+ int loopCtTemp; /* Index of temp var in a proc frame holding
+ * the loop's iteration count. Used to
+ * determine next value list element to assign
+ * each loop var. */
+ ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
+ * structures describing each var list. The
+ * actual size of this field will be large
+ * enough to numVars indexes. THIS MUST BE THE
+ * LAST FIELD IN THE STRUCTURE! */
+} ForeachInfo;
+
+/*
+ * Structure used to hold information about a switch command that is needed
+ * during program execution. These structures are stored in CompileEnv and
+ * ByteCode structures as auxiliary data.
+ */
+
+typedef struct JumptableInfo {
+ Tcl_HashTable hashTable; /* Hash that maps strings to signed ints (PC
+ * offsets). */
+} JumptableInfo;
+
+MODULE_SCOPE const AuxDataType tclJumptableInfoType;
+
+#define JUMPTABLEINFO(envPtr, index) \
+ ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
+
+/*
+ * Structure used to hold information about a [dict update] command that is
+ * needed during program execution. These structures are stored in CompileEnv
+ * and ByteCode structures as auxiliary data.
+ */
+
+typedef struct {
+ int length; /* Size of array */
+ int varIndices[1]; /* Array of variable indices to manage when
+ * processing the start and end of a [dict
+ * update]. There is really more than one
+ * entry, and the structure is allocated to
+ * take account of this. MUST BE LAST FIELD IN
+ * STRUCTURE. */
+} DictUpdateInfo;
+
+/*
+ * ClientData type used by the math operator commands.
+ */
+
+typedef struct {
+ const char *op; /* Do not call it 'operator': C++ reserved */
+ const char *expected;
+ union {
+ int numArgs;
+ int identity;
+ } i;
+} TclOpCmdClientData;
+
+/*
+ *----------------------------------------------------------------
+ * Procedures exported by tclBasic.c to be used within the engine.
+ *----------------------------------------------------------------
+ */
+
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
+
+/*
+ *----------------------------------------------------------------
+ * Procedures exported by the engine to be used by tclBasic.c
+ *----------------------------------------------------------------
+ */
+
+MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ const CmdFrame *invoker, int word);
+
+/*
+ *----------------------------------------------------------------
+ * Procedures shared among Tcl bytecode compilation and execution modules but
+ * not used outside:
+ *----------------------------------------------------------------
+ */
+
+MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
+MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int count,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script,
+ int numBytes, CompileEnv *envPtr, int optimize);
+MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int numWords,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp,
+ const char *script, int numBytes,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int count,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, CompileEnv *envPtr);
+MODULE_SCOPE int TclCreateAuxData(ClientData clientData,
+ const AuxDataType *typePtr, CompileEnv *envPtr);
+MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type,
+ CompileEnv *envPtr);
+MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size);
+MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes,
+ int length, unsigned int hash, int *newPtr,
+ Namespace *nsPtr, int flags,
+ LiteralEntry **globalPtrPtr);
+MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr);
+MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp,
+ LiteralTable *tablePtr);
+MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
+ TclJumpType jumpType, JumpFixup *jumpFixupPtr);
+MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
+MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
+ int catchOnly, ByteCode *codePtr);
+MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
+ ByteCode *codePtr);
+MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
+MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
+ int create, CompileEnv *envPtr);
+MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
+ JumpFixup *jumpFixupPtr, int jumpDist,
+ int distThreshold);
+MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
+MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
+ CompileEnv *envPtr, const char *string,
+ int numBytes, const CmdFrame *invoker, int word);
+MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
+MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
+MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
+ int returnCode, ExceptionAux **auxPtrPtr);
+MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr,
+ ExceptionAux *auxPtr);
+MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
+ int range);
+#ifdef TCL_COMPILE_STATS
+MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
+MODULE_SCOPE int TclLog2(int value);
+#endif
+MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes,
+ CompileEnv *envPtr);
+MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
+ CompileEnv *envPtr);
+MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
+#ifdef TCL_COMPILE_DEBUG
+MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+#endif
+MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr,
+ const unsigned char *pc);
+MODULE_SCOPE void TclPrintObject(FILE *outFile,
+ Tcl_Obj *objPtr, int maxChars);
+MODULE_SCOPE void TclPrintSource(FILE *outFile,
+ const char *string, int maxChars);
+MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
+ Tcl_Token *varTokenPtr, CompileEnv *envPtr,
+ int flags, int *localIndexPtr,
+ int *isScalarPtr);
+MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
+MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
+ const char *name, Namespace *nsPtr);
+MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclSortingOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+#ifdef TCL_COMPILE_DEBUG
+MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr);
+MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
+#endif
+MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
+ Tcl_Obj *valuePtr);
+MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
+ const char *script, const char *command,
+ int length, const unsigned char *pc,
+ Tcl_Obj **tosPtr);
+MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
+ const unsigned char *pc, Tcl_Obj **tosPtr);
+MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
+MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
+ register Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int isLambda);
+
+
+/*
+ *----------------------------------------------------------------
+ * Macros and flag values used by Tcl bytecode compilation and execution
+ * modules inside the Tcl core but not used outside.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * Simplified form to access AuxData.
+ *
+ * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
+ */
+
+#define TclFetchAuxData(envPtr, index) \
+ (envPtr)->auxDataArrayPtr[(index)].clientData
+
+#define LITERAL_ON_HEAP 0x01
+#define LITERAL_CMD_NAME 0x02
+
+/*
+ * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
+ * cast away constness, and it is cleanest to do that here, all in one place.
+ *
+ * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
+ * int length);
+ */
+
+#define TclRegisterNewLiteral(envPtr, bytes, length) \
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
+
+/*
+ * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
+ * is safe to cast away constness, and it is cleanest to do that here, all in
+ * one place.
+ *
+ * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
+ * int length);
+ */
+
+#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
+
+/*
+ * Macro used to manually adjust the stack requirements; used in cases where
+ * the stack effect cannot be computed from the opcode and its operands, but
+ * is still known at compile time.
+ *
+ * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
+ */
+
+#define TclAdjustStackDepth(delta, envPtr) \
+ do { \
+ if ((delta) < 0) { \
+ if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \
+ (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \
+ } \
+ } \
+ (envPtr)->currStackDepth += (delta); \
+ } while (0)
+
+#define TclGetStackDepth(envPtr) \
+ ((envPtr)->currStackDepth)
+
+#define TclSetStackDepth(depth, envPtr) \
+ (envPtr)->currStackDepth = (depth)
+
+#define TclCheckStackDepth(depth, envPtr) \
+ do { \
+ int dd = (depth); \
+ if (dd != (envPtr)->currStackDepth) { \
+ Tcl_Panic("bad stack depth computations: is %i, should be %i", \
+ (envPtr)->currStackDepth, dd); \
+ } \
+ } while (0)
+
+/*
+ * Macro used to update the stack requirements. It is called by the macros
+ * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
+ * Remark that the very last instruction of a bytecode always reduces the
+ * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
+ * updated.
+ *
+ * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);
+ */
+
+#define TclUpdateStackReqs(op, i, envPtr) \
+ do { \
+ int delta = tclInstructionTable[(op)].stackEffect; \
+ if (delta) { \
+ if (delta == INT_MIN) { \
+ delta = 1 - (i); \
+ } \
+ TclAdjustStackDepth(delta, envPtr); \
+ } \
+ } while (0)
+
+/*
+ * Macros used to update the flag that indicates if we are at the start of a
+ * command, based on whether the opcode is INST_START_COMMAND.
+ *
+ * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
+ */
+
+#define TclUpdateAtCmdStart(op, envPtr) \
+ if ((envPtr)->atCmdStart < 2) { \
+ (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \
+ }
+
+/*
+ * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
+ */
+
+#define TclEmitOpcode(op, envPtr) \
+ do { \
+ if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) (op); \
+ TclUpdateAtCmdStart(op, envPtr); \
+ TclUpdateStackReqs(op, 0, envPtr); \
+ } while (0)
+
+/*
+ * Macros to emit an integer operand. The ANSI C "prototype" for these macros
+ * are:
+ *
+ * void TclEmitInt1(int i, CompileEnv *envPtr);
+ * void TclEmitInt4(int i, CompileEnv *envPtr);
+ */
+
+#define TclEmitInt1(i, envPtr) \
+ do { \
+ if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
+ } while (0)
+
+#define TclEmitInt4(i, envPtr) \
+ do { \
+ if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 24); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 16); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 8); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) ); \
+ } while (0)
+
+/*
+ * Macros to emit an instruction with signed or unsigned integer operands.
+ * Four byte integers are stored in "big-endian" order with the high order
+ * byte stored at the lowest address. The ANSI C "prototypes" for these macros
+ * are:
+ *
+ * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
+ * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
+ */
+
+#define TclEmitInstInt1(op, i, envPtr) \
+ do { \
+ if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) (op); \
+ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
+ TclUpdateAtCmdStart(op, envPtr); \
+ TclUpdateStackReqs(op, i, envPtr); \
+ } while (0)
+
+#define TclEmitInstInt4(op, i, envPtr) \
+ do { \
+ if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
+ *(envPtr)->codeNext++ = (unsigned char) (op); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 24); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 16); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) >> 8); \
+ *(envPtr)->codeNext++ = \
+ (unsigned char) ((unsigned int) (i) ); \
+ TclUpdateAtCmdStart(op, envPtr); \
+ TclUpdateStackReqs(op, i, envPtr); \
+ } while (0)
+
+/*
+ * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
+ * object's one or four byte array index into the CompileEnv's code array.
+ * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a
+ * CompileEnv. The ANSI C "prototype" for this macro is:
+ *
+ * void TclEmitPush(int objIndex, CompileEnv *envPtr);
+ */
+
+#define TclEmitPush(objIndex, envPtr) \
+ do { \
+ register int objIndexCopy = (objIndex); \
+ if (objIndexCopy <= 255) { \
+ TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
+ } else { \
+ TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
+ } \
+ } while (0)
+
+/*
+ * Macros to update a (signed or unsigned) integer starting at a pointer. The
+ * two variants depend on the number of bytes. The ANSI C "prototypes" for
+ * these macros are:
+ *
+ * void TclStoreInt1AtPtr(int i, unsigned char *p);
+ * void TclStoreInt4AtPtr(int i, unsigned char *p);
+ */
+
+#define TclStoreInt1AtPtr(i, p) \
+ *(p) = (unsigned char) ((unsigned int) (i))
+
+#define TclStoreInt4AtPtr(i, p) \
+ do { \
+ *(p) = (unsigned char) ((unsigned int) (i) >> 24); \
+ *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
+ *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \
+ *(p+3) = (unsigned char) ((unsigned int) (i) ); \
+ } while (0)
+
+/*
+ * Macros to update instructions at a particular pc with a new op code and a
+ * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros
+ * are:
+ *
+ * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
+ * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
+ */
+
+#define TclUpdateInstInt1AtPc(op, i, pc) \
+ do { \
+ *(pc) = (unsigned char) (op); \
+ TclStoreInt1AtPtr((i), ((pc)+1)); \
+ } while (0)
+
+#define TclUpdateInstInt4AtPc(op, i, pc) \
+ do { \
+ *(pc) = (unsigned char) (op); \
+ TclStoreInt4AtPtr((i), ((pc)+1)); \
+ } while (0)
+
+/*
+ * Macro to fix up a forward jump to point to the current code-generation
+ * position in the bytecode being created (the most common case). The ANSI C
+ * "prototypes" for this macro is:
+ *
+ * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr,
+ * int threshold);
+ */
+
+#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
+ TclFixupForwardJump((envPtr), (fixupPtr), \
+ (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
+ (threshold))
+
+/*
+ * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
+ * (GET_UINT{1,2}) from a pointer. There are two variants for each return type
+ * that depend on the number of bytes fetched. The ANSI C "prototypes" for
+ * these macros are:
+ *
+ * int TclGetInt1AtPtr(unsigned char *p);
+ * int TclGetInt4AtPtr(unsigned char *p);
+ * unsigned int TclGetUInt1AtPtr(unsigned char *p);
+ * unsigned int TclGetUInt4AtPtr(unsigned char *p);
+ */
+
+/*
+ * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on
+ * the 1-byte value. Unfortunately the "char" type isn't signed on all
+ * platforms so sign-extension doesn't always happen automatically. Sometimes
+ * we can explicitly declare the pointer to be signed, but other times we have
+ * to explicitly sign-extend the value in software.
+ */
+
+#ifndef __CHAR_UNSIGNED__
+# define TclGetInt1AtPtr(p) ((int) *((char *) p))
+#elif defined(HAVE_SIGNED_CHAR)
+# define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
+#else
+# define TclGetInt1AtPtr(p) \
+ (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
+#endif
+
+#define TclGetInt4AtPtr(p) \
+ (((int) TclGetInt1AtPtr(p) << 24) | \
+ (*((p)+1) << 16) | \
+ (*((p)+2) << 8) | \
+ (*((p)+3)))
+
+#define TclGetUInt1AtPtr(p) \
+ ((unsigned int) *(p))
+#define TclGetUInt4AtPtr(p) \
+ ((unsigned int) (*(p) << 24) | \
+ (*((p)+1) << 16) | \
+ (*((p)+2) << 8) | \
+ (*((p)+3)))
+
+/*
+ * Macros used to compute the minimum and maximum of two integers. The ANSI C
+ * "prototypes" for these macros are:
+ *
+ * int TclMin(int i, int j);
+ * int TclMax(int i, int j);
+ */
+
+#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
+#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
+
+/*
+ * Convenience macros for use when compiling bodies of commands. The ANSI C
+ * "prototype" for these macros are:
+ *
+ * static void BODY(Tcl_Token *tokenPtr, int word);
+ */
+
+#define BODY(tokenPtr, word) \
+ SetLineInformation((word)); \
+ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \
+ envPtr)
+
+/*
+ * Convenience macro for use when compiling tokens to be pushed. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * static void CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
+ * Tcl_Interp *interp);
+ */
+
+#define CompileTokens(envPtr, tokenPtr, interp) \
+ TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
+ (envPtr));
+/*
+ * Convenience macros for use when pushing literals. The ANSI C "prototype" for
+ * these macros are:
+ *
+ * static void PushLiteral(CompileEnv *envPtr,
+ * const char *string, int length);
+ * static void PushStringLiteral(CompileEnv *envPtr,
+ * const char *string);
+ */
+
+#define PushLiteral(envPtr, string, length) \
+ TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
+#define PushStringLiteral(envPtr, string) \
+ PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
+
+/*
+ * Macro to advance to the next token; it is more mnemonic than the address
+ * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
+ *
+ * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr);
+ */
+
+#define TokenAfter(tokenPtr) \
+ ((tokenPtr) + ((tokenPtr)->numComponents + 1))
+
+/*
+ * Macro to get the offset to the next instruction to be issued. The ANSI C
+ * "prototype" for this macro is:
+ *
+ * static int CurrentOffset(CompileEnv *envPtr);
+ */
+
+#define CurrentOffset(envPtr) \
+ ((envPtr)->codeNext - (envPtr)->codeStart)
+
+/*
+ * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
+ * maximal depth of nested CATCH ranges in order to alloc runtime
+ * memory. These macros should compute precisely that? OTOH, the nesting depth
+ * of LOOP ranges is an interesting datum for debugging purposes, and that is
+ * what we compute now.
+ *
+ * static int ExceptionRangeStarts(CompileEnv *envPtr, int index);
+ * static void ExceptionRangeEnds(CompileEnv *envPtr, int index);
+ * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
+ */
+
+#define ExceptionRangeStarts(envPtr, index) \
+ (((envPtr)->exceptDepth++), \
+ ((envPtr)->maxExceptDepth = \
+ TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
+ ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
+#define ExceptionRangeEnds(envPtr, index) \
+ (((envPtr)->exceptDepth--), \
+ ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
+ CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
+#define ExceptionRangeTarget(envPtr, index, targetType) \
+ ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
+
+/*
+ * Check if there is an LVT for compiled locals
+ */
+
+#define EnvHasLVT(envPtr) \
+ (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)
+
+/*
+ * Macros for making it easier to deal with tokens and DStrings.
+ */
+
+#define TclDStringAppendToken(dsPtr, tokenPtr) \
+ Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
+#define TclRegisterDStringLiteral(envPtr, dsPtr) \
+ TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
+ Tcl_DStringLength(dsPtr), /*flags*/ 0)
+
+/*
+ * Macro that encapsulates an efficiency trick that avoids a function call for
+ * the simplest of compiles. The ANSI C "prototype" for this macro is:
+ *
+ * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
+ * Tcl_Interp *interp, int word);
+ */
+
+#define CompileWord(envPtr, tokenPtr, interp, word) \
+ if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
+ PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \
+ } else { \
+ SetLineInformation((word)); \
+ CompileTokens((envPtr), (tokenPtr), (interp)); \
+ }
+
+/*
+ * TIP #280: Remember the per-word line information of the current command. An
+ * index is used instead of a pointer as recursive compilation may reallocate,
+ * i.e. move, the array. This is also the reason to save the nuloc now, it may
+ * change during the course of the function.
+ *
+ * Macro to encapsulate the variable definition and setup.
+ */
+
+#define DefineLineInformation \
+ ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
+ int eclIndex = mapPtr->nuloc - 1
+
+#define SetLineInformation(word) \
+ envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \
+ envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
+
+#define PushVarNameWord(i,v,e,f,l,sc,word) \
+ SetLineInformation(word); \
+ TclPushVarName(i,v,e,f,l,sc)
+
+/*
+ * Often want to issue one of two versions of an instruction based on whether
+ * the argument will fit in a single byte or not. This makes it much clearer.
+ */
+
+#define Emit14Inst(nm,idx,envPtr) \
+ if (idx <= 255) { \
+ TclEmitInstInt1(nm##1,idx,envPtr); \
+ } else { \
+ TclEmitInstInt4(nm##4,idx,envPtr); \
+ }
+
+/*
+ * How to get an anonymous local variable (used for holding temporary values
+ * off the stack) or a local simple scalar.
+ */
+
+#define AnonymousLocal(envPtr) \
+ (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
+#define LocalScalar(chars,len,envPtr) \
+ TclLocalScalar(chars, len, envPtr)
+#define LocalScalarFromToken(tokenPtr,envPtr) \
+ TclLocalScalarFromToken(tokenPtr, envPtr)
+
+/*
+ * Flags bits used by TclPushVarName.
+ */
+
+#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
+#define TCL_NO_ELEMENT 2 /* Do not push the array element. */
+
+/*
+ * DTrace probe macros (NOPs if DTrace support is not enabled).
+ */
+
+/*
+ * Define the following macros to enable debug logging of the DTrace proc,
+ * cmd, and inst probes. Note that this does _not_ require a platform with
+ * DTrace, it simply logs all probe output to /tmp/tclDTraceDebug-[pid].log.
+ *
+ * If the second macro is defined, logging to file starts immediately,
+ * otherwise only after the first call to [tcl::dtrace]. Note that the debug
+ * probe data is always computed, even when it is not logged to file.
+ *
+ * Defining the third macro enables debug logging of inst probes (disabled
+ * by default due to the significant performance impact).
+ */
+
+/*
+#define TCL_DTRACE_DEBUG 1
+#define TCL_DTRACE_DEBUG_LOG_ENABLED 1
+#define TCL_DTRACE_DEBUG_INST_PROBES 1
+*/
+
+#if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__))
+
+#ifdef USE_DTRACE
+
+#if defined(__GNUC__) && __GNUC__ > 2
+/*
+ * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks.
+ */
+#define unlikely(x) (__builtin_expect((x), 0))
+#else
+#define unlikely(x) (x)
+#endif
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() unlikely(TCL_PROC_ENTRY_ENABLED())
+#define TCL_DTRACE_PROC_RETURN_ENABLED() unlikely(TCL_PROC_RETURN_ENABLED())
+#define TCL_DTRACE_PROC_RESULT_ENABLED() unlikely(TCL_PROC_RESULT_ENABLED())
+#define TCL_DTRACE_PROC_ARGS_ENABLED() unlikely(TCL_PROC_ARGS_ENABLED())
+#define TCL_DTRACE_PROC_INFO_ENABLED() unlikely(TCL_PROC_INFO_ENABLED())
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) TCL_PROC_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_PROC_RETURN(a0, a1) TCL_PROC_RETURN(a0, a1)
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED())
+#define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED())
+#define TCL_DTRACE_CMD_RESULT_ENABLED() unlikely(TCL_CMD_RESULT_ENABLED())
+#define TCL_DTRACE_CMD_ARGS_ENABLED() unlikely(TCL_CMD_ARGS_ENABLED())
+#define TCL_DTRACE_CMD_INFO_ENABLED() unlikely(TCL_CMD_INFO_ENABLED())
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) TCL_CMD_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_CMD_RETURN(a0, a1) TCL_CMD_RETURN(a0, a1)
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED())
+#define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED())
+#define TCL_DTRACE_INST_START(a0, a1, a2) TCL_INST_START(a0, a1, a2)
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) TCL_INST_DONE(a0, a1, a2)
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() unlikely(TCL_TCL_PROBE_ENABLED())
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+
+#define TCL_DTRACE_DEBUG_LOG()
+
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args,
+ int *argsi);
+
+#else /* USE_DTRACE */
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() 0
+#define TCL_DTRACE_PROC_RETURN_ENABLED() 0
+#define TCL_DTRACE_PROC_RESULT_ENABLED() 0
+#define TCL_DTRACE_PROC_ARGS_ENABLED() 0
+#define TCL_DTRACE_PROC_INFO_ENABLED() 0
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {if (a0) {}}
+#define TCL_DTRACE_PROC_RETURN(a0, a1) {if (a0) {}}
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}}
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() 0
+#define TCL_DTRACE_CMD_RETURN_ENABLED() 0
+#define TCL_DTRACE_CMD_RESULT_ENABLED() 0
+#define TCL_DTRACE_CMD_ARGS_ENABLED() 0
+#define TCL_DTRACE_CMD_INFO_ENABLED() 0
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) {}
+#define TCL_DTRACE_CMD_RETURN(a0, a1) {}
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
+
+#define TCL_DTRACE_INST_START_ENABLED() 0
+#define TCL_DTRACE_INST_DONE_ENABLED() 0
+#define TCL_DTRACE_INST_START(a0, a1, a2) {}
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) {}
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() 0
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+
+#define TclDTraceInfo(info, args, argsi) {*args = ""; *argsi = 0;}
+
+#endif /* USE_DTRACE */
+
+#else /* TCL_DTRACE_DEBUG */
+
+#define USE_DTRACE 1
+
+#if !defined(TCL_DTRACE_DEBUG_LOG_ENABLED) || !(TCL_DTRACE_DEBUG_LOG_ENABLED)
+#undef TCL_DTRACE_DEBUG_LOG_ENABLED
+#define TCL_DTRACE_DEBUG_LOG_ENABLED 0
+#endif
+
+#if !defined(TCL_DTRACE_DEBUG_INST_PROBES) || !(TCL_DTRACE_DEBUG_INST_PROBES)
+#undef TCL_DTRACE_DEBUG_INST_PROBES
+#define TCL_DTRACE_DEBUG_INST_PROBES 0
+#endif
+
+MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
+MODULE_SCOPE FILE *tclDTraceDebugLog;
+MODULE_SCOPE void TclDTraceOpenDebugLog(void);
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi);
+
+#define TCL_DTRACE_DEBUG_LOG() \
+ int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \
+ int tclDTraceDebugIndent = 0; \
+ FILE *tclDTraceDebugLog = NULL; \
+ void TclDTraceOpenDebugLog(void) { \
+ char n[35]; \
+ sprintf(n, "/tmp/tclDTraceDebug-%lu.log", \
+ (unsigned long) getpid()); \
+ tclDTraceDebugLog = fopen(n, "a"); \
+ }
+
+#define TclDTraceDbgMsg(p, m, ...) \
+ do { \
+ if (tclDTraceDebugEnabled) { \
+ int _l, _t = 0; \
+ if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \
+ fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", \
+ strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \
+ fprintf(tclDTraceDebugLog, " %.*s():%n", \
+ (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \
+ fprintf(tclDTraceDebugLog, "%*s" p "%n", \
+ (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \
+ "", &_l); _t += _l; \
+ fprintf(tclDTraceDebugLog, "%*s" m "\n", \
+ (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__); \
+ fflush(tclDTraceDebugLog); \
+ } \
+ } while (0)
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() 1
+#define TCL_DTRACE_PROC_RETURN_ENABLED() 1
+#define TCL_DTRACE_PROC_RESULT_ENABLED() 1
+#define TCL_DTRACE_PROC_ARGS_ENABLED() 1
+#define TCL_DTRACE_PROC_INFO_ENABLED() 1
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
+ tclDTraceDebugIndent++; \
+ TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2)
+#define TCL_DTRACE_PROC_RETURN(a0, a1) \
+ TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \
+ tclDTraceDebugIndent--
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \
+ TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3)
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
+ a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \
+ a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() 1
+#define TCL_DTRACE_CMD_RETURN_ENABLED() 1
+#define TCL_DTRACE_CMD_RESULT_ENABLED() 1
+#define TCL_DTRACE_CMD_ARGS_ENABLED() 1
+#define TCL_DTRACE_CMD_INFO_ENABLED() 1
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \
+ tclDTraceDebugIndent++; \
+ TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2)
+#define TCL_DTRACE_CMD_RETURN(a0, a1) \
+ TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \
+ tclDTraceDebugIndent--
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \
+ TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3)
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
+ a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
+ TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \
+ a2, a3, a4, a5, a6, a7)
+
+#define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
+#define TCL_DTRACE_INST_DONE_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
+#define TCL_DTRACE_INST_START(a0, a1, a2) \
+ TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2)
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) \
+ TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2)
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() 1
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ do { \
+ tclDTraceDebugEnabled = 1; \
+ TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \
+ a1, a2, a3, a4, a5, a6, a7, a8, a9); \
+ } while (0)
+
+#endif /* TCL_DTRACE_DEBUG */
+
+#endif /* _TCLCOMPILATION */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */