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>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompile.h,v 1.33.2.7 2009/07/14 16:31:49 andreas_kupries Exp $
 */

#ifndef _TCLCOMPILATION
#define _TCLCOMPILATION 1

#ifndef _TCLINT
#include "tclInt.h"
#endif /* _TCLINT */

#ifdef BUILD_tcl
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

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

extern int 		tclTraceCompile;
#endif

#ifdef TCL_COMPILE_DEBUG
/*
 * 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".
 */

extern int 		tclTraceExec;
#endif

/*
 *------------------------------------------------------------------------
 * Data structures related to compilation.
 *------------------------------------------------------------------------
 */

/*
 * The structure used to implement Tcl "exceptions" (exceptional returns):
 * for example, those generated in loops by the break and continue commands,
 * and those generated by scripts and caught by the catch command. This
 * ExceptionRange structure describes a range of code (e.g., a loop body),
 * the kind of exceptions (e.g., a break or continue) that might occur, and
 * the PC offsets to jump to if a matching exception does occur. Exception
 * ranges can nest so this structure includes a nesting level that is used
 * at runtime to find the closest exception range surrounding a PC. For
 * example, when a break command is executed, the ExceptionRange structure
 * for the most deeply nested loop, if any, is found and used. These
 * structures are also generated for the "next" subcommands of for loops
 * since a break there terminates the for command. This means a for command
 * actually generates two LoopInfo structures.
 */

typedef enum {
    LOOP_EXCEPTION_RANGE,	/* Exception's range is part of a loop.
				 * Break and continue "exceptions" cause
				 * jumps to appropriate PC offsets. */
    CATCH_EXCEPTION_RANGE	/* Exception's range is controlled by a
				 * catch command. Errors in the range cause
				 * a jump to a catch PC offset. */
} ExceptionRangeType;

typedef struct ExceptionRange {
    ExceptionRangeType type;	/* The kind of ExceptionRange. */
    int nestingLevel;		/* Static depth of the exception range.
				 * Used to find the most deeply-nested
				 * range surrounding a PC at runtime. */
    int codeOffset;		/* Offset of the first instruction byte of
				 * the code range. */
    int numCodeBytes;		/* Number of bytes in the code range. */
    int breakOffset;		/* If LOOP_EXCEPTION_RANGE, the target PC
				 * offset for a break command in the range. */
    int continueOffset;		/* If LOOP_EXCEPTION_RANGE and not -1, the
				 * target PC offset for a continue command in
				 * the code range. Otherwise, ignore this range
				 * when processing a continue command. */
    int catchOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
				 * offset for any "exception" in range. */
} ExceptionRange;

/*
 * Structure used to map between instruction pc and source locations. It
 * defines for each compiled Tcl command its code's starting offset and 
 * its source's starting offset and length. Note that the code offset
 * increases monotonically: that is, the table is sorted in code offset
 * order. The source offset is not monotonic.
 */

typedef struct CmdLocation {
    int codeOffset;		/* Offset of first byte of command code. */
    int numCodeBytes;		/* Number of bytes for command's code. */
    int srcOffset;		/* Offset of first char of the command. */
    int numSrcBytes;		/* Number of command source chars. */
} CmdLocation;

#ifdef TCL_TIP280
/*
 * TIP #280
 * Structure to record additional location information for byte code.
 * This information is internal and not saved. I.e. tbcload'ed code
 * will not have this information. It records the lines for all words
 * of all commands found in the byte code. The association with a
 * ByteCode structure BC is done through the 'lineBCPtr' HashTable in
 * Interp, keyed by the address of BC. Also recorded is information
 * coming from the context, i.e. type of the frame and associated
 * information, like the path of a sourced file.
 */

typedef struct ECL {
  int  srcOffset; /* cmd location to find the entry */
  int  nline;     /* Number of words in the command */
  int* line;      /* line information for all words in the command */
} ECL;

typedef struct ExtCmdLoc {
  int      type;  /* Context type */
  Tcl_Obj* path;  /* Path of the sourced file the command is in */
  ECL*     loc;   /* Command word locations (lines) */
  int      nloc;  /* Number of allocated entries in 'loc' */
  int      nuloc; /* Number of used entries in 'loc' */
  Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the
			  * information accessible per command and
			  * argument, not per whole bytecode. Value is
			  * index of command in 'loc', giving us the
			  * literals to associate with line
			  * information as command argument, see
			  * TclArgumentBCEnter() */
} ExtCmdLoc;
#endif

