diff options
Diffstat (limited to 'generic/tclCompile.h')
| -rw-r--r-- | generic/tclCompile.h | 1425 |
1 files changed, 929 insertions, 496 deletions
diff --git a/generic/tclCompile.h b/generic/tclCompile.h index ec8f120..bc298ae 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -3,24 +3,19 @@ * * 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.15 2001/05/17 02:13:02 hobbs Exp $ + * 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 -#ifndef _TCLINT #include "tclInt.h" -#endif /* _TCLINT */ -#ifdef BUILD_tcl -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif +struct ByteCode; /* Forward declaration. */ /* *------------------------------------------------------------------------ @@ -29,14 +24,7 @@ *------------------------------------------------------------------------ */ -/* - * Variable that denotes the command name Tcl object type. Objects of this - * type cache the Command pointer that results from looking up command names - * in the command hashtable. - */ - -extern Tcl_ObjType tclCmdNameType; - +#ifdef TCL_COMPILE_DEBUG /* * Variable that controls whether compilation tracing is enabled and, if so, * what level of tracing is desired: @@ -46,7 +34,7 @@ extern Tcl_ObjType tclCmdNameType; * This variable is linked to the Tcl variable "tcl_traceCompile". */ -extern int tclTraceCompile; +MODULE_SCOPE int tclTraceCompile; /* * Variable that controls whether execution tracing is enabled and, if so, @@ -58,8 +46,9 @@ extern int tclTraceCompile; * This variable is linked to the Tcl variable "tcl_traceExec". */ -extern int tclTraceExec; - +MODULE_SCOPE int tclTraceExec; +#endif + /* *------------------------------------------------------------------------ * Data structures related to compilation. @@ -67,54 +56,55 @@ extern int tclTraceExec; */ /* - * 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. + * 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. */ + 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 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. */ + * 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. + * 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 { @@ -125,43 +115,89 @@ typedef struct CmdLocation { } CmdLocation; /* - * 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. + * 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 + * TclCompEvalObj. */ + + 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; + +/* + * 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. + * 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)); +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. + * 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. */ + 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. */ } AuxDataType; /* @@ -171,8 +207,8 @@ typedef struct AuxDataType { */ typedef struct AuxData { - AuxDataType *type; /* pointer to the AuxData type associated with - * this ClientData. */ + AuxDataType *type; /* Pointer to the AuxData type associated with + * this ClientData. */ ClientData clientData; /* The compilation data itself. */ } AuxData; @@ -190,113 +226,125 @@ typedef struct AuxData { 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 + * 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. */ + 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 + 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. */ - 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. */ - int exprIsJustVarRef; /* Set 1 if the expression last compiled by - * TclCompileExpr consisted of just a - * variable reference as in the expression - * of "if $b then...". Otherwise 0. Used - * to implement expr's 2 level substitution - * semantics properly. */ - int exprIsComparison; /* Set 1 if the top-level operator in the - * expression last compiled is a comparison. - * Otherwise 0. If 1, since the operands - * might be strings, the expr is compiled - * out-of-line to implement expr's 2 level - * substitution semantics properly. */ + 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.*/ + 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. */ + 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. */ + * 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. */ + * 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. */ + 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. */ + * 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. */ + /* Initial storage for code. */ LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS]; - /* Initial storage of LiteralEntry array. */ + /* Initial storage of LiteralEntry array. */ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; - /* Initial ExceptionRange array storage. */ + /* Initial ExceptionRange array storage. */ CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]; - /* Initial storage for cmd location map. */ + /* Initial storage for cmd location map. */ AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; - /* Initial storage for aux data array. */ + /* 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. */ + ContLineLoc* clLoc; /* If not NULL, the table holding the + * locations of the invisible continuation + * lines in the input script, to adjust the + * line counter. */ + 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. + * 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 + typedef struct ByteCode { TclHandle interpHandle; /* Handle for interpreter containing the - * compiled code. Commands and their compile + * compiled code. Commands and their compile * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ @@ -304,25 +352,25 @@ typedef struct ByteCode { * 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 + 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. */ + 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. */ + * 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 @@ -338,70 +386,71 @@ typedef struct ByteCode { 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 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. */ + 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. */ + * 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. */ + /* 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. */ + /* 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. */ + /* 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. */ + /* 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, instructionTable, 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 + * 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. */ @@ -451,7 +500,7 @@ typedef struct ByteCode { #define INST_JUMP_TRUE1 36 #define INST_JUMP_TRUE4 37 #define INST_JUMP_FALSE1 38 -#define INST_JUMP_FALSE4 39 +#define INST_JUMP_FALSE4 39 /* Opcodes 40 to 64 */ #define INST_LOR 40 @@ -507,6 +556,7 @@ typedef struct ByteCode { #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 @@ -514,6 +564,7 @@ typedef struct ByteCode { #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 @@ -521,16 +572,109 @@ typedef struct ByteCode { #define INST_LAPPEND_ARRAY_STK 92 #define INST_LAPPEND_STK 93 -/* The last opcode */ -#define LAST_INST_OPCODE 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 + +/* The last opcode */ +#define LAST_INST_OPCODE 131 + /* - * 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. + * 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 @@ -540,87 +684,43 @@ typedef enum InstOperandType { 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_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. */ } 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 instructionTable[]; - -/* - * 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 builtinFuncTable 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 LAST_BUILTIN_FUNC 24 - -/* - * 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 builtinFuncTable[]; +MODULE_SCOPE InstructionDesc tclInstructionTable[]; /* * 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. + * (||) 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 { @@ -639,14 +739,14 @@ typedef struct JumpFixup { * 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 + * 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 +#define JUMPFIXUP_INIT_ENTRIES 10 typedef struct JumpFixupArray { JumpFixup *fixup; /* Points to start of jump fixup array. */ @@ -659,21 +759,21 @@ typedef struct JumpFixupArray { } 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, + * 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! */ + * 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; /* @@ -685,244 +785,356 @@ typedef struct ForeachVarList { 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. */ + 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! */ + * enough to numVars indexes. THIS MUST BE THE + * LAST FIELD IN THE STRUCTURE! */ } ForeachInfo; -extern AuxDataType tclForeachInfoType; - -/* - * Structure containing a cached pointer to a command that is the result - * of resolving the command's name in some namespace. It is the internal - * representation for a cmdName object. It contains the pointer along - * with some information that is used to check the pointer's validity. - */ - -typedef struct ResolvedCmdName { - Command *cmdPtr; /* A cached Command pointer. */ - Namespace *refNsPtr; /* Points to the namespace containing the - * reference (not the namespace that - * contains the referenced command). */ - long refNsId; /* refNsPtr's unique namespace id. Used to - * verify that refNsPtr is still valid - * (e.g., it's possible that the cmd's - * containing namespace was deleted and a - * new one created at the same address). */ - int refNsCmdEpoch; /* Value of the referencing namespace's - * cmdRefEpoch when the pointer was cached. - * Before using the cached pointer, we check - * if the namespace's epoch was incremented; - * if so, this cached pointer is invalid. */ - int cmdEpoch; /* Value of the command's cmdEpoch when this - * pointer was cached. Before using the - * cached pointer, we check if the cmd's - * epoch was incremented; if so, the cmd was - * renamed, deleted, hidden, or exposed, and - * so the pointer is invalid. */ - int refCount; /* Reference count: 1 for each cmdName - * object that has a pointer to this - * ResolvedCmdName structure as its internal - * rep. This structure can be freed when - * refCount becomes zero. */ -} ResolvedCmdName; +MODULE_SCOPE AuxDataType tclForeachInfoType; + +/* + * 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 AuxDataType tclJumptableInfoType; + +/* + * 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; + +MODULE_SCOPE AuxDataType tclDictUpdateInfoType; /* + * 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 int TclEvalObjvInternal(Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[], + CONST char *command, int length, int flags); +/* + *---------------------------------------------------------------- + * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- - * Procedures shared among Tcl bytecode compilation and execution - * modules but not used outside: + */ + +MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + const CmdFrame *invoker, int word); + +/* + *---------------------------------------------------------------- + * 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, +MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr); +MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, - CompileEnv *envPtr)); -EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int numBytes, - CompileEnv *envPtr)); -EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp, + 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)); -EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int numBytes, int nested, - CompileEnv *envPtr)); -EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp, + 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)); -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 InstructionDesc * TclGetInstructionTable _ANSI_ARGS_(()); -EXTERN int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp, - ByteCode *codePtr)); -EXTERN void TclExpandCodeArray _ANSI_ARGS_(( - CompileEnv *envPtr)); -EXTERN void TclExpandJumpFixupArray _ANSI_ARGS_(( - JumpFixupArray *fixupArrayPtr)); -EXTERN void TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void)); -EXTERN int TclFindCompiledLocal _ANSI_ARGS_((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)); -EXTERN void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp, - CompileEnv *envPtr, char *string, - int numBytes)); -EXTERN void TclInitJumpFixupArray _ANSI_ARGS_(( - JumpFixupArray *fixupArrayPtr)); -EXTERN void TclInitLiteralTable _ANSI_ARGS_(( - LiteralTable *tablePtr)); + CompileEnv *envPtr); +MODULE_SCOPE int TclCreateAuxData(ClientData clientData, + AuxDataType *typePtr, CompileEnv *envPtr); +MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, + CompileEnv *envPtr); +MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp); +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 ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, + int catchOnly, ByteCode* codePtr); +MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); +MODULE_SCOPE int TclExecuteByteCode(Tcl_Interp *interp, + ByteCode *codePtr); +MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void); +MODULE_SCOPE int TclFindCompiledLocal(CONST char *name, int nameChars, + int create, Proc *procPtr); +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 TclInitAuxDataTypeTable(void); +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); #ifdef TCL_COMPILE_STATS -EXTERN char * TclLiteralStats _ANSI_ARGS_(( - LiteralTable *tablePtr)); -EXTERN int TclLog2 _ANSI_ARGS_((int value)); +MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); +MODULE_SCOPE int TclLog2(int value); #endif #ifdef TCL_COMPILE_DEBUG -EXTERN void TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); +MODULE_SCOPE void TclPrintByteCodeObj(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, - 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)); +MODULE_SCOPE int TclPrintInstruction(ByteCode* codePtr, + 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 int TclRegisterLiteral(CompileEnv *envPtr, + char *bytes, int length, int flags); +MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); +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 -EXTERN void TclVerifyGlobalLiteralTable _ANSI_ARGS_(( - Interp *iPtr)); -EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_(( - CompileEnv *envPtr)); +MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr); +MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr); #endif - +MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, + Tcl_Obj *valuePtr); + /* *---------------------------------------------------------------- - * Macros used by Tcl bytecode compilation and execution modules - * inside the Tcl core but not used outside. + * Macros and flag values used by Tcl bytecode compilation and execution + * modules inside the Tcl core but not used outside. *---------------------------------------------------------------- */ +#define LITERAL_ON_HEAP 0x01 +#define LITERAL_NS_SCOPE 0x02 + +/* + * 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. + * + * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes, + * int length); + */ + +#define TclRegisterNewLiteral(envPtr, bytes, length) \ + TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0) + +/* + * Form of TclRegisterNSLiteral 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. + * + * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes, + * int length); + */ + +#define TclRegisterNewNSLiteral(envPtr, bytes, length) \ + TclRegisterLiteral(envPtr, (char *)(bytes), length, \ + /*flags*/ LITERAL_NS_SCOPE) + +/* + * 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) \ + if ((delta) < 0) {\ + if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\ + (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\ + }\ + }\ + (envPtr)->currStackDepth += (delta) + +/* + * 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) \ + {\ + int delta = tclInstructionTable[(op)].stackEffect;\ + if (delta) {\ + if (delta == INT_MIN) {\ + delta = 1 - (i);\ + }\ + TclAdjustStackDepth(delta, envPtr);\ + }\ + } + /* - * Macro to emit an opcode byte into a CompileEnv's code array. - * The ANSI C "prototype" for this macro is: + * 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)); + * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr); */ #define TclEmitOpcode(op, envPtr) \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) \ - TclExpandCodeArray(envPtr); \ - *(envPtr)->codeNext++ = (unsigned char) (op) + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op);\ + (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateStackReqs(op, 0, envPtr) /* - * Macro to emit an integer operand. - * The ANSI C "prototype" for this macro is: + * Macros to emit an integer operand. The ANSI C "prototype" for these macros + * are: * - * EXTERN void TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr)); + * void TclEmitInt1(int i, CompileEnv *envPtr); + * void TclEmitInt4(int i, CompileEnv *envPtr); */ #define TclEmitInt1(i, envPtr) \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) \ - TclExpandCodeArray(envPtr); \ + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)) +#define TclEmitInt4(i, envPtr) \ + 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) ) + /* * 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: + * 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)); + * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr); + * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr); */ #define TclEmitInstInt1(op, i, envPtr) \ if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ + TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)) + *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\ + (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateStackReqs(op, i, envPtr) #define TclEmitInstInt4(op, i, envPtr) \ if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ + TclExpandCodeArray(envPtr); \ } \ *(envPtr)->codeNext++ = (unsigned char) (op); \ *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ + (unsigned char) ((unsigned int) (i) >> 24); \ *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ + (unsigned char) ((unsigned int) (i) >> 16); \ *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ + (unsigned char) ((unsigned int) (i) >> 8); \ *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ) - + (unsigned char) ((unsigned int) (i) );\ + (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + 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: + * 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)); + * void TclEmitPush(int objIndex, CompileEnv *envPtr); */ #define TclEmitPush(objIndex, envPtr) \ - if ((objIndex) <= 255) { \ - TclEmitInstInt1(INST_PUSH1, (objIndex), (envPtr)); \ - } else { \ - TclEmitInstInt4(INST_PUSH4, (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: + * 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)); + * 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) \ *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ @@ -930,14 +1142,12 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_(( *(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: + * 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)); + * 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) \ @@ -947,26 +1157,39 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_(( #define TclUpdateInstInt4AtPc(op, i, pc) \ *(pc) = (unsigned char) (op); \ TclStoreInt4AtPtr((i), ((pc)+1)) - + +/* + * 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: + * (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)); + * 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. + * 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__ @@ -974,35 +1197,245 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_(( #else # ifdef HAVE_SIGNED_CHAR # define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) -# else +# else # define TclGetInt1AtPtr(p) (((int) *((char *) p)) \ | ((*(p) & 0200) ? (-256) : 0)) -# endif +# endif #endif #define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \ - (*((p)+1) << 16) | \ + (*((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))) + (*((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: + * 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)); + * 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)) -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT +/* + * 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_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) \ + TCL_PROC_INFO(a0, a1, a2, a3, a4, a5) + +#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) \ + TCL_CMD_INFO(a0, a1, a2, a3, a4, a5) + +#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, 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) {} +#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_PROC_INFO(a0, a1, a2, a3, a4, a5) {} + +#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) {} + +#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, 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) \ + TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d", a0, a1, \ + a2, a3, a4, a5) + +#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) \ + TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d", a0, a1, \ + a2, a3, a4, a5) + +#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 */ #endif /* _TCLCOMPILATION */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |