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