/*
 * CompileProcs need the ability to record information during compilation
 * that can be used by bytecode instructions during execution. The AuxData
 * structure provides this "auxiliary data" mechanism. An arbitrary number
 * of these structures can be stored in the ByteCode record (during
 * compilation they are stored in a CompileEnv structure). Each AuxData
 * record holds one word of client-specified data (often a pointer) and is
 * given an index that instructions can later use to look up the structure
 * and its data.
 *
 * The following definitions declare the types of procedures that are called
 * to duplicate or free this auxiliary data when the containing ByteCode
 * objects are duplicated and freed. Pointers to these procedures are kept
 * in the AuxData structure.
 */

typedef ClientData (AuxDataDupProc)  _ANSI_ARGS_((ClientData clientData));
typedef void       (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));

/*
 * 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 {
    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. */
} AuxDataType;

/*
 * The definition of the AuxData structure that holds information created
 * during compilation by CompileProcs and used by instructions during
 * execution.
 */

typedef struct AuxData {
    AuxDataType *type;		/* pointer to the AuxData type associated with
                             * this ClientData. */
    ClientData clientData;	/* The compilation data itself. */
} AuxData;

/*
 * Structure defining the compilation environment. After compilation, fields
 * describing bytecode instructions are copied out into the more compact
 * ByteCode structure defined below.
 */

#define COMPILEENV_INIT_CODE_BYTES    250
#define COMPILEENV_INIT_NUM_OBJECTS    60
#define COMPILEENV_INIT_EXCEPT_RANGES   5
#define COMPILEENV_INIT_CMD_MAP_SIZE   40
#define COMPILEENV_INIT_AUX_DATA_SIZE   5

typedef struct CompileEnv {
    Interp *iPtr;		/* Interpreter containing the code being
				 * compiled. Commands and their compile
				 * procs are specific to an interpreter so
				 * the code emitted will depend on the
				 * interpreter. */
    char *source;		/* The source string being compiled by
				 * SetByteCodeFromAny. This pointer is not
				 * owned by the CompileEnv and must not be
				 * freed or changed by it. */
    int numSrcBytes;		/* Number of bytes in source. */
    Proc *procPtr;		/* If a procedure is being compiled, a
				 * pointer to its Proc structure; otherwise
				 * NULL. Used to compile local variables.
				 * Set from information provided by
				 * ObjInterpProc in tclProc.c. */
    int numCommands;		/* Number of commands compiled. */
    int exceptDepth;		/* Current exception range nesting level;
				 * -1 if not in any range currently. */
    int maxExceptDepth;		/* Max nesting level of exception ranges;
				 * -1 if no ranges have been compiled. */
    int maxStackDepth;		/* Maximum number of stack elements needed
				 * to execute the code. Set by compilation
				 * procedures before returning. */
    int currStackDepth;         /* Current stack depth. */
    LiteralTable localLitTable;	/* Contains LiteralEntry's describing
				 * all Tcl objects referenced by this
				 * compiled code. Indexed by the string
				 * representations of the literals. Used to
				 * avoid creating duplicate objects. */
    unsigned char *codeStart;	/* Points to the first byte of the code. */
    unsigned char *codeNext;	/* Points to next code array byte to use. */
    unsigned char *codeEnd;	/* Points just after the last allocated
				 * code array byte. */
    int mallocedCodeArray;      /* Set 1 if code array was expanded 
				 * and codeStart points into the heap.*/
    LiteralEntry *literalArrayPtr;
    				/* Points to start of LiteralEntry array. */
    int literalArrayNext;	/* Index of next free object array entry. */
    int literalArrayEnd;	/* Index just after last obj array entry. */
    int mallocedLiteralArray;   /* 1 if object array was expanded and
                                 * objArray points into the heap, else 0. */
    ExceptionRange *exceptArrayPtr;
    				/* Points to start of the ExceptionRange
				 * array. */
    int exceptArrayNext;	/* Next free ExceptionRange array index.
				 * exceptArrayNext is the number of ranges
				 * and (exceptArrayNext-1) is the index of
				 * the current range's array entry. */
    int exceptArrayEnd;		/* Index after the last ExceptionRange
				 * array entry. */
    int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded
				 * and exceptArrayPtr points in heap,
				 * else 0. */
    CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
				 * numCommands is the index of the next
				 * entry to use; (numCommands-1) is the
				 * entry index for the last command. */
    int cmdMapEnd;		/* Index after last CmdLocation entry. */
    int mallocedCmdMap;		/* 1 if command map array was expanded and
				 * cmdMapPtr points in the heap, else 0. */
    AuxData *auxDataArrayPtr;   /* Points to auxiliary data array start. */
    int auxDataArrayNext;	/* Next free compile aux data array index.
				 * auxDataArrayNext is the number of aux
				 * data items and (auxDataArrayNext-1) is
				 * index of current aux data array entry. */
    int auxDataArrayEnd;	/* Index after last aux data array entry. */
    int mallocedAuxDataArray;	/* 1 if aux data array was expanded and
				 * auxDataArrayPtr points in heap else 0. */
    unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
                                /* Initial storage for code. */
    LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
                                /* Initial storage of LiteralEntry array. */
    ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
                                /* Initial ExceptionRange array storage. */
    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. */
#ifdef TCL_TIP280
    /* 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. */
#endif
} CompileEnv;

