path: root/generic/tclCompile.h

/*
 * 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>
 * Copyright (c) 2025 Donal K. Fellows <dkf@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;

enum TclTraceBytecodeCompileLevels {
    TCL_TRACE_BYTECODE_COMPILE_NONE = 0,
    TCL_TRACE_BYTECODE_COMPILE_SUMMARY = 1,
    TCL_TRACE_BYTECODE_COMPILE_DETAIL = 2
};

/*
 * 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;

enum TclTraceBytecodeExecLevels {
    TCL_TRACE_BYTECODE_EXEC_NONE = 0,
    TCL_TRACE_BYTECODE_EXEC_PROCS = 1,
    TCL_TRACE_BYTECODE_EXEC_COMMANDS = 2,
    TCL_TRACE_BYTECODE_EXEC_INSTRUCTIONS = 3
};
#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 type of indices into the local variable table.
 */
typedef Tcl_Size Tcl_LVTIndex;

/*
 * The type of handles made by TclCreateAuxData()
 */
typedef Tcl_Size Tcl_AuxDataRef;

/*
 * The type of "catch ranges" returned from TclCreateExceptRange(), etc.
 */
typedef Tcl_Size Tcl_ExceptionRange;

/*
 * 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. */
    Tcl_Size nestingLevel;	/* Static depth of the exception range. Used
				 * to find the most deeply-nested range
				 * surrounding a PC at runtime. */
    Tcl_Size codeOffset;	/* Offset of the first instruction byte of the
				 * code range. */
    Tcl_Size numCodeBytes;	/* Number of bytes in the code range. */
    Tcl_Size breakOffset;	/* If LOOP_EXCEPTION_RANGE, the target PC
				 * offset for a break command in the range. */
    Tcl_Size continueOffset;	/* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE,
				 * the target PC offset for a continue command
				 * in the code range. Otherwise, ignore this
				 * range when processing a continue
				 * command. */
    Tcl_Size 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. */
    Tcl_Size 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. */
    Tcl_Size 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. */
    Tcl_Size 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. */
    Tcl_Size numBreakTargets;	/* The number of [break]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    size_t *breakTargets;	/* The offsets of the INST_JUMP 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. */
    Tcl_Size allocBreakTargets;	/* The size of the breakTargets array. */
    Tcl_Size numContinueTargets;/* The number of [continue]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    size_t *continueTargets;	/* The offsets of the INST_JUMP 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. */
    Tcl_Size 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 {
    Tcl_Size codeOffset;	/* Offset of first byte of command code. */
    Tcl_Size numCodeBytes;	/* Number of bytes for command's code. */
    Tcl_Size srcOffset;		/* Offset of first char of the command. */
    Tcl_Size 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 {
    Tcl_Size srcOffset;		/* Command location to find the entry. */
    Tcl_Size nline;		/* Number of words in the command */
    int *line;			/* Line information for all words in the
				 * command. */
    Tcl_Size **next;		/* Transient information used by the compiler
				 * for tracking of hidden continuation
				 * lines. */
} ECL;

typedef struct ExtCmdLoc {
    int type;			/* Context type. */
    Tcl_Size 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). */
    Tcl_Size nloc;		/* Number of allocated entries in 'loc'. */
    Tcl_Size 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 void *	(AuxDataDupProc) (void *clientData);
typedef void	(AuxDataFreeProc) (void *clientData);
typedef void	(AuxDataPrintProc) (void *clientData,
	Tcl_Obj *appendObj, struct ByteCode *codePtr,
	size_t 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. */
    void *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. */
    Tcl_Size 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. */
    Tcl_Size numCommands;	/* Number of commands compiled. */
    Tcl_Size exceptDepth;	/* Current exception range nesting level;
				 * TCL_INDEX_NONE if not in any range
				 * currently. */
    Tcl_Size maxExceptDepth;	/* Max nesting level of exception ranges;
				 * TCL_INDEX_NONE if no ranges have been
				 * compiled. */
    Tcl_Size maxStackDepth;	/* Maximum number of stack elements needed to
				 * execute the code. Set by compilation
				 * procedures before returning. */
    Tcl_Size 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.*/
    int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
				 * exceptArrayPtr points in heap, else 0. */
    LiteralEntry *literalArrayPtr;
				/* Points to start of LiteralEntry array. */
    Tcl_Size literalArrayNext;	/* Index of next free object array entry. */
    Tcl_Size 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. */
    Tcl_Size 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. */
    Tcl_Size exceptArrayEnd;	/* Index after the last ExceptionRange array
				 * entry. */
    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. */
    Tcl_Size cmdMapEnd;		/* Index after last CmdLocation entry. */
    int mallocedCmdMap;		/* 1 if command map array was expanded and
				 * cmdMapPtr points in the heap, else 0. */
    int mallocedAuxDataArray;	/* 1 if aux data array was expanded and
				 * auxDataArrayPtr points in heap else 0. */
    AuxData *auxDataArrayPtr;	/* Points to auxiliary data array start. */
    Tcl_Size 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. */
    Tcl_Size auxDataArrayEnd;	/* Index after last aux data array entry. */
    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). */
    Tcl_Size expandCount;	/* Number of INST_EXPAND_START instructions
				 * encountered that have not yet been paired
				 * with a corresponding
				 * INST_INVOKE_EXPANDED. */
    Tcl_Size *clNext;		/* If not NULL, it refers to the next slot in
				 * clLoc to check for an invisible
				 * continuation line. */
} CompileEnv;

/*
 * Function to get the offset to the next instruction to be issued.
 * More mnemonic than just putting the calculation in directly.
 */
static inline Tcl_Size
CurrentOffset(
    CompileEnv *envPtr)
{
    return envPtr->codeNext - envPtr->codeStart;
}

/*
 * Information about what the current source line is.
 */
typedef struct LineInformation {
    ExtCmdLoc *mapPtr;		/* Extended command location information for
				 * 'info frame'. */
    Tcl_Size eclIndex;		/* Current index into mapPtr->loc. */
} LineInformation;

/*
 * 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.
 */

