summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c172
1 files changed, 102 insertions, 70 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 970c1ef..b6b270b 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.172 2009/08/25 23:20:36 das Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.173 2009/09/04 17:33:11 dgp Exp $
*/
#include "tclInt.h"
@@ -399,6 +399,13 @@ InstructionDesc const tclInstructionTable[] = {
* stknext */
{"existStk", 1, 0, 0, {OPERAND_NONE}},
/* Test if general variable exists; unparsed variable name is stktop*/
+ {"nop", 1, 0, 0, {OPERAND_NONE}},
+ /* Do nothing */
+ {"returnCodeBranch", 1, -1, 0, {OPERAND_NONE}},
+ /* Jump to next instruction based on the return code on top of stack
+ * ERROR: +1; RETURN: +3; BREAK: +5; CONTINUE: +7;
+ * Other non-OK: +9
+ */
{0}
};
@@ -1277,6 +1284,17 @@ TclCompileScript(
TclCompileSyntaxError(interp, envPtr);
break;
}
+
+ /*
+ * TIP #280: We have to count newlines before the command even
+ * in the degenerate case when the command has no words. (See
+ * test info-30.33). So make that counting here, and not in
+ * the (numWords > 0) branch below.
+ */
+ TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
+ TclAdvanceContinuations(&cmdLine, &clNext,
+ parsePtr->commandStart - envPtr->source);
+
if (parsePtr->numWords > 0) {
int expand = 0; /* Set if there are dynamic expansions to
* handle */
@@ -1361,9 +1379,6 @@ TclCompileScript(
* 'wlines'.
*/
- TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
- TclAdvanceContinuations (&cmdLine, &clNext,
- parsePtr->commandStart - envPtr->source);
EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
parsePtr->tokenPtr, parsePtr->commandStart,
parsePtr->commandSize, parsePtr->numWords, cmdLine,
@@ -1633,6 +1648,14 @@ TclCompileScript(
} while (bytesLeft > 0);
/*
+ * TIP #280: Bring the line counts in the CompEnv up to date.
+ * See tests info-30.33,34,35 .
+ */
+
+ envPtr->line = cmdLine;
+ envPtr->clNext = clNext;
+
+ /*
* If the source script yielded no instructions (e.g., if it was empty),
* push an empty string as the command's result.
*
@@ -1674,6 +1697,77 @@ TclCompileScript(
*/
void
+TclCompileVarSubst(
+ Tcl_Interp *interp,
+ Tcl_Token *tokenPtr,
+ CompileEnv *envPtr)
+{
+ const char *p, *name = tokenPtr[1].start;
+ int nameBytes = tokenPtr[1].size;
+ int i, localVar, localVarName = 1;
+
+ /*
+ * Determine how the variable name should be handled: if it
+ * contains any namespace qualifiers it is not a local variable
+ * (localVarName=-1); if it looks like an array element and the
+ * token has a single component, it should not be created here
+ * [Bug 569438] (localVarName=0); otherwise, the local variable
+ * can safely be created (localVarName=1).
+ */
+
+ for (i = 0, p = name; i < nameBytes; i++, p++) {
+ if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
+ localVarName = -1;
+ break;
+ } else if ((*p == '(')
+ && (tokenPtr->numComponents == 1)
+ && (*(name + nameBytes - 1) == ')')) {
+ localVarName = 0;
+ break;
+ }
+ }
+
+ /*
+ * Either push the variable's name, or find its index in the array
+ * of local variables in a procedure frame.
+ */
+
+ localVar = -1;
+ if (localVarName != -1) {
+ localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
+ }
+ if (localVar < 0) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes), envPtr);
+ }
+
+ /*
+ * Emit instructions to load the variable.
+ */
+
+ TclAdvanceLines(&(envPtr->line), tokenPtr[1].start,
+ tokenPtr[1].start + tokenPtr[1].size);
+
+ if (tokenPtr->numComponents == 1) {
+ if (localVar < 0) {
+ TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+ } else if (localVar <= 255) {
+ TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
+ }
+ } else {
+ TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr);
+ if (localVar < 0) {
+ TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+ } else if (localVar <= 255) {
+ TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
+ }
+ }
+}
+
+void
TclCompileTokens(
Tcl_Interp *interp, /* Used for error and status reporting. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
@@ -1685,9 +1779,7 @@ TclCompileTokens(
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[TCL_UTF_MAX];
- const char *name, *p;
- int numObjsToConcat, nameBytes, localVarName, localVar;
- int length, i;
+ int i, numObjsToConcat, length;
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
@@ -1731,6 +1823,8 @@ TclCompileTokens(
switch (tokenPtr->type) {
case TCL_TOKEN_TEXT:
Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
+ TclAdvanceLines(&(envPtr->line), tokenPtr->start,
+ tokenPtr->start + tokenPtr->size);
break;
case TCL_TOKEN_BS:
@@ -1810,69 +1904,7 @@ TclCompileTokens(
Tcl_DStringFree(&textBuffer);
}
- /*
- * Determine how the variable name should be handled: if it
- * contains any namespace qualifiers it is not a local variable
- * (localVarName=-1); if it looks like an array element and the
- * token has a single component, it should not be created here
- * [Bug 569438] (localVarName=0); otherwise, the local variable
- * can safely be created (localVarName=1).
- */
-
- name = tokenPtr[1].start;
- nameBytes = tokenPtr[1].size;
-
- localVarName = 1;
- for (i = 0, p = name; i < nameBytes; i++, p++) {
- if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
- localVarName = -1;
- break;
- } else if ((*p == '(')
- && (tokenPtr->numComponents == 1)
- && (*(name + nameBytes - 1) == ')')) {
- localVarName = 0;
- break;
- }
- }
-
- /*
- * Either push the variable's name, or find its index in the array
- * of local variables in a procedure frame.
- */
-
- localVar = -1;
- if (localVarName != -1) {
- localVar = TclFindCompiledLocal(name, nameBytes, localVarName,
- envPtr);
- }
- if (localVar < 0) {
- TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
- envPtr);
- }
-
- /*
- * Emit instructions to load the variable.
- */
-
- if (tokenPtr->numComponents == 1) {
- if (localVar < 0) {
- TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
- } else if (localVar <= 255) {
- TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
- } else {
- TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
- }
- } else {
- TclCompileTokens(interp, tokenPtr+2,
- tokenPtr->numComponents-1, envPtr);
- if (localVar < 0) {
- TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
- } else if (localVar <= 255) {
- TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
- } else {
- TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
- }
- }
+ TclCompileVarSubst(interp, tokenPtr, envPtr);
numObjsToConcat++;
count -= tokenPtr->numComponents;
tokenPtr += tokenPtr->numComponents;
generated by cgit v0.12 at 2024-07-19 17:28:38 (GMT)