/*
 * The structure defining the bytecode instructions resulting from compiling
 * a Tcl script. Note that this structure is variable length: a single heap
 * object is allocated to hold the ByteCode structure immediately followed
 * by the code bytes, the literal object array, the ExceptionRange array,
 * the CmdLocation map, and the compilation AuxData array.
 */

/*
 * A PRECOMPILED bytecode struct is one that was generated from a compiled
 * image rather than implicitly compiled from source
 */
#define TCL_BYTECODE_PRECOMPILED		0x0001

typedef struct ByteCode {
    TclHandle interpHandle;	/* Handle for interpreter containing the
				 * compiled code.  Commands and their compile
				 * procs are specific to an interpreter so the
				 * code emitted will depend on the
				 * interpreter. */
    int compileEpoch;		/* Value of iPtr->compileEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when, e.g., commands with compile
				 * procs are redefined. */
    Namespace *nsPtr;		/* Namespace context in which this code
				 * was compiled. If the code is executed
				 * if a different namespace, it must be
				 * recompiled. */
    int nsEpoch;		/* Value of nsPtr->resolverEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when new namespace resolution rules
				 * are put into effect. */
    int refCount;		/* Reference count: set 1 when created
				 * plus 1 for each execution of the code
				 * currently active. This structure can be
				 * freed when refCount becomes zero. */
    unsigned int flags;		/* flags describing state for the codebyte.
                                 * this variable holds ORed values from the
                                 * TCL_BYTECODE_ masks defined above */
    char *source;		/* The source string from which this
				 * ByteCode was compiled. Note that this
				 * pointer is not owned by the ByteCode and
				 * must not be freed or modified by it. */
    Proc *procPtr;		/* If the ByteCode was compiled from a
				 * procedure body, this is a pointer to its
				 * Proc structure; otherwise NULL. This
				 * pointer is also not owned by the ByteCode
				 * and must not be freed by it. */
    size_t structureSize;	/* Number of bytes in the ByteCode structure
				 * itself. Does not include heap space for
				 * literal Tcl objects or storage referenced
				 * by AuxData entries. */
    int numCommands;		/* Number of commands compiled. */
    int numSrcBytes;		/* Number of source bytes compiled. */
    int numCodeBytes;		/* Number of code bytes. */
    int numLitObjects;		/* Number of objects in literal array. */
    int numExceptRanges;	/* Number of ExceptionRange array elems. */
    int numAuxDataItems;	/* Number of AuxData items. */
    int numCmdLocBytes;		/* Number of bytes needed for encoded
				 * command location information. */
    int maxExceptDepth;		/* Maximum nesting level of ExceptionRanges;
				 * -1 if no ranges were compiled. */
    int maxStackDepth;		/* Maximum number of stack elements needed
				 * to execute the code. */
    unsigned char *codeStart;	/* Points to the first byte of the code.
				 * This is just after the final ByteCode
				 * member cmdMapPtr. */
    Tcl_Obj **objArrayPtr;	/* Points to the start of the literal
				 * object array. This is just after the
				 * last code byte. */
    ExceptionRange *exceptArrayPtr;
    				/* Points to the start of the ExceptionRange
				 * array. This is just after the last
				 * object in the object array. */
    AuxData *auxDataArrayPtr;   /* Points to the start of the auxiliary data
				 * array. This is just after the last entry
				 * in the ExceptionRange array. */
    unsigned char *codeDeltaStart;
				/* Points to the first of a sequence of
				 * bytes that encode the change in the
				 * starting offset of each command's code.
				 * If -127<=delta<=127, it is encoded as 1
				 * byte, otherwise 0xFF (128) appears and
				 * the delta is encoded by the next 4 bytes.
				 * Code deltas are always positive. This
				 * sequence is just after the last entry in
				 * the AuxData array. */
    unsigned char *codeLengthStart;
				/* Points to the first of a sequence of
				 * bytes that encode the length of each
				 * command's code. The encoding is the same
				 * as for code deltas. Code lengths are
				 * always positive. This sequence is just
				 * after the last entry in the code delta
				 * sequence. */
    unsigned char *srcDeltaStart;
				/* Points to the first of a sequence of
				 * bytes that encode the change in the
				 * starting offset of each command's source.
				 * The encoding is the same as for code
				 * deltas. Source deltas can be negative.
				 * This sequence is just after the last byte
				 * in the code length sequence. */
    unsigned char *srcLengthStart;
				/* Points to the first of a sequence of
				 * bytes that encode the length of each
				 * command's source. The encoding is the
				 * same as for code deltas. Source lengths
				 * are always positive. This sequence is
				 * just after the last byte in the source
				 * delta sequence. */
#ifdef TCL_COMPILE_STATS
    Tcl_Time createTime;	/* Absolute time when the ByteCode was
				 * created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;

/*
 * Opcodes for the Tcl bytecode instructions. These must correspond to
 * the entries in the table of instruction descriptions,
 * tclInstructionTable, in tclCompile.c. Also, the order and number of
 * the expression opcodes (e.g., INST_LOR) must match the entries in
 * the array operatorStrings in tclExecute.c.
 */

/* Opcodes 0 to 9 */
#define INST_DONE			0
#define INST_PUSH1			1
#define INST_PUSH4			2
#define INST_POP			3
#define INST_DUP			4
#define INST_CONCAT1			5
#define INST_INVOKE_STK1		6
#define INST_INVOKE_STK4		7
#define INST_EVAL_STK			8
#define INST_EXPR_STK			9

/* Opcodes 10 to 23 */
#define INST_LOAD_SCALAR1		10
#define INST_LOAD_SCALAR4		11
#define INST_LOAD_SCALAR_STK		12
#define INST_LOAD_ARRAY1		13
#define INST_LOAD_ARRAY4		14
#define INST_LOAD_ARRAY_STK		15
#define INST_LOAD_STK			16
#define INST_STORE_SCALAR1		17
#define INST_STORE_SCALAR4		18
#define INST_STORE_SCALAR_STK		19
#define INST_STORE_ARRAY1		20
#define INST_STORE_ARRAY4		21
#define INST_STORE_ARRAY_STK		22
#define INST_STORE_STK			23

/* Opcodes 24 to 33 */
#define INST_INCR_SCALAR1		24
#define INST_INCR_SCALAR_STK		25
#define INST_INCR_ARRAY1		26
#define INST_INCR_ARRAY_STK		27
#define INST_INCR_STK			28
#define INST_INCR_SCALAR1_IMM		29
#define INST_INCR_SCALAR_STK_IMM	30
#define INST_INCR_ARRAY1_IMM		31
#define INST_INCR_ARRAY_STK_IMM		32
#define INST_INCR_STK_IMM		33

/* Opcodes 34 to 39 */
#define INST_JUMP1			34
#define INST_JUMP4			35
#define INST_JUMP_TRUE1			36
#define INST_JUMP_TRUE4			37
#define INST_JUMP_FALSE1		38
#define INST_JUMP_FALSE4	        39

/* Opcodes 40 to 64 */
#define INST_LOR			40
#define INST_LAND			41
#define INST_BITOR			42
#define INST_BITXOR			43
#define INST_BITAND			44
#define INST_EQ				45
#define INST_NEQ			46
#define INST_LT				47
#define INST_GT				48
#define INST_LE				49
#define INST_GE				50
#define INST_LSHIFT			51
#define INST_RSHIFT			52
#define INST_ADD			53
#define INST_SUB			54
#define INST_MULT			55
#define INST_DIV			56
#define INST_MOD			57
#define INST_UPLUS			58
#define INST_UMINUS			59
#define INST_BITNOT			60
#define INST_LNOT			61
#define INST_CALL_BUILTIN_FUNC1		62
#define INST_CALL_FUNC1			63
#define INST_TRY_CVT_TO_NUMERIC		64

/* Opcodes 65 to 66 */
#define INST_BREAK			65
#define INST_CONTINUE			66

/* Opcodes 67 to 68 */
#define INST_FOREACH_START4		67
#define INST_FOREACH_STEP4		68

/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4		69
#define INST_END_CATCH			70
#define INST_PUSH_RESULT		71
#define INST_PUSH_RETURN_CODE		72

/* Opcodes 73 to 78 */
#define INST_STR_EQ			73
#define INST_STR_NEQ			74
#define INST_STR_CMP			75
#define INST_STR_LEN			76
#define INST_STR_INDEX			77
#define INST_STR_MATCH			78

/* Opcodes 78 to 81 */
#define INST_LIST			79
#define INST_LIST_INDEX			80
#define INST_LIST_LENGTH		81

/* Opcodes 82 to 87 */
#define INST_APPEND_SCALAR1		82
#define INST_APPEND_SCALAR4		83
#define INST_APPEND_ARRAY1		84
#define INST_APPEND_ARRAY4		85
#define INST_APPEND_ARRAY_STK		86
#define INST_APPEND_STK			87

/* Opcodes 88 to 93 */
#define INST_LAPPEND_SCALAR1		88
#define INST_LAPPEND_SCALAR4		89
#define INST_LAPPEND_ARRAY1		90
#define INST_LAPPEND_ARRAY4		91
#define INST_LAPPEND_ARRAY_STK		92
#define INST_LAPPEND_STK		93

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

#define INST_LIST_INDEX_MULTI		94

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

#define INST_OVER                       95
#define INST_LSET_LIST			96
#define INST_LSET_FLAT                  97

/* The last opcode */
#define LAST_INST_OPCODE        	97

/*
 * 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. */
} InstOperandType;

