summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCompCmds.c37
-rw-r--r--generic/tclCompCmdsGR.c9
-rw-r--r--generic/tclCompCmdsSZ.c7
-rw-r--r--generic/tclCompile.h30
-rw-r--r--generic/tclEnsemble.c16
-rw-r--r--tests/info.test25
6 files changed, 62 insertions, 62 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index b1faa53..7fe0728 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -610,12 +610,12 @@ TclCompileCatchCmd(
* begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
*/
- SetLineInformation(1);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
- CompileBody(envPtr, cmdTokenPtr, interp);
+ BODY(cmdTokenPtr, 1);
} else {
+ SetLineInformation(1);
CompileTokens(envPtr, cmdTokenPtr, interp);
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
@@ -1467,8 +1467,7 @@ CompileDictEachCmd(
* Compile the loop body itself. It should be stack-neutral.
*/
- SetLineInformation(3);
- CompileBody(envPtr, bodyTokenPtr, interp);
+ BODY(bodyTokenPtr, 3);
if (collect == TCL_EACH_COLLECT) {
Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr);
TclEmitInstInt4(INST_OVER, 1, envPtr);
@@ -1651,8 +1650,7 @@ TclCompileDictUpdateCmd(
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
- SetLineInformation(parsePtr->numWords - 1);
- CompileBody(envPtr, bodyTokenPtr, interp);
+ BODY(bodyTokenPtr, parsePtr->numWords - 1);
ExceptionRangeEnds(envPtr, range);
/*
@@ -1992,8 +1990,7 @@ TclCompileDictWithCmd(
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
ExceptionRangeStarts(envPtr, range);
- SetLineInformation(parsePtr->numWords-1);
- CompileBody(envPtr, tokenPtr, interp);
+ BODY(tokenPtr, parsePtr->numWords - 1);
ExceptionRangeEnds(envPtr, range);
/*
@@ -2268,8 +2265,7 @@ TclCompileForCmd(
* Inline compile the initial command.
*/
- SetLineInformation(1);
- CompileBody(envPtr, startTokenPtr, interp);
+ BODY(startTokenPtr, 1);
TclEmitOpcode(INST_POP, envPtr);
/*
@@ -2292,8 +2288,7 @@ TclCompileForCmd(
bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
- SetLineInformation(4);
- CompileBody(envPtr, bodyTokenPtr, interp);
+ BODY(bodyTokenPtr, 4);
ExceptionRangeEnds(envPtr, bodyRange);
TclEmitOpcode(INST_POP, envPtr);
@@ -2306,8 +2301,7 @@ TclCompileForCmd(
nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
- SetLineInformation(3);
- CompileBody(envPtr, nextTokenPtr, interp);
+ BODY(nextTokenPtr, 3);
ExceptionRangeEnds(envPtr, nextRange);
TclEmitOpcode(INST_POP, envPtr);
@@ -2644,8 +2638,7 @@ CompileEachloopCmd(
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
if ((i%2 == 0) && (i > 0)) {
- SetLineInformation(i);
- CompileTokens(envPtr, tokenPtr, interp);
+ CompileWord(envPtr, tokenPtr, interp, i);
tempVar = (firstValueTemp + loopIndex);
Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr);
TclEmitOpcode( INST_POP, envPtr);
@@ -2682,9 +2675,8 @@ CompileEachloopCmd(
* Inline compile the loop body.
*/
- SetLineInformation(numWords - 1);
ExceptionRangeStarts(envPtr, range);
- CompileBody(envPtr, bodyTokenPtr, interp);
+ BODY(bodyTokenPtr, numWords - 1);
ExceptionRangeEnds(envPtr, range);
if (collect == TCL_EACH_COLLECT) {
@@ -3165,10 +3157,7 @@ TclPushVarName(
CompileEnv *envPtr, /* Holds resulting instructions. */
int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
int *localIndexPtr, /* Must not be NULL. */
- int *isScalarPtr, /* Must not be NULL. */
- int line, /* Line the token starts on. */
- int *clNext) /* Reference to offset of next hidden cont.
- * line. */
+ int *isScalarPtr) /* Must not be NULL. */
{
register const char *p;
const char *name, *elName;
@@ -3348,8 +3337,6 @@ TclPushVarName(
if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
if (elNameChars) {
- envPtr->line = line;
- envPtr->clNext = clNext;
TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
envPtr);
} else {
@@ -3361,8 +3348,6 @@ TclPushVarName(
* The var name isn't simple: compile and push it.
*/
- envPtr->line = line;
- envPtr->clNext = clNext;
CompileTokens(envPtr, varTokenPtr, interp);
}
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 4de8cf2..fc68509 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -264,8 +264,7 @@ TclCompileIfCmd(
*/
if (compileScripts) {
- SetLineInformation(wordIdx);
- CompileBody(envPtr, tokenPtr, interp);
+ BODY(tokenPtr, wordIdx);
}
if (realCond) {
@@ -345,8 +344,7 @@ TclCompileIfCmd(
* Compile the else command body.
*/
- SetLineInformation(wordIdx);
- CompileBody(envPtr, tokenPtr, interp);
+ BODY(tokenPtr, wordIdx);
}
/*
@@ -701,8 +699,7 @@ TclCompileInfoLevelCmd(
* list of arguments.
*/
- SetLineInformation(1);
- CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp);
+ CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr);
}
return TCL_OK;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 58a5ba5..320ed57 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -85,8 +85,6 @@ const AuxDataType tclJumptableInfoType = {
TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define OP44(name,val1,val2) \
TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
-#define BODY(token,index) \
- SetLineInformation((index));CompileBody(envPtr,(token),interp)
#define PUSH(str) \
PushStringLiteral(envPtr, str)
#define JUMP4(name,var) \
@@ -1287,8 +1285,7 @@ TclCompileSwitchCmd(
*/
/* Both methods push the value to match against onto the stack. */
- SetLineInformation(valueIndex);
- CompileTokens(envPtr, valueTokenPtr, interp);
+ CompileWord(envPtr, valueTokenPtr, interp, valueIndex);
if (mode == Switch_Exact) {
IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
@@ -1502,7 +1499,7 @@ IssueSwitchChainedTests(
}
/*
- * Now do the actual compilation. Note that we do not use CompileBody
+ * Now do the actual compilation. Note that we do not use BODY()
* because we may have synthesized the tokens in a non-standard
* pattern.
*/
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index cbe104c..0bcd84e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1075,7 +1075,7 @@ MODULE_SCOPE void TclPrintSource(FILE *outFile,
MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
- int *isScalarPtr, int line, int *clNext);
+ int *isScalarPtr);
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
char *bytes, int length, int flags);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -1408,16 +1408,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
#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:
+ * Convenience macros for use when compiling bodies of commands. The ANSI C
+ * "prototype" for these macros are:
*
- * static void CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- * Tcl_Interp *interp);
+ * static void BODY(Tcl_Token *tokenPtr, int word);
*/
-#define CompileBody(envPtr, tokenPtr, interp) \
- TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
- (envPtr))
+#define BODY(tokenPtr, word) \
+ SetLineInformation((word)); \
+ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \
+ envPtr)
/*
* Convenience macro for use when compiling tokens to be pushed. The ANSI C
@@ -1516,13 +1516,10 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
#define CompileWord(envPtr, tokenPtr, interp, word) \
if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
- TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
- (tokenPtr)[1].size), (envPtr)); \
+ PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \
} else { \
- envPtr->line = mapPtr->loc[eclIndex].line[word]; \
- envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \
- TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
- (envPtr)); \
+ SetLineInformation((word)); \
+ CompileTokens((envPtr), (tokenPtr), (interp)); \
}
/*
@@ -1543,9 +1540,8 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
#define PushVarNameWord(i,v,e,f,l,sc,word) \
- TclPushVarName(i,v,e,f,l,sc, \
- mapPtr->loc[eclIndex].line[(word)], \
- mapPtr->loc[eclIndex].next[(word)])
+ SetLineInformation(word); \
+ TclPushVarName(i,v,e,f,l,sc)
/*
* Often want to issue one of two versions of an instruction based on whether
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 0bb7cb6..680ab45d 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1527,6 +1527,14 @@ TclMakeEnsemble(
cmdName = nameParts[nameCount - 1];
}
}
+
+ /*
+ * Switch on compilation always for core ensembles now that we can do
+ * nice bytecode things with them. Do it now. Waiting until later will
+ * just cause pointless epoch bumps.
+ */
+
+ ensembleFlags |= ENSEMBLE_COMPILE;
ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags);
/*
@@ -1578,14 +1586,6 @@ TclMakeEnsemble(
}
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
-
- /*
- * Switch on compilation always for core ensembles now that we can do
- * nice bytecode things with them.
- */
-
- Tcl_SetEnsembleFlags(interp, ensemble,
- ensembleFlags | ENSEMBLE_COMPILE);
}
Tcl_DStringFree(&buf);
diff --git a/tests/info.test b/tests/info.test
index afdaaee..3057dd2 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2371,6 +2371,31 @@ test info-33.33 {{*}, literal, simple, bytecompiled} -body {
} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ append x {*}{
+ } [return [info frame 0]]
+}
+test info-33.34 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+ append {*}{
+ } x([return [info frame 0]]) {*}{
+ } a
+}
+test info-33.35 {{*}, literal, simple, bytecompiled} -body {
+ reduce [foo::bar]
+} -cleanup {
+ namespace delete foo
+} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
unset -nocomplain res
# cleanup
generated by cgit v0.12 at 2024-11-05 08:56:39 (GMT)