diff options
Diffstat (limited to 'generic/tclCompile.h')
| -rw-r--r-- | generic/tclCompile.h | 568 |
1 files changed, 378 insertions, 190 deletions
diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c035a03..4d8ed65 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -127,26 +127,25 @@ typedef struct CmdLocation { typedef struct ECL { int srcOffset; /* Command location to find the entry. */ - int nline; /* Number of words in the command */ + 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 + 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 + int start; /* Starting line for compiled script. Needed * for the extended recompile check in - * TclCompEvalObj. */ - + * 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'. */ - Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the + 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 @@ -171,7 +170,7 @@ typedef struct ExtCmdLoc { */ typedef ClientData (AuxDataDupProc) (ClientData clientData); -typedef void (AuxDataFreeProc) (ClientData clientData); +typedef void (AuxDataFreeProc) (ClientData clientData); typedef void (AuxDataPrintProc)(ClientData clientData, Tcl_Obj *appendObj, struct ByteCode *codePtr, unsigned int pcOffset); @@ -184,7 +183,7 @@ typedef void (AuxDataPrintProc)(ClientData clientData, */ typedef struct AuxDataType { - char *name; /* The name of the type. Types can be + 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 @@ -207,7 +206,7 @@ typedef struct AuxDataType { */ typedef struct AuxData { - AuxDataType *type; /* Pointer to the AuxData type associated with + const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ ClientData clientData; /* The compilation data itself. */ } AuxData; @@ -311,13 +310,13 @@ typedef struct CompileEnv { * 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. */ + 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; /* @@ -342,6 +341,8 @@ typedef struct CompileEnv { #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 @@ -437,7 +438,7 @@ typedef struct ByteCode { * 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 + LocalCache *localCachePtr; /* Pointer to the start of the cached variable * names and initialisation data for local * variables. */ #ifdef TCL_COMPILE_STATS @@ -665,8 +666,55 @@ typedef struct ByteCode { #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 +#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 + /* The last opcode */ -#define LAST_INST_OPCODE 131 +#define LAST_INST_OPCODE 163 /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -696,7 +744,7 @@ typedef enum InstOperandType { } InstOperandType; typedef struct InstructionDesc { - char *name; /* Name of instruction. */ + 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 @@ -708,7 +756,7 @@ typedef struct InstructionDesc { /* The type of each operand. */ } InstructionDesc; -MODULE_SCOPE InstructionDesc tclInstructionTable[]; +MODULE_SCOPE InstructionDesc const tclInstructionTable[]; /* * Compilation of some Tcl constructs such as if commands and the logical or @@ -798,7 +846,7 @@ typedef struct ForeachInfo { * LAST FIELD IN THE STRUCTURE! */ } ForeachInfo; -MODULE_SCOPE AuxDataType tclForeachInfoType; +MODULE_SCOPE const AuxDataType tclForeachInfoType; /* * Structure used to hold information about a switch command that is needed @@ -811,7 +859,7 @@ typedef struct JumptableInfo { * offsets). */ } JumptableInfo; -MODULE_SCOPE AuxDataType tclJumptableInfoType; +MODULE_SCOPE const AuxDataType tclJumptableInfoType; /* * Structure used to hold information about a [dict update] command that is @@ -829,14 +877,14 @@ typedef struct { * STRUCTURE. */ } DictUpdateInfo; -MODULE_SCOPE AuxDataType tclDictUpdateInfoType; +MODULE_SCOPE const AuxDataType tclDictUpdateInfoType; /* * ClientData type used by the math operator commands. */ typedef struct { - const char *op; /* Do not call it 'operator': C++ reserved */ + const char *op; /* Do not call it 'operator': C++ reserved */ const char *expected; union { int numArgs; @@ -850,16 +898,15 @@ typedef struct { *---------------------------------------------------------------- */ -MODULE_SCOPE int TclEvalObjvInternal(Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[], - CONST char *command, int length, int flags); +MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; + /* *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c *---------------------------------------------------------------- */ -MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word); /* @@ -873,41 +920,43 @@ MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr); 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 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 TclCompileScript(Tcl_Interp *interp, - CONST char *script, int numBytes, + 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, - AuxDataType *typePtr, CompileEnv *envPtr); + const 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 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 ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, - int catchOnly, ByteCode* codePtr); + int catchOnly, ByteCode *codePtr); MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); -MODULE_SCOPE int TclExecuteByteCode(Tcl_Interp *interp, +MODULE_SCOPE int TclNRExecuteByteCode(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 TclFindCompiledLocal(const char *name, int nameChars, + int create, CompileEnv *envPtr); MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, @@ -921,7 +970,7 @@ MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, MODULE_SCOPE void TclInitCompilation(void); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr, const char *string, - int numBytes, CONST CmdFrame* invoker, int word); + int numBytes, const CmdFrame *invoker, int word); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); #ifdef TCL_COMPILE_STATS @@ -932,34 +981,44 @@ MODULE_SCOPE int TclLog2(int value); MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif -MODULE_SCOPE int TclPrintInstruction(ByteCode* codePtr, - unsigned char *pc); +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 TclRegisterAuxDataType(AuxDataType *typePtr); + const char *string, int maxChars); +MODULE_SCOPE void TclRegisterAuxDataType(const AuxDataType *typePtr); MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr, char *bytes, int length, int flags); 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[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclSortingOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + 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); + /* *---------------------------------------------------------------- @@ -968,31 +1027,31 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, *---------------------------------------------------------------- */ -#define LITERAL_ON_HEAP 0x01 -#define LITERAL_NS_SCOPE 0x02 +#define LITERAL_ON_HEAP 0x01 +#define LITERAL_CMD_NAME 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. + * 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) + 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. + * 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 TclRegisterNewNSLiteral(envPtr, bytes, length) \ - TclRegisterLiteral(envPtr, (char *)(bytes), length, \ - /*flags*/ LITERAL_NS_SCOPE) +#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 @@ -1003,12 +1062,14 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclAdjustStackDepth(delta, envPtr) \ - if ((delta) < 0) {\ - if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\ - (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\ - }\ - }\ - (envPtr)->currStackDepth += (delta) + do { \ + if ((delta) < 0) { \ + if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \ + (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ + } \ + } \ + (envPtr)->currStackDepth += (delta); \ + } while (0) /* * Macro used to update the stack requirements. It is called by the macros @@ -1021,15 +1082,15 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclUpdateStackReqs(op, i, envPtr) \ - {\ - int delta = tclInstructionTable[(op)].stackEffect;\ - if (delta) {\ - if (delta == INT_MIN) {\ - delta = 1 - (i);\ - }\ - TclAdjustStackDepth(delta, envPtr);\ - }\ - } + do { \ + int delta = tclInstructionTable[(op)].stackEffect; \ + if (delta) { \ + if (delta == INT_MIN) { \ + delta = 1 - (i); \ + } \ + TclAdjustStackDepth(delta, envPtr); \ + } \ + } while (0) /* * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C @@ -1039,12 +1100,14 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclEmitOpcode(op, envPtr) \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op);\ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ - TclUpdateStackReqs(op, 0, envPtr) + do { \ + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateStackReqs(op, 0, envPtr); \ + } while (0) /* * Macros to emit an integer operand. The ANSI C "prototype" for these macros @@ -1055,23 +1118,27 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclEmitInt1(i, envPtr) \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)) + do { \ + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ + } while (0) #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) ) + 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. @@ -1084,29 +1151,33 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclEmitInstInt1(op, i, envPtr) \ - if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ - TclUpdateStackReqs(op, i, envPtr) + do { \ + if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateStackReqs(op, i, envPtr); \ + } while (0) #define TclEmitInstInt4(op, i, envPtr) \ - if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) );\ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ - TclUpdateStackReqs(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) ); \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateStackReqs(op, i, envPtr); \ + } while (0) /* * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the @@ -1118,14 +1189,14 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclEmitPush(objIndex, envPtr) \ - {\ - register int objIndexCopy = (objIndex);\ - if (objIndexCopy <= 255) { \ + do { \ + register int objIndexCopy = (objIndex); \ + if (objIndexCopy <= 255) { \ TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \ - } else { \ + } else { \ TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \ - }\ - } + } \ + } while (0) /* * Macros to update a (signed or unsigned) integer starting at a pointer. The @@ -1140,10 +1211,12 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, *(p) = (unsigned char) ((unsigned int) (i)) #define TclStoreInt4AtPtr(i, p) \ - *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ - *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ - *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ - *(p+3) = (unsigned char) ((unsigned int) (i) ) + 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 @@ -1155,12 +1228,16 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclUpdateInstInt1AtPc(op, i, pc) \ - *(pc) = (unsigned char) (op); \ - TclStoreInt1AtPtr((i), ((pc)+1)) + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt1AtPtr((i), ((pc)+1)); \ + } while (0) #define TclUpdateInstInt4AtPc(op, i, pc) \ - *(pc) = (unsigned char) (op); \ - TclStoreInt4AtPtr((i), ((pc)+1)) + 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 @@ -1172,7 +1249,7 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, */ #define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \ - TclFixupForwardJump((envPtr), (fixupPtr), \ + TclFixupForwardJump((envPtr), (fixupPtr), \ (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \ (threshold)) @@ -1198,25 +1275,26 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #ifndef __CHAR_UNSIGNED__ # define TclGetInt1AtPtr(p) ((int) *((char *) p)) +#elif defined(HAVE_SIGNED_CHAR) +# define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) #else -# ifdef HAVE_SIGNED_CHAR -# define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) -# else -# define TclGetInt1AtPtr(p) (((int) *((char *) p)) \ - | ((*(p) & 0200) ? (-256) : 0)) -# endif +# 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 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))) +#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 @@ -1226,8 +1304,106 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, * 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)) +#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j)) +#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) + +/* + * Convenience macro for use when compiling bodies of commands. The ANSI C + * "prototype" for this macro is: + * + * static void CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr, + * Tcl_Interp *interp); + */ + +#define CompileBody(envPtr, tokenPtr, interp) \ + 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 macro for use when pushing literals. The ANSI C "prototype" for + * this macro is: + * + * static void PushLiteral(CompileEnv *envPtr, + * const char *string, int length); + */ + +#define PushLiteral(envPtr, string, length) \ + TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr)) + +/* + * 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 DeclareExceptionRange(CompileEnv *envPtr, int type); + * static int ExceptionRangeStarts(CompileEnv *envPtr, int index); + * static void ExceptionRangeEnds(CompileEnv *envPtr, int index); + * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL); + */ + +#define DeclareExceptionRange(envPtr, type) \ + (TclCreateExceptRange((type), (envPtr))) +#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) /* * DTrace probe macros (NOPs if DTrace support is not enabled). @@ -1241,7 +1417,7 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, * 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). */ @@ -1256,10 +1432,10 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #ifdef USE_DTRACE -#include "tclDTrace.h" - #if defined(__GNUC__) && __GNUC__ > 2 -/* Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. */ +/* + * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. + */ #define unlikely(x) (__builtin_expect((x), 0)) #else #define unlikely(x) (x) @@ -1275,8 +1451,8 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #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_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()) @@ -1288,8 +1464,8 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #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_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()) @@ -1302,7 +1478,8 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, #define TCL_DTRACE_DEBUG_LOG() -MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); +MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, + int *argsi); #else /* USE_DTRACE */ @@ -1311,11 +1488,11 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #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_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) {} +#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 @@ -1326,7 +1503,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #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_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {} #define TCL_DTRACE_INST_START_ENABLED() 0 #define TCL_DTRACE_INST_DONE_ENABLED() 0 @@ -1357,27 +1534,36 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); 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); +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) + 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 @@ -1395,9 +1581,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #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_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 @@ -1415,9 +1601,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #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_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 @@ -1428,9 +1614,11 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #define TCL_DTRACE_TCL_PROBE_ENABLED() 1 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ - tclDTraceDebugEnabled = 1; \ + 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) + a1, a2, a3, a4, a5, a6, a7, a8, a9); \ + } while (0) #endif /* TCL_DTRACE_DEBUG */ |