/*
* 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_ARITH_SERIES,
/* 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_LREPLACE4_* 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.
*----------------------------------------------------------------
*/
/*
* 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 int 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 int
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 (int) 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)
/*
* 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_LREPLACE4_END_IS_LAST = 1, /* "end" refers to last element */
TCL_LREPLACE4_SINGLE_INDEX = 2 /* Second index absent (pure insert) */
};
/*
* 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)
// 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:
*/