summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c134
1 files changed, 74 insertions, 60 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0844a78..6d07189 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -280,12 +280,11 @@ const InstructionDesc const tclInstructionTable[] = {
/* Binary exponentiation operator: push (stknext ** stktop) */
/*
- * NOTE: the stack effects of expandStkTop, invokeExpanded and
- * listExpanded are wrong - but it cannot be done right at compile time,
- * the stack effect is only known at run time. The value for both
- * invokeExpanded and listExpanded are estimated better at compile time.
- * See the comments further down in this file, where INST_INVOKE_EXPANDED
- * and INST_LIST_EXPANDED are emitted.
+ * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong -
+ * but it cannot be done right at compile time, the stack effect is only
+ * known at run time. The value for invokeExpanded is estimated better at
+ * compile time. See the comments further down in this file, where
+ * INST_INVOKE_EXPANDED is emitted.
*/
{"expandStart", 1, 0, 0, {OPERAND_NONE}},
/* Start of command with {*} (expanded) arguments */
@@ -539,8 +538,6 @@ const InstructionDesc const tclInstructionTable[] = {
/* Concatenates the two lists at the top of the stack into a single
* list and pushes that resulting list onto the stack.
* Stack: ... list1 list2 => ... [lconcat list1 list2] */
- {"listExpanded", 1, 0, 0, {OPERAND_NONE}},
- /* Construct a list from the words marked by the last 'expandStart' */
{NULL, 0, 0, 0, {OPERAND_NONE}}
};
@@ -559,6 +556,8 @@ static void EnterCmdExtentData(CompileEnv *envPtr,
int cmdNumber, int numSrcBytes, int numCodeBytes);
static void EnterCmdStartData(CompileEnv *envPtr,
int cmdNumber, int srcOffset, int codeOffset);
+static Command * FindCommandFromToken(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, Tcl_Namespace *namespacePtr);
static void FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int GetCmdLocEncodingSize(CompileEnv *envPtr);
@@ -1775,6 +1774,49 @@ TclWordKnownAtCompileTime(
}
/*
+ * ---------------------------------------------------------------------
+ *
+ * FindCommandFromToken --
+ *
+ * A simple helper that looks up a command's compiler from its token.
+ *
+ * ---------------------------------------------------------------------
+ */
+
+static Command *
+FindCommandFromToken(
+ Tcl_Interp *interp,
+ Tcl_Token *tokenPtr,
+ Tcl_Namespace *namespacePtr)
+{
+ Tcl_DString ds;
+ Command *cmdPtr;
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return NULL;
+ }
+
+ /*
+ * We copy the string before trying to find the command by name. We used
+ * to modify the string in place, but this is not safe because the name
+ * resolution handlers could have side effects that rely on the unmodified
+ * string.
+ */
+
+ Tcl_DStringInit(&ds);
+ TclDStringAppendToken(&ds, &tokenPtr[1]);
+ cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds),
+ namespacePtr, /*flags*/ 0);
+ if (cmdPtr != NULL && (cmdPtr->compileProc == NULL
+ || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
+ || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
+ cmdPtr = NULL;
+ }
+ Tcl_DStringFree(&ds);
+ return cmdPtr;
+}
+
+/*
*----------------------------------------------------------------------
*
* TclCompileScript --
@@ -1816,7 +1858,6 @@ TclCompileScript(
Command *cmdPtr;
Tcl_Token *tokenPtr;
int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
- Tcl_DString ds;
/* TIP #280 */
ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
int *wlines, wlineat, cmdLine, *clNext;
@@ -1826,8 +1867,6 @@ TclCompileScript(
Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
}
- Tcl_DStringInit(&ds);
-
if (numBytes < 0) {
numBytes = strlen(script);
}
@@ -1877,15 +1916,9 @@ TclCompileScript(
parsePtr->commandStart - envPtr->source);
if (parsePtr->numWords > 0) {
- int expand = 0; /* Set if there are dynamic expansions to
+ int expand = 0; /* Set to the relevant expansion instruction
+ * if there are dynamic expansions to
* handle */
- int expandIgnoredWords = 0;
- /* The number of *apparent* words that we are
- * generating code from directly during
- * expansion processing. For [list {*}blah]
- * expansion, we set this to one because we
- * ignore the first word and generate code
- * directly. */
/*
* If not the first command, pop the previous command's result
@@ -1943,6 +1976,22 @@ TclCompileScript(
}
}
+ /*
+ * If expansion was requested, check if the command declares that
+ * it knows how to compile it. Note that if expansion is requested
+ * for the first word, this check will fail as the token type will
+ * inhibit it. (That check is done inside FindCommandFromToken.)
+ * This is as it should be.
+ */
+
+ if (expand) {
+ cmdPtr = FindCommandFromToken(interp, parsePtr->tokenPtr,
+ (Tcl_Namespace *) cmdNsPtr);
+ if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
+ expand = 0;
+ }
+ }
+
envPtr->numCommands++;
currCmdIndex = envPtr->numCommands - 1;
lastTopLevelCmdIndex = currCmdIndex;
@@ -1991,7 +2040,7 @@ TclCompileScript(
TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
- if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
+ if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
TclEmitInstInt4(INST_EXPAND_STKTOP,
envPtr->currStackDepth, envPtr);
}
@@ -2006,24 +2055,10 @@ TclCompileScript(
*/
if ((wordIdx == 0) && !expand) {
- /*
- * We copy the string before trying to find the command by
- * name. We used to modify the string in place, but this
- * is not safe because the name resolution handlers could
- * have side effects that rely on the unmodified string.
- */
-
- TclDStringClear(&ds);
- TclDStringAppendToken(&ds, &tokenPtr[1]);
-
- cmdPtr = (Command *) Tcl_FindCommand(interp,
- Tcl_DStringValue(&ds),
- (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+ cmdPtr = FindCommandFromToken(interp, tokenPtr,
+ (Tcl_Namespace *) cmdNsPtr);
if ((cmdPtr != NULL)
- && (cmdPtr->compileProc != NULL)
- && !(cmdPtr->nsPtr->flags&NS_SUPPRESS_COMPILATION)
- && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
&& !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
int code, savedNumCmds = envPtr->numCommands;
unsigned savedCodeNext =
@@ -2148,26 +2183,6 @@ TclCompileScript(
TclFetchLiteral(envPtr, objIndex), cmdPtr);
}
} else {
- if (wordIdx == 0 && expand) {
- TclDStringClear(&ds);
- TclDStringAppendToken(&ds, &tokenPtr[1]);
- cmdPtr = (Command *) Tcl_FindCommand(interp,
- Tcl_DStringValue(&ds),
- (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
- if ((cmdPtr != NULL) &&
- (cmdPtr->compileProc == TclCompileListCmd)) {
- /*
- * Special case! [list] command can be expanded
- * directly provided the first word is not the
- * expanded one.
- */
-
- expand = INST_LIST_EXPANDED;
- expandIgnoredWords = 1;
- continue;
- }
- }
-
/*
* Simple argument word of a command. We reach this if and
* only if the command word was not compiled for whatever
@@ -2211,12 +2226,12 @@ TclCompileScript(
* is being prepared and run, INST_EXPAND_STKTOP is not
* stack-neutral in general.
*
- * The opcodes that may be issued here (both assumed to be
- * non-zero) are INST_INVOKE_EXPANDED and INST_LIST_EXPANDED.
+ * The opcode that may be issued here (assumed to be non-zero)
+ * is INST_INVOKE_EXPANDED.
*/
TclEmitOpcode(expand, envPtr);
- TclAdjustStackDepth(1 + expandIgnoredWords - wordIdx, envPtr);
+ TclAdjustStackDepth(1 - wordIdx, envPtr);
} else if (wordIdx > 0) {
/*
* Save PC -> command map for the TclArgumentBC* functions.
@@ -2292,7 +2307,6 @@ TclCompileScript(
envPtr->numSrcBytes = p - script;
TclStackFree(interp, parsePtr);
- Tcl_DStringFree(&ds);
}
/*
generated by cgit v0.12 at 2024-11-12 20:55:47 (GMT)