enum ByteCodeFlags {
    /*
     * A PRECOMPILED bytecode struct is one that was generated from a compiled
     * image rather than implicitly compiled from source
     */
    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.
     */
    TCL_BYTECODE_RESOLVE_VARS = 0x0002,

    /*
     * Used to note that a recompilation of the bytecode is believed necessary.
     * The recompilation may generate the same bytecode sequence, but we can't
     * prove that without doing it.
     */
    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. */
    Tcl_Size 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. */
    Tcl_Size nsEpoch;		/* Value of nsPtr->resolverEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when new namespace resolution rules
				 * are put into effect. */
    Tcl_Size 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 OR'ed 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. */
    Tcl_Size numCommands;	/* Number of commands compiled. */
    Tcl_Size numSrcBytes;	/* Number of source bytes compiled. */
    Tcl_Size numCodeBytes;	/* Number of code bytes. */
    Tcl_Size numLitObjects;	/* Number of objects in literal array. */
    Tcl_Size numExceptRanges;	/* Number of ExceptionRange array elems. */
    Tcl_Size numAuxDataItems;	/* Number of AuxData items. */
    Tcl_Size numCmdLocBytes;	/* Number of bytes needed for encoded command
				 * location information. */
    Tcl_Size maxExceptDepth;	/* Maximum nesting level of ExceptionRanges;
				 * TCL_INDEX_NONE if no ranges were compiled. */
    Tcl_Size 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;

#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (codePtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), (typePtr), &ir);			\
    } while (0)

#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \
    do {								\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), (typePtr));		\
	(codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL;	\
    } while (0)

/*
 * A special macro to allow an opcode in the TclInstruction enum to be marked
 * as deprecated. The tricky bit is that we do *not* want the opcodes to be
 * deprecated in the bytecode execution engine, disassembler or (for now)
 * optimizer; if ALLOW_DEPRECATED_OPCODES is defined prior to including this
 * file, DEPRECATED_OPCODE doesn't apply the deprecation marker.
 *
 * If REMOVE_DEPRECATED_OPCODES is defined, the opcodes are removed entirely
 * and will be wholly unusable, even by precompiled bytecode.
 */

#ifdef REMOVE_DEPRECATED_OPCODES
#define DEPRECATED_OPCODE(name) JOIN(INST_DEPRECATED_, __LINE__)
#elif defined(ALLOW_DEPRECATED_OPCODES)
#define DEPRECATED_OPCODE(name) \
    name
#elif defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202311L
#define DEPRECATED_OPCODE(name) \
    name [[deprecated("use 4-byte operand version instead")]]
#elif defined(__GNUC__) || defined(__clang__)
/* Technically missing guards for some very old gcc/clang versions. */
#define DEPRECATED_OPCODE(name) \
    name __attribute__((deprecated ("use 4-byte operand version instead")))
#else
#define DEPRECATED_OPCODE(name) \
    name
#endif

/*
 * 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_BITOR) must match the entries in the array operatorStrings in
 * tclExecute.c.
 */

enum TclInstruction {
    /* Opcodes 0 to 9 */
    INST_DONE = 0,
    DEPRECATED_OPCODE(INST_PUSH1),
    INST_PUSH = 2,
    INST_POP,
    INST_DUP,
    INST_STR_CONCAT1,
    DEPRECATED_OPCODE(INST_INVOKE_STK1),
    INST_INVOKE_STK = 7,
    INST_EVAL_STK,
    INST_EXPR_STK,

    /* Opcodes 10 to 23 */
    DEPRECATED_OPCODE(INST_LOAD_SCALAR1),
    INST_LOAD_SCALAR = 11,
    DEPRECATED_OPCODE(INST_LOAD_SCALAR_STK), // Not used
    DEPRECATED_OPCODE(INST_LOAD_ARRAY1),
    INST_LOAD_ARRAY = 14,
    INST_LOAD_ARRAY_STK,
    INST_LOAD_STK,
    DEPRECATED_OPCODE(INST_STORE_SCALAR1),
    INST_STORE_SCALAR = 18,
    DEPRECATED_OPCODE(INST_STORE_SCALAR_STK), // Not used
    DEPRECATED_OPCODE(INST_STORE_ARRAY1),
    INST_STORE_ARRAY = 21,
    INST_STORE_ARRAY_STK,
    INST_STORE_STK,

    /* Opcodes 24 to 33 */
    DEPRECATED_OPCODE(INST_INCR_SCALAR1),
    INST_INCR_SCALAR_STK = 25,
    DEPRECATED_OPCODE(INST_INCR_ARRAY1),
    INST_INCR_ARRAY_STK = 27,
    INST_INCR_STK,
    DEPRECATED_OPCODE(INST_INCR_SCALAR1_IMM),
    INST_INCR_SCALAR_STK_IMM = 30,
    DEPRECATED_OPCODE(INST_INCR_ARRAY1_IMM),
    INST_INCR_ARRAY_STK_IMM = 32,
    INST_INCR_STK_IMM,

    /* Opcodes 34 to 39 */
    DEPRECATED_OPCODE(INST_JUMP1),
    INST_JUMP = 35,
    DEPRECATED_OPCODE(INST_JUMP_TRUE1),
    INST_JUMP_TRUE = 37,
    DEPRECATED_OPCODE(INST_JUMP_FALSE1),
    INST_JUMP_FALSE = 39,

    /* Opcodes 42 to 60 */
    INST_BITOR,
    INST_BITXOR,
    INST_BITAND,
    INST_EQ,
    INST_NEQ,
    INST_LT,
    INST_GT,
    INST_LE,
    INST_GE,
    INST_LSHIFT,
    INST_RSHIFT,
    INST_ADD,
    INST_SUB,
    INST_MULT,
    INST_DIV,
    INST_MOD,
    INST_UPLUS,
    INST_UMINUS,
    INST_BITNOT,
    INST_LNOT,
    INST_TRY_CVT_TO_NUMERIC,

    /* Opcodes 61 to 62 */
    INST_BREAK,
    INST_CONTINUE,

    /* Opcodes 63 to 66 */
    INST_BEGIN_CATCH,
    INST_END_CATCH,
    INST_PUSH_RESULT,
    INST_PUSH_RETURN_CODE,