typedef struct InstructionDesc {
    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;

extern InstructionDesc tclInstructionTable[];

/*
 * Definitions of the values of the INST_CALL_BUILTIN_FUNC instruction's
 * operand byte. Each value denotes a builtin Tcl math function. These
 * values must correspond to the entries in the tclBuiltinFuncTable array
 * below and to the values stored in the tclInt.h MathFunc structure's
 * builtinFuncIndex field.
 */

#define BUILTIN_FUNC_ACOS		0
#define BUILTIN_FUNC_ASIN		1
#define BUILTIN_FUNC_ATAN		2
#define BUILTIN_FUNC_ATAN2		3
#define BUILTIN_FUNC_CEIL		4
#define BUILTIN_FUNC_COS		5
#define BUILTIN_FUNC_COSH		6
#define BUILTIN_FUNC_EXP		7
#define BUILTIN_FUNC_FLOOR		8
#define BUILTIN_FUNC_FMOD		9
#define BUILTIN_FUNC_HYPOT		10
#define BUILTIN_FUNC_LOG		11
#define BUILTIN_FUNC_LOG10		12
#define BUILTIN_FUNC_POW		13
#define BUILTIN_FUNC_SIN		14
#define BUILTIN_FUNC_SINH		15
#define BUILTIN_FUNC_SQRT		16
#define BUILTIN_FUNC_TAN		17
#define BUILTIN_FUNC_TANH		18
#define BUILTIN_FUNC_ABS		19
#define BUILTIN_FUNC_DOUBLE		20
#define BUILTIN_FUNC_INT		21
#define BUILTIN_FUNC_RAND		22
#define BUILTIN_FUNC_ROUND		23
#define BUILTIN_FUNC_SRAND		24
#define BUILTIN_FUNC_WIDE		25

#define LAST_BUILTIN_FUNC        	25

/*
 * Table describing the built-in math functions. Entries in this table are
 * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
 * operand byte.
 */

typedef int (CallBuiltinFuncProc) _ANSI_ARGS_((Tcl_Interp *interp,
        ExecEnv *eePtr, ClientData clientData));

typedef struct {
    char *name;			/* Name of function. */
    int numArgs;		/* Number of arguments for function. */
    Tcl_ValueType argTypes[MAX_MATH_ARGS];
				/* Acceptable types for each argument. */
    CallBuiltinFuncProc *proc;	/* Procedure implementing this function. */
    ClientData clientData;	/* Additional argument to pass to the
				 * function when invoking it. */
} BuiltinFunc;

extern BuiltinFunc tclBuiltinFuncTable[];

/*
 * 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. */
    int codeOffset;		/* Offset of the first byte of the one-byte
				 * forward jump's code. */
    int cmdIndex;		/* Index of the first command after the one
				 * for which the jump was emitted. Used to
				 * update the code offsets for subsequent
				 * commands if the two-byte jump at jumpPc
				 * must be replaced with a five-byte one. */
    int exceptIndex;		/* Index of the first range entry in the
				 * ExceptionRange array after the current
				 * one. This field is used to adjust the
				 * code offsets in subsequent ExceptionRange
				 * records when a jump is grown from 2 bytes
				 * to 5 bytes. */
} JumpFixup;

