summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-03-13 02:48:51 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-03-13 02:48:51 (GMT)
commitece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69 (patch)
treecd5a481ad409b13cc663aa33a74415c55f0e488d /generic/tclCompile.c
parent40ae076645b787b5f61ab2f9496b6c49ddb7580d (diff)
downloadtcl-ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69.zip
tcl-ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69.tar.gz
tcl-ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69.tar.bz2
* generic/tclBasic.c (Tcl_EvalTokensStandard):
* generic/tclCmdMZ.c (Tcl_SubstObj): * generic/tclCompCmds.c (TclCompileSwitchCmd): * generic/tclCompExpr.c (CompileSubExpr): * generic/tclCompile.c (TclSetByteCodeFromAny,TclCompileScript, TclCompileTokens,TclCompileCmdWord): * generic/tclCompile.h (TclCompileScript): * generic/tclExecute.c (TclCompEvalObj): * generic/tclInt.h (Interp,TCL_BRACKET_TERM,TclSubstTokens): * generic/tclParse.c (ParseTokens,Tcl_SubstObj,TclSubstTokens): * tests/subst.test (2.4, 8.7, 8.8, 11.4, 11.5): Substantial refactoring of Tcl_SubstObj to make use of the same parsing and substitution procedures as normal script evaluation. Tcl_SubstObj() moved to tclParse.c. New routine TclSubstTokens() created in tclParse.c which implements all substantial functioning of Tcl_EvalTokensStandard(). TclCompileScript() loses its "nested" argument, the Tcl_Interp struct loses its termOffset field and the TCL_BRACKET_TERM flag in the evalFlags field, all of which were only used (indirectly) by Tcl_SubstObj(). Tests subst-8.7,8.8,11.4,11.5 modified to accomodate the only behavior change: reporting of parse errors now takes precedence over [return] and [continue] exceptions. All other behavior should
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c113
1 files changed, 15 insertions, 98 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 704178b..c98348f 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.43 2003/02/19 14:33:39 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.44 2003/03/13 02:48:52 dgp Exp $
*/
#include "tclInt.h"
@@ -348,14 +348,16 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
CompileHookProc *hookProc; /* Procedure to invoke after compilation. */
ClientData clientData; /* Hook procedure private data. */
{
+#ifdef TCL_COMPILE_DEBUG
Interp *iPtr = (Interp *) interp;
+#endif /*TCL_COMPILE_DEBUG*/
CompileEnv compEnv; /* Compilation environment structure
* allocated in frame. */
LiteralTable *localTablePtr = &(compEnv.localLitTable);
register AuxData *auxDataPtr;
LiteralEntry *entryPtr;
register int i;
- int length, nested, result;
+ int length, result;
char *string;
#ifdef TCL_COMPILE_DEBUG
@@ -368,21 +370,15 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
}
#endif
- if (iPtr->evalFlags & TCL_BRACKET_TERM) {
- nested = 1;
- } else {
- nested = 0;
- }
string = Tcl_GetStringFromObj(objPtr, &length);
TclInitCompileEnv(interp, &compEnv, string, length);
- result = TclCompileScript(interp, string, length, nested, &compEnv);
+ result = TclCompileScript(interp, string, length, &compEnv);
if (result == TCL_OK) {
/*
* Successful compilation. Add a "done" instruction at the end.
*/
- compEnv.numSrcBytes = iPtr->termOffset;
TclEmitOpcode(INST_DONE, &compEnv);
/*
@@ -786,10 +782,6 @@ TclFreeCompileEnv(envPtr)
* on failure. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * interp->termOffset is set to the offset of the character in the
- * script just after the last one successfully processed; this will be
- * the offset of the ']' if (flags & TCL_BRACKET_TERM).
- *
* Side effects:
* Adds instructions to envPtr to evaluate the script at runtime.
*
@@ -797,7 +789,7 @@ TclFreeCompileEnv(envPtr)
*/
int
-TclCompileScript(interp, script, numBytes, nested, envPtr)
+TclCompileScript(interp, script, numBytes, envPtr)
Tcl_Interp *interp; /* Used for error and status reporting.
* Also serves as context for finding and
* compiling commands. May not be NULL. */
@@ -805,10 +797,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
int numBytes; /* Number of bytes in script. If < 0, the
* script consists of all bytes up to the
* first null character. */
- int nested; /* Non-zero means this is a nested command:
- * close bracket ']' should be considered a
- * command terminator. If zero, close
- * bracket has no special meaning. */
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Interp *iPtr = (Interp *) interp;
@@ -845,55 +833,11 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
bytesLeft = numBytes;
gotParse = 0;
do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) {
code = TCL_ERROR;
goto error;
}
gotParse = 1;
- if (nested) {
- /*
- * This is an unusual situation where the caller has passed us
- * a non-zero value for "nested". How unusual? Well, this
- * procedure, TclCompileScript, is internal to Tcl, so all
- * callers should be within Tcl itself. All but one of those
- * callers explicitly pass in (nested = 0). The exceptional
- * caller is TclSetByteCodeFromAny, which will pass in
- * (nested = 1) if and only if the flag TCL_BRACKET_TERM
- * is set in the evalFlags field of interp.
- *
- * It appears that the TCL_BRACKET_TERM flag is only ever set
- * by Tcl_SubstObj, and it immediately calls Tcl_EvalEx
- * which clears the flag before passing the interp along.
- * So, I don't think this procedure, TclCompileScript, is
- * **ever** called with (nested != 0).
- * (The testsuite indeed doesn't exercise this code. MS)
- *
- * This means that the branches in this procedure that are
- * only active when (nested != 0) are probably never exercised.
- * This means that any bugs in them go unnoticed, and any bug
- * fixes in them have a semi-theoretical nature.
- *
- * All that said, the spec for this procedure says it should
- * handle the (nested != 0) case, so here's an attempt to fix
- * bugs (Tcl Bug 681841) in that case. Just in case some
- * callers eventually come along and expect it to work...
- */
-
- if (parse.term == (script + numBytes)) {
- /*
- * The (nested != 0) case is meant to indicate that the
- * caller found an open bracket ([) and asked us to
- * parse and compile Tcl commands up to the matching
- * close bracket (]). We have to detect and handle
- * the case where the close bracket is missing.
- */
-
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("missing close-bracket", -1));
- code = TCL_ERROR;
- goto error;
- }
- }
if (parse.numWords > 0) {
/*
* If not the first command, pop the previous command's result
@@ -903,11 +847,8 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
if (!isFirstCmd) {
TclEmitOpcode(INST_POP, envPtr);
- if (!nested) {
- envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - startCodeOffset;
- }
+ envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart) - startCodeOffset;
}
/*
@@ -931,8 +872,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* If tracing, print a line for each top level command compiled.
*/
- if ((tclTraceCompile >= 1)
- && !nested && (envPtr->procPtr == NULL)) {
+ if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
fprintf(stdout, " Compiling: ");
TclPrintSource(stdout, parse.commandStart,
TclMin(commandLength, 55));
@@ -946,9 +886,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
envPtr->numCommands++;
currCmdIndex = (envPtr->numCommands - 1);
- if (!nested) {
- lastTopLevelCmdIndex = currCmdIndex;
- }
+ lastTopLevelCmdIndex = currCmdIndex;
startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
EnterCmdStartData(envPtr, currCmdIndex,
(parse.commandStart - envPtr->source), startCodeOffset);
@@ -1071,16 +1009,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
p = next;
Tcl_FreeParse(&parse);
gotParse = 0;
- if (nested && (*parse.term == ']')) {
- /*
- * We get here in the special case where TCL_BRACKET_TERM was
- * set in the interpreter and the latest parsed command was
- * terminated by the matching close-bracket we were looking for.
- * Stop compilation.
- */
-
- break;
- }
} while (bytesLeft > 0);
/*
@@ -1093,17 +1021,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
envPtr);
}
- if (nested) {
- /*
- * When (nested != 0) back up 1 character to have
- * iPtr->termOffset indicate the offset to the matching
- * close-bracket.
- */
-
- iPtr->termOffset = (p - 1) - script;
- } else {
- iPtr->termOffset = (p - script);
- }
+ envPtr->numSrcBytes = (p - script);
Tcl_DStringFree(&ds);
return TCL_OK;
@@ -1132,7 +1050,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
if (gotParse) {
Tcl_FreeParse(&parse);
}
- iPtr->termOffset = (p - script);
+ envPtr->numSrcBytes = (p - script);
Tcl_DStringFree(&ds);
return code;
}
@@ -1207,7 +1125,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
}
code = TclCompileScript(interp, tokenPtr->start+1,
- tokenPtr->size-2, /*nested*/ 0, envPtr);
+ tokenPtr->size-2, envPtr);
if (code != TCL_OK) {
goto error;
}
@@ -1396,8 +1314,7 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
*/
if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
- code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
- /*nested*/ 0, envPtr);
+ code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
return code;
}