    /* Opcodes 67 to 72 */
    INST_STR_EQ,
    INST_STR_NEQ,
    INST_STR_CMP,
    INST_STR_LEN,
    INST_STR_INDEX,
    INST_STR_MATCH,

    /* Opcodes 73 to 75 */
    INST_LIST,
    INST_LIST_INDEX,
    INST_LIST_LENGTH,

    /* Opcodes 76 to 81 */
    DEPRECATED_OPCODE(INST_APPEND_SCALAR1),
    INST_APPEND_SCALAR = 77,
    DEPRECATED_OPCODE(INST_APPEND_ARRAY1),
    INST_APPEND_ARRAY = 79,
    INST_APPEND_ARRAY_STK,
    INST_APPEND_STK,

    /* Opcodes 82 to 87 */
    DEPRECATED_OPCODE(INST_LAPPEND_SCALAR1),
    INST_LAPPEND_SCALAR = 83,
    DEPRECATED_OPCODE(INST_LAPPEND_ARRAY1),
    INST_LAPPEND_ARRAY = 85,
    INST_LAPPEND_ARRAY_STK,
    INST_LAPPEND_STK,

    /* TIP #22 - LINDEX operator with flat arg list */
    INST_LIST_INDEX_MULTI,

    /*
     * TIP #33 - 'lset' command. Code gen also required a Forth-like
     *	     OVER operation.
     */
    INST_OVER,
    INST_LSET_LIST,
    INST_LSET_FLAT,

    /* TIP#90 - 'return' command. */
    INST_RETURN_IMM,

    /* TIP#123 - exponentiation operator. */
    INST_EXPON,

    /* TIP #157 - {*}... (word expansion) language syntax support. */
    INST_EXPAND_START,
    INST_EXPAND_STKTOP,
    INST_INVOKE_EXPANDED,

    /*
     * TIP #57 - 'lassign' command. Code generation requires immediate
     *	     LINDEX and LRANGE operators.
     */
    INST_LIST_INDEX_IMM,
    INST_LIST_RANGE_IMM,
    INST_START_CMD,
    INST_LIST_IN,
    INST_LIST_NOT_IN,
    INST_PUSH_RETURN_OPTIONS,
    INST_RETURN_STK,

    /*
     * Dictionary (TIP#111) related commands.
     */
    INST_DICT_GET,
    INST_DICT_SET,
    INST_DICT_UNSET,
    INST_DICT_INCR_IMM,
    INST_DICT_APPEND,
    INST_DICT_LAPPEND,
    INST_DICT_FIRST,
    INST_DICT_NEXT,
    INST_DICT_UPDATE_START,
    INST_DICT_UPDATE_END,

    /*
     * Instruction to support jumps defined by tables (instead of the classic
     * [switch] technique of chained comparisons).
     */
    INST_JUMP_TABLE,

    /*
     * Instructions to support compilation of global, variable, upvar and
     * [namespace upvar].
     */
    INST_UPVAR,
    INST_NSUPVAR,
    INST_VARIABLE,

    /* Instruction to support compiling syntax error to bytecode */
    INST_SYNTAX,

    /* Instruction to reverse N items on top of stack */
    INST_REVERSE,

    /* regexp instruction */
    INST_REGEXP,

    /* For [info exists] compilation */
    INST_EXIST_SCALAR,
    INST_EXIST_ARRAY,
    INST_EXIST_ARRAY_STK,
    INST_EXIST_STK,

    /* For [subst] compilation */
    INST_NOP,
    DEPRECATED_OPCODE(INST_RETURN_CODE_BRANCH),

    /* For [unset] compilation */
    INST_UNSET_SCALAR = 127,
    INST_UNSET_ARRAY,
    INST_UNSET_ARRAY_STK,
    INST_UNSET_STK,

    /* For [dict with], [dict exists], [dict create] and [dict merge] */
    INST_DICT_EXPAND,
    INST_DICT_RECOMBINE_STK,
    INST_DICT_RECOMBINE_IMM,
    INST_DICT_EXISTS,
    INST_DICT_VERIFY,

    /* For [string map] and [regsub] compilation */
    INST_STR_MAP,
    INST_STR_FIND,
    INST_STR_FIND_LAST,
    INST_STR_RANGE_IMM,
    INST_STR_RANGE,

    /* For operations to do with coroutines and other NRE-manipulators */
    INST_YIELD,
    INST_COROUTINE_NAME,
    DEPRECATED_OPCODE(INST_TAILCALL1),

    /* For compilation of basic information operations */
    INST_NS_CURRENT = 144,
    INST_INFO_LEVEL_NUM,
    INST_INFO_LEVEL_ARGS,
    INST_RESOLVE_COMMAND,

    /* For compilation relating to TclOO */
    INST_TCLOO_SELF,
    INST_TCLOO_CLASS,
    INST_TCLOO_NS,
    INST_TCLOO_IS_OBJECT,

    /* For compilation of [array] subcommands */
    INST_ARRAY_EXISTS_STK,
    INST_ARRAY_EXISTS_IMM,
    INST_ARRAY_MAKE_STK,
    INST_ARRAY_MAKE_IMM,

    INST_INVOKE_REPLACE,

    INST_LIST_CONCAT,

    INST_EXPAND_DROP,

    /* New foreach implementation */
    INST_FOREACH_START,
    INST_FOREACH_STEP,
    INST_FOREACH_END,
    INST_LMAP_COLLECT,

    /* For compilation of [string trim] and related */
    INST_STR_TRIM,
    INST_STR_TRIM_LEFT,
    INST_STR_TRIM_RIGHT,

    INST_CONCAT_STK,

    INST_STR_UPPER,
    INST_STR_LOWER,
    INST_STR_TITLE,
    INST_STR_REPLACE,

    INST_ORIGIN_COMMAND,

    DEPRECATED_OPCODE(INST_TCLOO_NEXT1),
    DEPRECATED_OPCODE(INST_TCLOO_NEXT_CLASS1),

    INST_YIELD_TO_INVOKE = 174,

    INST_NUM_TYPE,
    INST_TRY_CVT_TO_BOOLEAN,
    INST_STR_CLASS,