#define JUMPFIXUP_INIT_ENTRIES    10

typedef struct JumpFixupArray {
    JumpFixup *fixup;		/* Points to start of jump fixup array. */
    int next;			/* Index of next free array entry. */
    int end;			/* Index of last usable entry in array. */
    int mallocedArray;		/* 1 if array was expanded and fixups points
				 * into the heap, else 0. */
    JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
				/* Initial storage for jump fixup array. */
} JumpFixupArray;

/*
 * The structure describing one variable list of a foreach command. Note
 * that only foreach commands inside procedure bodies are compiled inline so
 * a ForeachVarList structure always describes local variables. Furthermore,
 * only scalar variables are supported for inline-compiled foreach loops.
 */

typedef struct ForeachVarList {
    int numVars;		/* The number of variables in the list. */
    int varIndexes[1];		/* An array of the indexes ("slot numbers")
				 * for each variable in the procedure's
				 * array of local variables. Only scalar
				 * variables are supported. The actual
				 * size of this field will be large enough
				 * to numVars indexes. THIS MUST BE THE
				 * LAST FIELD IN THE STRUCTURE! */
} ForeachVarList;

/*
 * Structure used to hold information about a foreach command that is needed
 * during program execution. These structures are stored in CompileEnv and
 * ByteCode structures as auxiliary data.
 */

