diff options
Diffstat (limited to 'generic/tclCompile.h')
| -rw-r--r-- | generic/tclCompile.h | 522 |
1 files changed, 189 insertions, 333 deletions
diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 45d50ea..bc298ae 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -127,25 +127,26 @@ 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 - * tclCompileObj. */ + * 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 + 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 @@ -170,7 +171,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); @@ -183,7 +184,7 @@ typedef void (AuxDataPrintProc)(ClientData clientData, */ typedef struct AuxDataType { - const char *name; /* The name of the type. Types can be + 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 @@ -206,7 +207,7 @@ typedef struct AuxDataType { */ typedef struct AuxData { - const AuxDataType *type; /* Pointer to the AuxData type associated with + AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ ClientData clientData; /* The compilation data itself. */ } AuxData; @@ -310,13 +311,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; /* @@ -341,8 +342,6 @@ 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 @@ -438,7 +437,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 @@ -666,18 +665,8 @@ 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 - /* The last opcode */ -#define LAST_INST_OPCODE 137 +#define LAST_INST_OPCODE 131 /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -707,7 +696,7 @@ typedef enum InstOperandType { } InstOperandType; typedef struct InstructionDesc { - const char *name; /* Name of instruction. */ + 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 @@ -719,7 +708,7 @@ typedef struct InstructionDesc { /* The type of each operand. */ } InstructionDesc; -MODULE_SCOPE InstructionDesc const tclInstructionTable[]; +MODULE_SCOPE InstructionDesc tclInstructionTable[]; /* * Compilation of some Tcl constructs such as if commands and the logical or @@ -809,7 +798,7 @@ typedef struct ForeachInfo { * LAST FIELD IN THE STRUCTURE! */ } ForeachInfo; -MODULE_SCOPE const AuxDataType tclForeachInfoType; +MODULE_SCOPE AuxDataType tclForeachInfoType; /* * Structure used to hold information about a switch command that is needed @@ -822,7 +811,7 @@ typedef struct JumptableInfo { * offsets). */ } JumptableInfo; -MODULE_SCOPE const AuxDataType tclJumptableInfoType; +MODULE_SCOPE AuxDataType tclJumptableInfoType; /* * Structure used to hold information about a [dict update] command that is @@ -840,14 +829,14 @@ typedef struct { * STRUCTURE. */ } DictUpdateInfo; -MODULE_SCOPE const AuxDataType tclDictUpdateInfoType; +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 *op; /* Do not call it 'operator': C++ reserved */ const char *expected; union { int numArgs; @@ -861,16 +850,16 @@ typedef struct { *---------------------------------------------------------------- */ -MODULE_SCOPE Tcl_NRPostProc NRCommand; -MODULE_SCOPE Tcl_ObjCmdProc NRInterpCoroutine; - +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 *---------------------------------------------------------------- */ -MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word); /* @@ -884,45 +873,41 @@ 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, - const AuxDataType *typePtr, CompileEnv *envPtr); + AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); -MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); -MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes, - int length, unsigned int hash, int *newPtr, - Namespace *nsPtr, int flags, - LiteralEntry **globalPtrPtr); +MODULE_SCOPE 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); + int catchOnly, ByteCode* codePtr); MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); -MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, +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, CompileEnv *envPtr); -MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp, - Tcl_Obj *objPtr); +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); @@ -931,10 +916,9 @@ MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitAuxDataTypeTable(void); MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr, CompileEnv *envPtr); -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 @@ -945,42 +929,33 @@ MODULE_SCOPE int TclLog2(int value); MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif -MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, - const unsigned char *pc); +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 void TclRegisterAuxDataType(const AuxDataType *typePtr); + 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[]); + 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); - /* *---------------------------------------------------------------- @@ -989,31 +964,31 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); *---------------------------------------------------------------- */ -#define LITERAL_ON_HEAP 0x01 -#define LITERAL_CMD_NAME 0x02 +#define LITERAL_ON_HEAP 0x01 +#define LITERAL_NS_SCOPE 0x02 /* - * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to - * cast away constness, and it is cleanest to do that here, all in one place. + * 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) + TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0) /* - * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it - * is safe to cast away constness, and it is cleanest to do that here, all in - * one place. + * 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 TclRegisterNewCmdLiteral(envPtr, bytes, length) \ - TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME) +#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 @@ -1024,14 +999,12 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclAdjustStackDepth(delta, envPtr) \ - do { \ - if ((delta) < 0) { \ - if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \ - (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ - } \ - } \ - (envPtr)->currStackDepth += (delta); \ - } while (0) + 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 @@ -1044,15 +1017,15 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclUpdateStackReqs(op, i, envPtr) \ - do { \ - int delta = tclInstructionTable[(op)].stackEffect; \ - if (delta) { \ - if (delta == INT_MIN) { \ - delta = 1 - (i); \ - } \ - TclAdjustStackDepth(delta, envPtr); \ - } \ - } while (0) + {\ + 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 @@ -1062,14 +1035,12 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclEmitOpcode(op, 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) + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op);\ + (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ + TclUpdateStackReqs(op, 0, envPtr) /* * Macros to emit an integer operand. The ANSI C "prototype" for these macros @@ -1080,27 +1051,23 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclEmitInt1(i, envPtr) \ - do { \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ - } while (0) + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)) #define TclEmitInt4(i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - } while (0) + 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. @@ -1113,33 +1080,29 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclEmitInstInt1(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ - TclUpdateStackReqs(op, i, envPtr); \ - } while (0) + 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) #define TclEmitInstInt4(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD); \ - TclUpdateStackReqs(op, i, envPtr); \ - } while (0) + 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) /* * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the @@ -1151,14 +1114,14 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclEmitPush(objIndex, envPtr) \ - do { \ - register int objIndexCopy = (objIndex); \ - if (objIndexCopy <= 255) { \ + {\ + 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 @@ -1173,12 +1136,10 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); *(p) = (unsigned char) ((unsigned int) (i)) #define TclStoreInt4AtPtr(i, p) \ - do { \ - *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ - *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ - *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ - *(p+3) = (unsigned char) ((unsigned int) (i) ); \ - } while (0) + *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ + *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ + *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ + *(p+3) = (unsigned char) ((unsigned int) (i) ) /* * Macros to update instructions at a particular pc with a new op code and a @@ -1190,16 +1151,12 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclUpdateInstInt1AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt1AtPtr((i), ((pc)+1)); \ - } while (0) + *(pc) = (unsigned char) (op); \ + TclStoreInt1AtPtr((i), ((pc)+1)) #define TclUpdateInstInt4AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt4AtPtr((i), ((pc)+1)); \ - } while (0) + *(pc) = (unsigned char) (op); \ + TclStoreInt4AtPtr((i), ((pc)+1)) /* * Macro to fix up a forward jump to point to the current code-generation @@ -1211,7 +1168,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); */ #define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \ - TclFixupForwardJump((envPtr), (fixupPtr), \ + TclFixupForwardJump((envPtr), (fixupPtr), \ (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \ (threshold)) @@ -1237,26 +1194,25 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #ifndef __CHAR_UNSIGNED__ # define TclGetInt1AtPtr(p) ((int) *((char *) p)) -#elif defined(HAVE_SIGNED_CHAR) -# define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) #else -# define TclGetInt1AtPtr(p) \ - (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0)) +# ifdef HAVE_SIGNED_CHAR +# define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) +# else +# define TclGetInt1AtPtr(p) (((int) *((char *) p)) \ + | ((*(p) & 0200) ? (-256) : 0)) +# endif #endif -#define TclGetInt4AtPtr(p) \ - (((int) TclGetInt1AtPtr(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ - (*((p)+3))) +#define 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 @@ -1266,96 +1222,8 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); * int TclMax(int i, int j); */ -#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j)) -#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) - -/* - * Convenience 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) +#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j)) +#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) /* * DTrace probe macros (NOPs if DTrace support is not enabled). @@ -1369,7 +1237,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); * 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). */ @@ -1384,10 +1252,10 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #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) @@ -1403,8 +1271,8 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3) #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) -#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ - TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) +#define TCL_DTRACE_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()) @@ -1416,8 +1284,8 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3) #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) -#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ - TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) +#define TCL_DTRACE_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()) @@ -1430,8 +1298,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #define TCL_DTRACE_DEBUG_LOG() -MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, - int *argsi); +MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); #else /* USE_DTRACE */ @@ -1440,11 +1307,11 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, #define TCL_DTRACE_PROC_RESULT_ENABLED() 0 #define TCL_DTRACE_PROC_ARGS_ENABLED() 0 #define TCL_DTRACE_PROC_INFO_ENABLED() 0 -#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {if (a0) {}} -#define TCL_DTRACE_PROC_RETURN(a0, a1) {if (a0) {}} -#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}} +#define TCL_DTRACE_PROC_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, a6, a7) {} +#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 @@ -1455,7 +1322,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, #define TCL_DTRACE_CMD_RETURN(a0, a1) {} #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {} #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} -#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {} +#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) {} #define TCL_DTRACE_INST_START_ENABLED() 0 #define TCL_DTRACE_INST_DONE_ENABLED() 0 @@ -1486,36 +1353,27 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent; MODULE_SCOPE FILE *tclDTraceDebugLog; MODULE_SCOPE void TclDTraceOpenDebugLog(void); -MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); +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) + 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 @@ -1533,9 +1391,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const 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, a6, a7) \ - TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \ - a2, a3, a4, a5, a6, a7) +#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 @@ -1553,9 +1411,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const 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, a6, a7) \ - TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \ - a2, a3, a4, a5, a6, a7) +#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 @@ -1566,11 +1424,9 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const 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) \ - do { \ - tclDTraceDebugEnabled = 1; \ + tclDTraceDebugEnabled = 1; \ TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \ - a1, a2, a3, a4, a5, a6, a7, a8, a9); \ - } while (0) + a1, a2, a3, a4, a5, a6, a7, a8, a9) #endif /* TCL_DTRACE_DEBUG */ |