    INST_LAPPEND_LIST,
    INST_LAPPEND_LIST_ARRAY,
    INST_LAPPEND_LIST_ARRAY_STK,
    INST_LAPPEND_LIST_STK,

    INST_CLOCK_READ,

    INST_DICT_GET_DEF,

    /* TIP 461 */
    INST_STR_LT,
    INST_STR_GT,
    INST_STR_LE,
    INST_STR_GE,

    INST_LREPLACE,

    /* TIP 667: const */
    INST_CONST_IMM,
    INST_CONST_STK,

    /* Updated compilations with fewer arg size constraints for 9.1 */
    INST_INCR_SCALAR,
    INST_INCR_ARRAY,
    INST_INCR_SCALAR_IMM,
    INST_INCR_ARRAY_IMM,
    INST_TAILCALL,
    INST_TCLOO_NEXT,
    INST_TCLOO_NEXT_CLASS,

    /* Really new opcodes for 9.1 */
    INST_SWAP,
    INST_ERROR_PREFIX_EQ,
    INST_TCLOO_ID,
    INST_DICT_PUT,
    INST_DICT_REMOVE,
    INST_IS_EMPTY,
    INST_JUMP_TABLE_NUM,
    INST_TAILCALL_LIST,
    INST_TCLOO_NEXT_LIST,
    INST_TCLOO_NEXT_CLASS_LIST,
    INST_ARITH_SERIES,
    INST_UPLEVEL,

    /* The last opcode */
    LAST_INST_OPCODE
};

/*
 * 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. */
    OPERAND_UNSF1,		/* Flags for [unset] */
    OPERAND_CLK1,		/* Index into [clock] types. */
    OPERAND_LRPL1		/* Combination of TCL_LREPLACE_* flags. */
} 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 {
    char name[8];		/* 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. */
    Tcl_Size next;		/* Index of next free array entry. */
    Tcl_Size 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 {
    Tcl_Size numVars;		/* The number of variables in the list. */
    Tcl_LVTIndex varIndexes[TCLFLEXARRAY];
				/* 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 {
    Tcl_Size numLists;		/* The number of both the variable and value
				 * lists of the foreach command. */
    Tcl_LVTIndex firstValueTemp;/* Index of the first temp var in a proc frame
				 * used to point to a value list. */
    Tcl_LVTIndex 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[TCLFLEXARRAY];
				/* 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;

/*
 * Structures 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 *) TclFetchAuxData((envPtr), TclGetUInt4AtPtr(index)))

static inline JumptableInfo *
AllocJumptable(void)
{
    JumptableInfo *jtPtr = (JumptableInfo *) Tcl_Alloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
    return jtPtr;
}

static inline int
CreateJumptableEntry(
    JumptableInfo *jtPtr,
    const char *keyPtr,
    Tcl_Size offset)
{
    int isNew;
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable, keyPtr,
	    &isNew);
    if (isNew) {
	Tcl_SetHashValue(hPtr, INT2PTR(offset));
    }
    return isNew;
}

#define CreateJumptableEntryToHere(jtPtr, key, baseOffset) \
    CreateJumptableEntry((jtPtr), (key), CurrentOffset(envPtr) - (baseOffset))

typedef struct JumptableNumInfo {
    Tcl_HashTable hashTable;	/* Hash that maps Tcl_WideInt to signed ints
				 * (PC offsets). */
} JumptableNumInfo;

MODULE_SCOPE const AuxDataType tclJumptableNumericInfoType;

#define JUMPTABLENUMINFO(envPtr, index) \
    ((JumptableNumInfo *) TclFetchAuxData((envPtr), TclGetUInt4AtPtr(index)))

static inline JumptableNumInfo *
AllocJumptableNum(void)
{
    JumptableNumInfo *jtnPtr = (JumptableNumInfo *)
	    Tcl_Alloc(sizeof(JumptableNumInfo));
    Tcl_InitHashTable(&jtnPtr->hashTable, TCL_ONE_WORD_KEYS);
    return jtnPtr;
}

static inline int
CreateJumptableNumEntry(
    JumptableNumInfo *jtnPtr,
    Tcl_Size key,
    Tcl_Size offset)
{
    int isNew;
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&jtnPtr->hashTable, INT2PTR(key),
	    &isNew);
    if (isNew) {
	Tcl_SetHashValue(hPtr, INT2PTR(offset));
    }
    return isNew;
}

#define CreateJumptableNumEntryToHere(jtnPtr, key, baseOffset) \
    CreateJumptableNumEntry((jtnPtr), (key),				\
	    CurrentOffset(envPtr) - (baseOffset))

/*
 * 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 DictUpdateInfo {
    Tcl_Size length;		/* Size of array */
    Tcl_Size varIndices[TCLFLEXARRAY];
				/* 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 TclOpCmdClientData {
    const char *op;		/* Do not call it 'operator': C++ reserved */
    const char *expected;
    union OperatorParameter {
	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, Tcl_Size word);

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl bytecode compilation and execution modules but
 * not used outside:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Tcl_Size depth, Command *cmdPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclClearFailedCompile(CompileEnv *envPtr,
			    LineInformation *lineInfoPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Size count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    Tcl_Size numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, size_t numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    const char *script, Tcl_Size numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Size count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE Tcl_AuxDataRef TclCreateAuxData(void *clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE Tcl_ExceptionRange TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, size_t size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    Tcl_Size length, size_t 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, Tcl_Size index);
MODULE_SCOPE Tcl_LVTIndex TclFindCompiledLocal(const char *name, Tcl_Size nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE void	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, Tcl_Size jumpDist);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t numBytes, const CmdFrame *invoker, Tcl_Size 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 int	TclIsEmptyToken(const Tcl_Token *tokenPtr);
MODULE_SCOPE void	TclAddLoopBreakFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclAddLoopContinueFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
			    Tcl_Size range);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int	TclLog2(long long value);