typedef struct ForeachInfo {
    int numLists;		/* The number of both the variable and value
				 * lists of the foreach command. */
    int firstValueTemp;		/* Index of the first temp var in a proc
				 * frame used to point to a value list. */
    int loopCtTemp;		/* Index of temp var in a proc frame
				 * holding the loop's iteration count. Used
				 * to determine next value list element to
				 * assign each loop var. */
    ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
				 * structures describing each var list. The
				 * actual size of this field will be large
				 * enough to numVars indexes. THIS MUST BE
				 * THE LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;

extern AuxDataType		tclForeachInfoType;


/*
 *----------------------------------------------------------------
 * Procedures exported by tclBasic.c to be used within the engine.
 *----------------------------------------------------------------
 */

EXTERN int		TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[], CONST char *command, int length,
			    int flags));
EXTERN int              TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));


/*
 *----------------------------------------------------------------
 * Procedures exported by the engine to be used by tclBasic.c
 *----------------------------------------------------------------
 */

#ifndef TCL_TIP280
EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
#else
EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, CONST CmdFrame* invoker,
			    int word));
#endif

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

EXTERN void		TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
EXTERN int		TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr));
EXTERN int		TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *script, int numBytes,
			    CompileEnv *envPtr));
EXTERN int		TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int numWords,
			    CompileEnv *envPtr));
EXTERN int		TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *script, int numBytes, int nested,
			    CompileEnv *envPtr));
EXTERN int		TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr));
EXTERN int		TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
			    AuxDataType *typePtr, CompileEnv *envPtr));
EXTERN int		TclCreateExceptRange _ANSI_ARGS_((
			    ExceptionRangeType type, CompileEnv *envPtr));
EXTERN ExecEnv *	TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void		TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
EXTERN void		TclDeleteLiteralTable _ANSI_ARGS_((
			    Tcl_Interp *interp, LiteralTable *tablePtr));
EXTERN void		TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr));
EXTERN ExceptionRange *	TclGetExceptionRangeForPc _ANSI_ARGS_((
			    unsigned char *pc, int catchOnly,
			    ByteCode* codePtr));
EXTERN void		TclExpandJumpFixupArray _ANSI_ARGS_((
                            JumpFixupArray *fixupArrayPtr));
EXTERN void		TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void));
EXTERN int		TclFindCompiledLocal _ANSI_ARGS_((CONST char *name, 
        		    int nameChars, int create, int flags,
			    Proc *procPtr));
EXTERN LiteralEntry *	TclLookupLiteralEntry _ANSI_ARGS_((
			    Tcl_Interp *interp, Tcl_Obj *objPtr));
EXTERN int		TclFixupForwardJump _ANSI_ARGS_((
			    CompileEnv *envPtr, JumpFixup *jumpFixupPtr,
			    int jumpDist, int distThreshold));
EXTERN void		TclFreeCompileEnv _ANSI_ARGS_((CompileEnv *envPtr));
EXTERN void		TclFreeJumpFixupArray _ANSI_ARGS_((
  			    JumpFixupArray *fixupArrayPtr));
EXTERN void		TclInitAuxDataTypeTable _ANSI_ARGS_((void));
EXTERN void		TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
			    CompileEnv *envPtr));
EXTERN void		TclInitCompilation _ANSI_ARGS_((void));
#ifndef TCL_TIP280
EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
			    CompileEnv *envPtr, char *string,
			    int numBytes));
#else
EXTERN void		TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
			    CompileEnv *envPtr, char *string,
			    int numBytes, CONST CmdFrame* invoker, int word));
#endif
EXTERN void		TclInitJumpFixupArray _ANSI_ARGS_((
			    JumpFixupArray *fixupArrayPtr));
EXTERN void		TclInitLiteralTable _ANSI_ARGS_((
			    LiteralTable *tablePtr));
#ifdef TCL_COMPILE_STATS
EXTERN char *		TclLiteralStats _ANSI_ARGS_((
			    LiteralTable *tablePtr));
EXTERN int		TclLog2 _ANSI_ARGS_((int value));
#endif
#ifdef TCL_COMPILE_DEBUG
EXTERN void		TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Obj *objPtr));
#endif
EXTERN int		TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr,
			    unsigned char *pc));
EXTERN void		TclPrintObject _ANSI_ARGS_((FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars));
EXTERN void		TclPrintSource _ANSI_ARGS_((FILE *outFile,
			    CONST char *string, int maxChars));
EXTERN void		TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
EXTERN int		TclRegisterLiteral _ANSI_ARGS_((CompileEnv *envPtr,
			    char *bytes, int length, int onHeap));
