summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-06-27 20:10:41 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-06-27 20:10:41 (GMT)
commit7924f4a694c43ca8fe4260041d090795b0791a96 (patch)
tree82699e23c1e4be781989104cb532b5d991bf2a8e
parent59dda187056234f42857543990b47682bb686732 (diff)
downloadtcl-7924f4a694c43ca8fe4260041d090795b0791a96.zip
tcl-7924f4a694c43ca8fe4260041d090795b0791a96.tar.gz
tcl-7924f4a694c43ca8fe4260041d090795b0791a96.tar.bz2
Stop the compileProc routines leaving behind error messages in interp.
(Nicer way to solve [Bug 20a81392ec].) Make simplifications in TclCompileScript() make possible by the new structure. Still a work in progress.
-rw-r--r--generic/tclAssembly.c32
-rw-r--r--generic/tclCompCmds.c5
-rw-r--r--generic/tclCompCmdsGR.c1
-rw-r--r--generic/tclCompile.c109
4 files changed, 83 insertions, 64 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 62641e6..1a061f0 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -930,6 +930,12 @@ TclCompileAssembleCmd(
{
Tcl_Token *tokenPtr; /* Token in the input script */
+#if 0
+ int numCommands = envPtr->numCommands;
+ int offset = envPtr->codeNext - envPtr->codeStart;
+ int depth = envPtr->currStackDepth;
+#endif
+
/*
* Make sure that the command has a single arg that is a simple word.
*/
@@ -943,10 +949,32 @@ TclCompileAssembleCmd(
}
/*
- * Compile the code and return any error from the compilation.
+ * Compile the code and convert any error from the compilation into
+ * bytecode reporting the error;
*/
- return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
+ if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
+ tokenPtr[1].size, TCL_EVAL_DIRECT)) {
+
+ /*
+ * TODO: Finish working out how to capture syntax errors captured
+ * during compile and make them bytecode reporting the error.
+ */
+#if 0
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"%.*s\" body, line %d)",
+ parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
+ Tcl_GetErrorLine(interp)));
+ envPtr->numCommands = numCommands;
+ envPtr->codeNext = envPtr->codeStart + offset;
+ envPtr->currStackDepth = depth;
+ TclCompileSyntaxError(interp, envPtr);
+#else
+ Tcl_ResetResult(interp);
+ return TCL_ERROR;
+#endif
+ }
+ return TCL_OK;
}
/*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index fddf152..18295eb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2544,7 +2544,7 @@ CompileEachloopCmd(
Tcl_DStringInit(&varList);
TclDStringAppendToken(&varList, &tokenPtr[1]);
- code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
+ code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
if (code != TCL_OK) {
@@ -2988,7 +2988,8 @@ TclCompileFormatCmd(
ckfree(objv);
Tcl_DecrRefCount(formatObj);
if (tmpObj == NULL) {
- return TCL_ERROR;
+ TclCompileSyntaxError(interp, envPtr);
+ return TCL_OK;
}
/*
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index f7c15e6..4de8cf2 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2534,6 +2534,7 @@ TclCompileSyntaxError(
TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
+ Tcl_ResetResult(interp);
}
/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 416078c..5a8524c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1738,24 +1738,25 @@ FindCompiledCommandFromToken(
*/
#if 1
-static void
+static int
CompileCommandTokens(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
- CompileEnv *envPtr,
- int *lastPopPtr)
+ CompileEnv *envPtr)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *cmdObj;
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
+ Tcl_Obj *cmdObj = Tcl_NewObj();
Command *cmdPtr = NULL;
int wordIdx, cmdKnown, expand = 0, numWords = parsePtr->numWords;
- ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
int *wlines, wlineat;
+ int cmdLine = envPtr->line;
+ int *clNext = envPtr->clNext;
+ int cmdIdx = envPtr->numCommands;
+ int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
- if (numWords == 0) {
- return;
- }
+ assert (numWords > 0);
for (wordIdx = 0; wordIdx < numWords;
wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
@@ -1765,7 +1766,6 @@ CompileCommandTokens(
}
}
- cmdObj = Tcl_NewObj();
Tcl_IncrRefCount(cmdObj);
tokenPtr = parsePtr->tokenPtr;
cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);
@@ -1787,15 +1787,9 @@ CompileCommandTokens(
}
/* Pre-Compile */
-int lastTopLevelCmdIndex, currCmdIndex, startCodeOffset;
-
-int cmdLine = envPtr->line;
-int *clNext = envPtr->clNext;
- lastTopLevelCmdIndex = currCmdIndex = envPtr->numCommands;
envPtr->numCommands++;
- startCodeOffset = envPtr->codeNext - envPtr->codeStart;
- EnterCmdStartData(envPtr, currCmdIndex,
+ EnterCmdStartData(envPtr, cmdIdx,
parsePtr->commandStart - envPtr->source, startCodeOffset);
if (expand && !cmdPtr) {
@@ -2016,11 +2010,9 @@ int *clNext = envPtr->clNext;
finishCommand:
TclEmitOpcode(INST_POP, envPtr);
- EnterCmdExtentData(envPtr, currCmdIndex,
+ EnterCmdExtentData(envPtr, cmdIdx,
parsePtr->term - parsePtr->commandStart,
(envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
- *lastPopPtr = currCmdIndex;
-
if (cmdKnown) {
Tcl_DecrRefCount(cmdObj);
@@ -2037,6 +2029,8 @@ finishCommand:
ckfree(eclPtr->loc[wlineat].next);
eclPtr->loc[wlineat].line = wlines;
eclPtr->loc[wlineat].next = NULL;
+
+ return cmdIdx;
}
#endif
@@ -2052,10 +2046,8 @@ TclCompileScript(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
#if 1
- unsigned char *entryCodeNext = envPtr->codeNext;
- const char *p;
- int cmdLine, *clNext;
- int lastPop = -1;
+ int lastCmdIdx = -1;
+ const char *p = script;
if (envPtr->iPtr == NULL) {
Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
@@ -2066,40 +2058,34 @@ TclCompileScript(
* from the script.
*/
- p = script;
- cmdLine = envPtr->line;
- clNext = envPtr->clNext;
+ /* TODO: Figure out when/why we need this */
+#if 0
+if (Tcl_GetStringResult(interp)[0] != '\0') {
+ fprintf(stdout, "INIT: '%s'\n", Tcl_GetStringResult(interp));
+ fflush(stdout);
+}
+#endif
+ Tcl_ResetResult(interp);
while (numBytes > 0) {
Tcl_Parse parse;
const char *next;
- /* TODO: can we relocate this to happen less frequently? */
- Tcl_ResetResult(interp);
if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, &parse)) {
/*
* Compile bytecodes to report the parse error at runtime.
*/
Tcl_LogCommandInfo(interp, script, parse.commandStart,
+/* TODO: Make this more sensible, f. ex. [eval {foo \$x(}] */
/* Drop the command terminator (";","]") if appropriate */
(parse.term ==
parse.commandStart + parse.commandSize - 1)?
parse.commandSize - 1 : parse.commandSize);
TclCompileSyntaxError(interp, envPtr);
Tcl_FreeParse(&parse);
- lastPop = -1;
- break;
+ return;
}
- /*
- * TIP #280: Count newlines before the command start.
- * (See test info-30.33).
- */
-
- TclAdvanceLines(&cmdLine, p, parse.commandStart);
- TclAdvanceContinuations(&cmdLine, &clNext,
- parse.commandStart - envPtr->source);
-
#ifdef TCL_COMPILE_DEBUG
/*
* If tracing, print a line for each top level command compiled.
@@ -2114,48 +2100,51 @@ TclCompileScript(
}
#endif
- envPtr->line = cmdLine;
- envPtr->clNext = clNext;
- CompileCommandTokens(interp, &parse, envPtr, &lastPop);
- cmdLine = envPtr->line;
- clNext = envPtr->clNext;
+ /*
+ * TIP #280: Count newlines before the command start.
+ * (See test info-30.33).
+ */
+
+ TclAdvanceLines(&envPtr->line, p, parse.commandStart);
+ TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+ parse.commandStart - envPtr->source);
/*
- * Advance to the next command in the script.
+ * Advance parser to the next command in the script.
*/
next = parse.commandStart + parse.commandSize;
numBytes -= next - p;
p = next;
+ if (parse.numWords == 0) {
+ /* TODO: Document justification */
+ continue;
+ }
+
+ lastCmdIdx = CompileCommandTokens(interp, &parse, envPtr);
+
/*
* TIP #280: Track lines in the just compiled command.
*/
- TclAdvanceLines(&cmdLine, parse.commandStart, p);
- TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
+ TclAdvanceLines(&envPtr->line, parse.commandStart, p);
+ TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
+ p - envPtr->source);
Tcl_FreeParse(&parse);
}
/*
- * 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.
*/
- if (envPtr->codeNext == entryCodeNext) {
- PushStringLiteral(envPtr, "");
- } else if (lastPop >= 0) {
- envPtr->cmdMapPtr[lastPop].numCodeBytes--;
+ if (lastCmdIdx >= 0) {
+ envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
envPtr->codeNext--;
- TclAdjustStackDepth(1, envPtr);
+ envPtr->currStackDepth++;
+ } else {
+ PushStringLiteral(envPtr, "");
}
#else
int lastTopLevelCmdIndex = -1;