summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.h
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompile.h')
-rw-r--r--generic/tclCompile.h566
1 files changed, 376 insertions, 190 deletions
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c035a03..3302f9b 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,53 @@ 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
+
/* The last opcode */
-#define LAST_INST_OPCODE 131
+#define LAST_INST_OPCODE 162
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -696,7 +742,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 +754,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 +844,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 +857,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 +875,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 +896,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 +918,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 +968,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 +979,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 +1025,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 +1060,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 +1080,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 +1098,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 +1116,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 +1149,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 +1187,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 +1209,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 +1226,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 +1247,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 +1273,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 +1302,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 +1415,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 +1430,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 +1449,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 +1462,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 +1476,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 +1486,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 +1501,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 +1532,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 +1579,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 +1599,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 +1612,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 */