EXTERN void		TclReleaseLiteral _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
EXTERN void		TclSetCmdNameObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Command *cmdPtr));
#ifdef TCL_COMPILE_DEBUG
EXTERN void		TclVerifyGlobalLiteralTable _ANSI_ARGS_((
			    Interp *iPtr));
EXTERN void		TclVerifyLocalLiteralTable _ANSI_ARGS_((
			    CompileEnv *envPtr));
#endif
EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
			    Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr));

/*
 *----------------------------------------------------------------
 * Macros used by Tcl bytecode compilation and execution modules
 * inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

/*
 * Form of TclRegisterLiteral with onHeap == 0.
 * In that case, it is safe to cast away CONSTness, and it
 * is cleanest to do that here, all in one place.
 */

#define TclRegisterNewLiteral(envPtr, bytes, length) \
	TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)

/*
 * Macro used to update the stack requirements.
 * It is called by the macros TclEmitOpCode, TclEmitInst1 and
 * TclEmitInst4.
 * Remark that the very last instruction of a bytecode always
 * reduces the stack level: INST_DONE or INST_POP, so that the 
 * maxStackdepth is always updated.
 */

#define TclUpdateStackReqs(op, i, envPtr) \
    {\
	int delta = tclInstructionTable[(op)].stackEffect;\
	if (delta) {\
	    if (delta < 0) {\
		if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
		    (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
		}\
		if (delta == INT_MIN) {\
		    delta = 1 - (i);\
		}\
	    }\
	    (envPtr)->currStackDepth += delta;\
	}\
    }

/*
 * Macro to emit an opcode byte into a CompileEnv's code array.
 * The ANSI C "prototype" for this macro is:
 *
 * EXTERN void	TclEmitOpcode _ANSI_ARGS_((unsigned char op,
 *		    CompileEnv *envPtr));
 */

#define TclEmitOpcode(op, envPtr) \
    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
        TclExpandCodeArray(envPtr); \
    *(envPtr)->codeNext++ = (unsigned char) (op);\
    TclUpdateStackReqs(op, 0, envPtr)

/*
 * Macro to emit an integer operand.
 * The ANSI C "prototype" for this macro is:
 *
 * EXTERN void	TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
 */

#define TclEmitInt1(i, envPtr) \
    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
        TclExpandCodeArray(envPtr); \
    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))

/*
 * Macros to emit an instruction with signed or unsigned integer operands.
 * Four byte integers are stored in "big-endian" order with the high order
 * byte stored at the lowest address.
 * The ANSI C "prototypes" for these macros are:
 *
 * EXTERN void	TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i, 
 *		    CompileEnv *envPtr));
 * EXTERN void	TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i, 
 *		    CompileEnv *envPtr));
 */


#define TclEmitInstInt1(op, i, envPtr) \
    if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
        TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) (op); \
    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
    TclUpdateStackReqs(op, i, envPtr)

#define TclEmitInstInt4(op, i, envPtr) \
    if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
        TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) (op); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i) >> 24); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i) >> 16); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i) >>  8); \
    *(envPtr)->codeNext++ = \
        (unsigned char) ((unsigned int) (i)      );\
    TclUpdateStackReqs(op, i, envPtr)
    
/*
 * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
 * object's one or four byte array index into the CompileEnv's code
 * array. These support, respectively, a maximum of 256 (2**8) and 2**32
 * objects in a CompileEnv. The ANSI C "prototype" for this macro is:
 *
 * EXTERN void	TclEmitPush _ANSI_ARGS_((int objIndex, CompileEnv *envPtr));
 */

#define TclEmitPush(objIndex, envPtr) \
    {\
        register int objIndexCopy = (objIndex);\
        if (objIndexCopy <= 255) { \
	    TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
        } else { \
	    TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
	}\
    }

/*
 * Macros to update a (signed or unsigned) integer starting at a pointer.
 * The two variants depend on the number of bytes. The ANSI C "prototypes"
 * for these macros are:
 *
 * EXTERN void	TclStoreInt1AtPtr _ANSI_ARGS_((int i, unsigned char *p));
 * EXTERN void	TclStoreInt4AtPtr _ANSI_ARGS_((int i, unsigned char *p));
 */
    
#define TclStoreInt1AtPtr(i, p) \
    *(p)   = (unsigned char) ((unsigned int) (i))
    