#endif
MODULE_SCOPE Tcl_LVTIndex TclLocalScalar(const char *bytes, size_t numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE Tcl_LVTIndex TclLocalScalarFromToken(Tcl_Token *tokenPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclDebugPrintByteCodeObj(Tcl_Obj *objPtr);
#else
#define TclDebugPrintByteCodeObj(objPtr) (void)(objPtr)
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, Tcl_Size maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, Tcl_Size maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, Tcl_LVTIndex *localIndexPtr,
			    int *isScalarPtr);
MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE int	TclRegisterLiteralObj(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int flags);
MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE Tcl_ObjCmdProc	TclSingleOpCmd;
MODULE_SCOPE Tcl_ObjCmdProc	TclSortingOpCmd;
MODULE_SCOPE Tcl_ObjCmdProc	TclVariadicOpCmd;
MODULE_SCOPE Tcl_ObjCmdProc	TclNoIdentOpCmd;
#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,
			    Tcl_Size 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(void *clientData,
			    Tcl_Interp *interp, Tcl_Size 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.
 *----------------------------------------------------------------
 */

// Point at which we issue a LIST_CONCAT anyway when doing an expansion sequence
#define LIST_CONCAT_THRESHOLD	(1 << 15)

/*
 * Simplified form to access AuxData.
 *
 * void *TclFetchAuxData(CompileEng *envPtr, Tcl_AuxDataRef index);
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

// Flags for TclRegisterLiteral()
enum LiteralFlags {
    LITERAL_ON_HEAP = 0x01,	/* The caller of TclRegisterLiteral already
				 * malloc'd bytes and ownership is passed to
				 * the literal store. */
    LITERAL_CMD_NAME = 0x02,	/* The literal should not be shared across
				 * namespaces. */
    LITERAL_UNSHARED = 0x04	/* The literal should not be shared with any
				 * other usage, even if they're the same string
				 * in the same stack frame. */
};

/*
 * Adjust the stack requirements. Manually used in cases where the stack
 * effect cannot be computed from the opcode and its operands, but is still
 * known at compile time.
 */
static inline void
TclAdjustStackDepth(
    Tcl_Size delta,
    CompileEnv *envPtr)
{
    if (delta < 0) {
	if (envPtr->maxStackDepth < envPtr->currStackDepth) {
	    envPtr->maxStackDepth = envPtr->currStackDepth;
	}
    }
    envPtr->currStackDepth += delta;
}

#define TclGetStackDepth(envPtr) \
    ((envPtr)->currStackDepth)

#define TclSetStackDepth(depth, envPtr) \
    (envPtr)->currStackDepth = (depth)

/*
 * Verify that the current stack depth is what we think it should be. When
 * this is wrong, code generation is broken!
 */
static inline void
TclCheckStackDepth(
    size_t depth,
    CompileEnv *envPtr)
{
    if (depth != (size_t) envPtr->currStackDepth) {
	Tcl_Panic("bad stack depth computations: "
		"is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u",
		(size_t) envPtr->currStackDepth, depth);
    }
}

/*
 * Update the stack requirements based on the instruction definition. It is
 * called by the functions TclEmitOpCode, TclEmitInst1, TclEmitInst4, et al.
 * 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.
 */
static inline void
TclUpdateStackReqs(
    unsigned char op,
    Tcl_Size i,
    CompileEnv *envPtr)
{
    Tcl_Size delta = tclInstructionTable[op].stackEffect;
    if (delta) {
	if (delta == INT_MIN) {
	    if (i > INT_MAX || i < INT_MIN+2) {
		Tcl_Panic("%s: stack effect too big", "TclUpdateStackReqs");
	    }
	    delta = 1 - i;
	}
	TclAdjustStackDepth(delta, envPtr);
    }

    /*
     * Apply stack depth corrections.
     * These instructions are encoded wrongly because they're cases the
     * original instruction table design wasn't designed to handle.
     */
    switch (op) {
    case INST_DICT_GET:
    case INST_DICT_SET:
    case INST_DICT_EXISTS:
    case INST_INVOKE_REPLACE:
	TclAdjustStackDepth(-1, envPtr);
	break;
    case INST_DICT_GET_DEF:
	TclAdjustStackDepth(-2, envPtr);
	break;
    default:
	/* Do nothing special */
	break;
    }
}

/*
 * Function 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.
 */

static inline void
TclUpdateAtCmdStart(
    unsigned char op,
    CompileEnv *envPtr)
{
    if (envPtr->atCmdStart < 2) {
	envPtr->atCmdStart = (op == INST_START_CMD ? 1 : 0);
    }
}

/*
 * Function to emit an opcode byte into a CompileEnv's code array.
 */

static inline void
TclEmitOpcode(
    unsigned char op,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext == envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(op);

    TclUpdateAtCmdStart(op, envPtr);
    TclUpdateStackReqs(op, 0, envPtr);
}

/*
 * Functions to emit an integer operand. The macro wrappers allow any C
 * integral type to be passed.
 */

static inline void
TclEmitInt1Impl(
    unsigned i,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext == envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(i);
}
#define TclEmitInt1(i, envPtr) \
    TclEmitInt1Impl((unsigned)(i), (envPtr))

static inline void
TclEmitInt4Impl(
    unsigned i,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext + 4 > envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(i >> 24);
    *envPtr->codeNext++ = UCHAR(i >> 16);
    *envPtr->codeNext++ = UCHAR(i >>  8);
    *envPtr->codeNext++ = UCHAR(i      );
}
#define TclEmitInt4(i, envPtr) \
    TclEmitInt4Impl((unsigned)(i), (envPtr))

/*
 * Functions 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 macro wrappers allow any C
 * integral type to be passed.
 */

static inline void
TclEmitInstInt1Impl(
    unsigned char op,
    unsigned i,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext + 2 > envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(op);
    *envPtr->codeNext++ = UCHAR(i);

    TclUpdateAtCmdStart(op, envPtr);
    // Emit 1-byte argument
    TclUpdateStackReqs(op, i, envPtr);
}
#define TclEmitInstInt1(op, i, envPtr) \
    TclEmitInstInt1Impl((op), (unsigned)(i), (envPtr))

static inline void
TclEmitInstInt4Impl(
    unsigned char op,
    unsigned i,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext + 5 > envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(op);
    // Emit 4-byte argument
    *envPtr->codeNext++ = UCHAR(i >> 24);
    *envPtr->codeNext++ = UCHAR(i >> 16);
    *envPtr->codeNext++ = UCHAR(i >>  8);
    *envPtr->codeNext++ = UCHAR(i      );

    TclUpdateAtCmdStart(op, envPtr);
    TclUpdateStackReqs(op, i, envPtr);
}
#define TclEmitInstInt4(op, i, envPtr) \
    TclEmitInstInt4Impl((op), (unsigned)(i), (envPtr))

static inline void
TclEmitInstInt14(
    unsigned char op,
    unsigned i,
    unsigned j,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext + 6 > envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(op);
    // Emit 1-byte argument
    *envPtr->codeNext++ = UCHAR(i      );
    // Emit 4-byte argument
    *envPtr->codeNext++ = UCHAR(j >> 24);
    *envPtr->codeNext++ = UCHAR(j >> 16);
    *envPtr->codeNext++ = UCHAR(j >>  8);
    *envPtr->codeNext++ = UCHAR(j      );

    TclUpdateAtCmdStart(op, envPtr);
    TclUpdateStackReqs(op, i, envPtr);
}

static inline void
TclEmitInstInt41(
    unsigned char op,
    unsigned i,
    unsigned j,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext + 6 > envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(op);
    // Emit 4-byte argument
    *envPtr->codeNext++ = UCHAR(i >> 24);
    *envPtr->codeNext++ = UCHAR(i >> 16);
    *envPtr->codeNext++ = UCHAR(i >>  8);
    *envPtr->codeNext++ = UCHAR(i      );
    // Emit 1-byte argument
    *envPtr->codeNext++ = UCHAR(j      );

    TclUpdateAtCmdStart(op, envPtr);
    TclUpdateStackReqs(op, i, envPtr);
}

static inline void
TclEmitInstInt44(
    unsigned char op,
    unsigned i,
    unsigned j,
    CompileEnv *envPtr)
{
    if (envPtr->codeNext + 9 > envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }

    *envPtr->codeNext++ = UCHAR(op);
    // Emit 4-byte argument
    *envPtr->codeNext++ = UCHAR(i >> 24);
    *envPtr->codeNext++ = UCHAR(i >> 16);
    *envPtr->codeNext++ = UCHAR(i >>  8);
    *envPtr->codeNext++ = UCHAR(i      );
    // Emit 4-byte argument
    *envPtr->codeNext++ = UCHAR(j >> 24);
    *envPtr->codeNext++ = UCHAR(j >> 16);
    *envPtr->codeNext++ = UCHAR(j >>  8);
    *envPtr->codeNext++ = UCHAR(j      );

    TclUpdateAtCmdStart(op, envPtr);
    TclUpdateStackReqs(op, i, envPtr);
}

/*
 * Function to push a Tcl object onto the Tcl evaluation stack. It emits the
 * object's four byte array index into the CompileEnv's code array.
 * This supports a maximum of 2**32 objects in a CompileEnv.
 */

static inline int
TclEmitPush(
    int objIndex,
    CompileEnv *envPtr)
{
    TclEmitInstInt4(INST_PUSH, objIndex, envPtr);
    return objIndex;
}

/*
 * Macros to update a (signed or unsigned) integer starting at a pointer. The
 * two variants depend on the number of bytes.
 */

static inline void
TclStoreInt1AtPtrImpl(
    unsigned i,
    unsigned char *p)
{
    p[0] = UCHAR(i);
}
#define TclStoreInt1AtPtr(i, p) \
    TclStoreInt1AtPtrImpl((unsigned)(i), (p))

static inline void
TclStoreInt4AtPtrImpl(
    unsigned i,
    unsigned char *p)
{
    p[0] = UCHAR(i >> 24);
    p[1] = UCHAR(i >> 16);
    p[2] = UCHAR(i >>  8);
    p[3] = UCHAR(i      );
}
#define TclStoreInt4AtPtr(i, p) \
    TclStoreInt4AtPtrImpl((unsigned)(i), (p))

/*
 * 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) = UCHAR(op);						\
	TclStoreInt1AtPtr((i), ((pc)+1));				\
    } while (0)

#define TclUpdateInstInt4AtPc(op, i, pc) \
    do {								\
	*(pc) = UCHAR(op);						\
	TclStoreInt4AtPtr((i), ((pc)+1));				\
    } while (0)

/*
 * Inline func to fix up a forward jump to point to the current code-generation
 * position in the bytecode being created (the most common case).
 */

static inline void
TclFixupForwardJumpToHere(
    CompileEnv *envPtr,
    JumpFixup *fixupPtr)
{
    TclFixupForwardJump(envPtr, fixupPtr,
	    CurrentOffset(envPtr) - (int) fixupPtr->codeOffset);
}

/*
 * 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 function 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.
 */

static inline int
TclGetInt1AtPtr(
    const unsigned char *p)
{
#ifndef __CHAR_UNSIGNED__
    return (int) *((char *) p);
#elif defined(HAVE_SIGNED_CHAR)
    return (int) *((signed char *) p);
#else
    return (int) ((*((char *) p)) | ((*(p) & 0200) ? (-256) : 0));
#endif
}

static inline unsigned int
TclGetUInt1AtPtr(
    const unsigned char *p)
{
    return (unsigned) *p;
}

static inline int
TclGetInt4AtPtr(
    const unsigned char *p)
{
    return (int) (
	(TclGetUInt1AtPtr(p) << 24) |
	(p[1] << 16) |
	(p[2] <<  8) |
	(p[3]      ));
}

static inline unsigned
TclGetUInt4AtPtr(
    const unsigned char *p)
{
    return (unsigned) (
	(p[0] << 24) |
	(p[1] << 16) |
	(p[2] <<  8) |
	(p[3]      ));
}

/*
 * Macros used to compute the minimum and maximum of two values. The ANSI C
 * "prototypes" for these macros are:
 *
 * size_t TclMin(size_t i, size_t j);
 * size_t TclMax(size_t i, size_t j);
 */

#define TclMin(i, j)	((((size_t) i) + 1 < ((size_t) j) + 1) ? (i) : (j))
#define TclMax(i, j)	((((size_t) i) + 1 > ((size_t) j) + 1) ? (i) : (j))

/*
 * 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 macro for use when pushing literals, returning the ID of the
 * literal. The ANSI C "prototype" for the macro is:
 *
 * static int		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, Tcl_Size length);
 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterLiteral((envPtr), (string), (length), 0), (envPtr))

/*
 * Function to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces.
 */
static inline Tcl_Token *
TokenAfter(
    Tcl_Token *tokenPtr)
{
    return tokenPtr + (tokenPtr->numComponents + 1);
}

/*
 * 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 Tcl_Size	ExceptionRangeStarts(CompileEnv *envPtr, Tcl_Size index);
 * static void	ExceptionRangeEnds(CompileEnv *envPtr, Tcl_Size index);
 * static void	ExceptionRangeTarget(CompileEnv *envPtr, Tcl_Size index, LABEL);
 */

static inline Tcl_Size
ExceptionRangeStarts(
    CompileEnv *envPtr,
    Tcl_ExceptionRange index)
{
    Tcl_Size offset;

    envPtr->exceptDepth++;
    envPtr->maxExceptDepth = TclMax(envPtr->exceptDepth,
	    envPtr->maxExceptDepth);
    offset = CurrentOffset(envPtr);
    envPtr->exceptArrayPtr[index].codeOffset = offset;
    return offset;
}

static inline void
ExceptionRangeEnds(
    CompileEnv *envPtr,
    Tcl_ExceptionRange 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)
// Stricter than EnvHasLVT; guarantees AnonymousLocal won't fail
#define EnvIsProc(envPtr) \
    (envPtr->procPtr != NULL)

/*
 * 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)
#define TclPushDString(envPtr, dsPtr) \
    TclEmitPush(TclRegisterDStringLiteral((envPtr), (dsPtr)), (envPtr))

/*
 * 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, Tcl_Size 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.
 *
 * Macros to encapsulate the variable definition and setup.
 */

#define DefineLineInformation \
    LineInformation lineInfo = {					\
	envPtr->extCmdMapPtr,						\
	envPtr->extCmdMapPtr->nuloc - 1					\
    }

#define ExtCmdLocation \
    lineInfo.mapPtr->loc[lineInfo.eclIndex]

#define SetLineInformation(word) \
    do {								\
	ECL *eclPtr = &ExtCmdLocation;					\
	envPtr->line = eclPtr->line[(word)];				\
	envPtr->clNext = eclPtr->next[(word)];				\
    } while (0)

#define PushVarNameWord(varTokenPtr,flags,localIndexPtr,isScalarPtr,wordIndex) \
    do {								\
	SetLineInformation(wordIndex);					\
	TclPushVarName(interp, varTokenPtr, envPtr, flags,		\
		localIndexPtr, isScalarPtr);				\
    } while (0)

#define ClearFailedCompile(envPtr) \
    TclClearFailedCompile((envPtr), &lineInfo)

/*
 * 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.
 *
 * TCL_NO_LARGE_INDEX is deprecated entirely; variable indices are always large
 * in bytecodes we now issue.
 */
enum PushVarNameFlags {
    // TCL_NO_LARGE_INDEX = 1,	/* Do not return localIndex value > 255 */
    TCL_NO_ELEMENT = 2		/* Do not push the array element. */
};

/*
 * Flags bits used by lreplace4 instruction
 */
enum Lreplace4Flags {
    TCL_LREPLACE_END_IS_LAST = 1,	/* "end" refers to last element */
    TCL_LREPLACE_SINGLE_INDEX = 2,	/* Second index absent (pure insert) */
    TCL_LREPLACE_NEED_IN_RANGE = 4	/* First index must resolve to real list index */
};

/* Flags bits used by arithSeries instruction */
enum ArithSeqriesFlags {
    TCL_ARITHSERIES_FROM = 1 << 0,	// from is defined (conventionally empty otherwise)
    TCL_ARITHSERIES_TO = 1 << 1,	// to is defined (conventionally empty otherwise)
    TCL_ARITHSERIES_STEP = 1 << 2,	// step is defined (conventionally empty otherwise)
    TCL_ARITHSERIES_COUNT = 1 << 3,	// count is defined (conventionally empty otherwise)
};

/*
 * Helper functions for jump tables that call other internal API bits.
 */

static inline Tcl_Size
RegisterJumptable(
    JumptableInfo *jtPtr,
    CompileEnv *envPtr)
{
    return TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
}

static inline Tcl_Size
RegisterJumptableNum(
    JumptableNumInfo *jtPtr,
    CompileEnv *envPtr)
{
    return TclCreateAuxData(jtPtr, &tclJumptableNumericInfoType, envPtr);
}

/*
 * The type of "labels" used in FWDLABEL() and BACKLABEL(). Logically, the
 * result of CurrentOffset(), but specifically not just that.
 */
typedef Tcl_Size Tcl_BytecodeLabel;

/*
 * Used to indicate that no jump is pending resolution.
 */
#define NO_PENDING_JUMP		((Tcl_Size) -1)

/*
 * Shorthand macros for instruction issuing.
 */

// Measure the length of a string literal.
#define LENGTH_OF(str) \
    ((Tcl_Size) sizeof(str "") - 1)

// Issue an instruction without an argument.
#define OP(name)	TclEmitOpcode(INST_##name, envPtr)
// Issue an instruction with a single-byte argument.
#define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
// Issue an instruction with a four-byte argument.
#define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
// Issue an instruction with a single-byte argument and a four-byte argument.
#define OP14(name,val1,val2) \
    TclEmitInstInt14(INST_##name, (unsigned)(val1), (unsigned)(val2), envPtr)
// Issue an instruction with two four-byte arguments.
#define OP44(name,val1,val2) \
    TclEmitInstInt44(INST_##name, (unsigned)(val1), (unsigned)(val2), envPtr)
// Issue an instruction with a foun-byte argument and a single-byte argument.
#define OP41(name,val1,val2) \
    TclEmitInstInt41(INST_##name, (unsigned)(val1), (unsigned)(val2), envPtr)
// Issue a potentially break/continue generating instruction without an argument.
#define INVOKE(name) \
    TclEmitInvoke(envPtr,INST_##name)
// Issue a potentially break/continue generating instruction with a single argument.
#define INVOKE4(name,arg1) \
    TclEmitInvoke(envPtr,INST_##name,(int)(arg1))
// Issue a potentially break/continue generating instruction with two arguments.
#define INVOKE41(name,arg1,arg2) \
    TclEmitInvoke(envPtr,INST_##name,(int)(arg1),(int)(arg2))

// Push a string literal.
#define PUSH(string) \
    PushLiteral((envPtr), (string), LENGTH_OF(string))
// Push a string whose is computed with strlen().
#define PUSH_STRING(strVar) \
    PushLiteral(envPtr, (strVar), TCL_AUTO_LENGTH)
// Push a string from a TCL_TOKEN_SIMPLE_WORD token.
#define PUSH_SIMPLE_TOKEN(tokenPtr) \
    PushLiteral(envPtr, (tokenPtr)[1].start, (tokenPtr)[1].size)
// Push a string from a TCL_TOKEN_SIMPLE_WORD token where that is a command.
#define PUSH_COMMAND_TOKEN(tokenPtr) \
    TclEmitPush(TclRegisterLiteral(envPtr,				\
	    (tokenPtr)[1].start, (tokenPtr)[1].size, LITERAL_CMD_NAME),	\
	    envPtr)
// Take a reference to a Tcl_Obj and arrange for it to be pushed.
#define PUSH_OBJ(objPtr) \
    TclEmitPush(TclAddLiteralObj(envPtr, (objPtr), NULL), envPtr)
// Take a reference to a Tcl_Obj and arrange for it to be pushed.
// Handles extra flags, typically used for command names.
#define PUSH_OBJ_FLAGS(objPtr, flags) \
    TclEmitPush(TclRegisterLiteralObj(envPtr, (objPtr), (flags)), envPtr)
// Push a general token. Needs which index of its command it is.
#define PUSH_TOKEN(tokenPtr, index) \
    CompileWord(envPtr, (tokenPtr), interp, (index))
// Push a token that is an expression.
#define PUSH_EXPR_TOKEN(tokenPtr, index) \
    do {								\
	SetLineInformation(index);					\
	TclCompileExprWords(interp, (tokenPtr), 1, envPtr);		\
    } while (0)
// Compile the body of a command (e.g., [if], [while])
#define BODY(tokenPtr, index) \
    do {								\
	SetLineInformation((index));					\
	TclCompileCmdWord(interp,					\
		(tokenPtr)+1, (tokenPtr)->numComponents,		\
		envPtr);						\
    } while (0)

// Set the label to the current address. Typically paired with BACKJUMP.
#define BACKLABEL(var) \
    (var)=CurrentOffset(envPtr)
// Jump (of given type) backwards to the label defined by BACKLABEL.
#define BACKJUMP(name, var) \
    TclEmitInstInt4(INST_##name,(var)-CurrentOffset(envPtr),envPtr)
// Jump (of given type) forwards to the label defined by FWDLABEL.
#define FWDJUMP(name, var) \
    (var)=CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr)
// Set the label to the current address. MUST be paired with FWDJUMP.
#define FWDLABEL(var) \
    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)

// Create an unplaced CATCH exception range.
#define MAKE_CATCH_RANGE() \
    TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr)
// Create an unplaced LOOP exception range.
#define MAKE_LOOP_RANGE() \
    TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr)
#define CATCH_RANGE_VAR(range,var) \
    for(int var=(ExceptionRangeStarts(envPtr,(range)), 0);		\
	    !var;							\
	    var=(ExceptionRangeEnds(envPtr,(range)), 1))
// Wrap the given range around a body of code, placing its start and end.
#define CATCH_RANGE(range) \
    CATCH_RANGE_VAR((range), JOIN(catchRange_, __LINE__))
// Define where caught exceptions in the CATCH range branch to.
#define CATCH_TARGET(range) \
    ExceptionRangeTarget(envPtr, (range), catchOffset)
// Define where caught BREAKs in the LOOP range branch to.
#define BREAK_TARGET(range) \
    ExceptionRangeTarget(envPtr, (range), breakOffset)
// Define where caught CONTINUEs in the LOOP range branch to.
#define CONTINUE_TARGET(range) \
    ExceptionRangeTarget(envPtr, (range), continueOffset)
// Finalize the LOOP exception range, setting the destinations for jumps.
#define FINALIZE_LOOP(range) \
    TclFinalizeLoopExceptionRange(envPtr, (range))

// Apply a correction to the stack depth.
#define STKDELTA(delta) \
    TclAdjustStackDepth((delta), envPtr)

// Convert a TCL_TOKEN_SIMPLE_WORD token to a Tcl_Obj.
#define TokenToObj(tokenPtr) \
    Tcl_NewStringObj((tokenPtr)[1].start, (tokenPtr)[1].size)
// Test if a token is literally a given string.
#define IS_TOKEN_LITERALLY(tokenPtr, str) \
    (((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD)			\
	    && ((tokenPtr)[1].size == LENGTH_OF(str))			\
	    && strncmp((tokenPtr)[1].start, str, LENGTH_OF(str)) == 0)
// Test if a token is a prefix of a given string.
#define IS_TOKEN_PREFIX(tokenPtr, minLength, str) \
    (((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD)			\
	    && ((tokenPtr)[1].size >= (Tcl_Size)(minLength))		\
	    && ((tokenPtr)[1].size <= LENGTH_OF(str))			\
	    && strncmp((tokenPtr)[1].start, str, (tokenPtr)[1].size) == 0)
// Test if a token has a given string as a prefix.
#define IS_TOKEN_PREFIXED_BY(tokenPtr, str) \
    (((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD)			\
	    && ((tokenPtr)[1].size > LENGTH_OF(str))			\
	    && strncmp((tokenPtr)[1].start, str, LENGTH_OF(str)) == 0)

/*
 * 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,
			    Tcl_Size *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, Tcl_Size *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];							\
	snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \
		(size_t) 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 %" TCL_SIZE_MODIFIER "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 %" TCL_SIZE_MODIFIER "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 %" TCL_SIZE_MODIFIER "d %" TCL_SIZE_MODIFIER "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:
 */