#define TclStoreInt4AtPtr(i, p) \
    *(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
    *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
    *(p+2) = (unsigned char) ((unsigned int) (i) >>  8); \
    *(p+3) = (unsigned char) ((unsigned int) (i)      )

/*
 * 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:
 *
 * EXTERN void	TclUpdateInstInt1AtPc _ANSI_ARGS_((unsigned char op, int i,
 *		    unsigned char *pc));
 * EXTERN void	TclUpdateInstInt4AtPc _ANSI_ARGS_((unsigned char op, int i,
 *		    unsigned char *pc));
 */

#define TclUpdateInstInt1AtPc(op, i, pc) \
    *(pc) = (unsigned char) (op); \
    TclStoreInt1AtPtr((i), ((pc)+1))

#define TclUpdateInstInt4AtPc(op, i, pc) \
    *(pc) = (unsigned char) (op); \
    TclStoreInt4AtPtr((i), ((pc)+1))
    
/*
 * 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:
 *
 * EXTERN int	        TclGetInt1AtPtr  _ANSI_ARGS_((unsigned char *p));
 * EXTERN int	        TclGetInt4AtPtr  _ANSI_ARGS_((unsigned char *p));
 * EXTERN unsigned int	TclGetUInt1AtPtr _ANSI_ARGS_((unsigned char *p));
 * EXTERN unsigned int	TclGetUInt4AtPtr _ANSI_ARGS_((unsigned char *p));
 */

/*
 * The TclGetInt1AtPtr macro is tricky because we want to do sign
 * extension on the 1-byte value. Unfortunately the "char" type isn't
 * signed on all platforms so sign-extension doesn't always happen
 * automatically. Sometimes we can explicitly declare the pointer to be
 * signed, but other times we have to explicitly sign-extend the value
 * in software.
 */

#ifndef __CHAR_UNSIGNED__
#   define TclGetInt1AtPtr(p) ((int) *((char *) p))
#else
#   ifdef HAVE_SIGNED_CHAR
#	define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#    else
#	define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
		| ((*(p) & 0200) ? (-256) : 0))
#    endif
#endif

#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
		                  	    (*((p)+1) << 16) | \
				  	    (*((p)+2) <<  8) | \
				  	    (*((p)+3)))

#define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) ((unsigned int) (*(p)     << 24) | \
		                            (*((p)+1) << 16) | \
				            (*((p)+2) <<  8) | \
				            (*((p)+3)))

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

#define TclMin(i, j)   ((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j)   ((((int) i) > ((int) j))? (i) : (j))

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

#include "tclDTrace.h"

#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_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_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_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_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()

#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_ENTRY(a0, a1, a2)   {}
#define TCL_DTRACE_PROC_RETURN(a0, a1)	    {}
#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {}
#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}

#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_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_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) {}

#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, char **args, int *argsi);

#define TCL_DTRACE_DEBUG_LOG() \
	int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;\
	int tclDTraceDebugIndent = 0; \
	FILE *tclDTraceDebugLog = NULL; \
	void TclDTraceOpenDebugLog(void) { char n[35]; \
	sprintf(n, "/tmp/tclDTraceDebug-%lu.log", (unsigned long) getpid()); \
	tclDTraceDebugLog = fopen(n, "a"); } \

#define TclDTraceDbgMsg(p, m, ...) do { if (tclDTraceDebugEnabled) { \
	int _l, _t = 0; if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \
	fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", strrchr(__FILE__, '/') + \
		1, __LINE__, &_l); _t += _l; \
	fprintf(tclDTraceDebugLog, " %.*s():%n", (_t < 18 ? 18 - _t : 0) + \
		18, __func__, &_l); _t += _l; \
	fprintf(tclDTraceDebugLog, "%*s" p "%n", (_t < 40 ? 40 - _t : 0) + \
		2 * tclDTraceDebugIndent, "", &_l); _t += _l; \
	fprintf(tclDTraceDebugLog, "%*s" m "\n", (_t < 64 ? 64 - _t : 1), "", \
		##__VA_ARGS__); fflush(tclDTraceDebugLog); \
	} } while (0)

#define TCL_DTRACE_PROC_ENTRY_ENABLED()	    1
#define TCL_DTRACE_PROC_RETURN_ENABLED()    1
#define TCL_DTRACE_PROC_RESULT_ENABLED()    1
#define TCL_DTRACE_PROC_ARGS_ENABLED()	    1
#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
	tclDTraceDebugIndent++; \
	TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2)
#define TCL_DTRACE_PROC_RETURN(a0, a1) \
	TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \
	tclDTraceDebugIndent--
#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \
	TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3)
#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
		a1, a2, a3, a4, a5, a6, a7, a8, a9)

#define TCL_DTRACE_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_ENTRY(a0, a1, a2) \
	tclDTraceDebugIndent++; \
	TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2)
#define TCL_DTRACE_CMD_RETURN(a0, a1) \
	TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \
	tclDTraceDebugIndent--
#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \
	TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3)
#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
		a1, a2, a3, a4, a5, a6, a7, a8, a9)

#define TCL_DTRACE_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) \
	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)

#endif /* TCL_DTRACE_DEBUG */

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLCOMPILATION */