From 6d2beac7e80048bcc4d4d46c68ec4f55d90986b3 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 17 Jul 2013 13:57:23 +0000
Subject: Factor out the call to a compileProc into one place used by both
 ensemble subcommand compiles and toplevel command compiles in
 TclCompileScript.

---
 generic/tclCompile.c  | 48 ++++++++++++++----------------------------------
 generic/tclCompile.h  |  3 +++
 generic/tclEnsemble.c | 28 +++++++++++++++++++++-------
 3 files changed, 38 insertions(+), 41 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6ac5fb9..763e8f1 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1887,10 +1887,7 @@ CompileCmdCompileProc(
     Command *cmdPtr,
     CompileEnv *envPtr)
 {
-    int savedNumCmds = envPtr->numCommands;
-    int startStackDepth = envPtr->currStackDepth;
-    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
-    int incrOffset = -1;
+    int unwind = 0, incrOffset = -1;
     DefineLineInformation;
 
     /*
@@ -1908,6 +1905,7 @@ CompileCmdCompileProc(
 
     switch (envPtr->atCmdStart) {
     case 0:
+	unwind = tclInstructionTable[INST_START_CMD].numBytes;
 	TclEmitInstInt4(INST_START_CMD, 0, envPtr);
 	incrOffset = envPtr->codeNext - envPtr->codeStart;
 	TclEmitInt4(0, envPtr);
@@ -1922,25 +1920,7 @@ CompileCmdCompileProc(
 	;
     }
 
-    if (TCL_OK == cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr)) {
-
-#ifdef TCL_COMPILE_DEBUG
-	/*
-	 * Confirm that the command compiler generated a
-	 * single value on the stack as its result. This
-	 * is only done in debugging mode, as it *should*
-	 * be correct and normal users have no reasonable
-	 * way to fix it anyway.
-	 */
-
-	int diff = envPtr->currStackDepth - startStackDepth;
-
-	if (diff != 1) {
-	    Tcl_Panic("bad stack adjustment when compiling"
-		    " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
-		    parsePtr->tokenPtr->start, diff);
-	}
-#endif
+    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
 	if (incrOffset >= 0) {
 	    /*
 	     * We successfully compiled a command.  Increment the number
@@ -1950,21 +1930,15 @@ CompileCmdCompileProc(
 	    unsigned char *startPtr = incrPtr - 5;
 
 	    TclIncrUInt4AtPtr(incrPtr, 1);
-	    TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
+	    if (unwind) {
+		/* We started the INST_START_CMD.  Record the code length. */
+		TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
+	    }
 	}
 	return TCL_OK;
     }
 
-    /*
-     * Restore numCommands, codeNext, and currStackDepth  to their
-     * correct values, removing any commands compiled before the
-     * failure to produce bytecode got reported.
-     * [Bugs 705406, 735055, 3614102]
-     */
-
-    envPtr->numCommands = savedNumCmds;
-    envPtr->codeNext = envPtr->codeStart + startCodeOffset;
-    envPtr->currStackDepth = startStackDepth;
+    envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */
 
     /*
      * Throw out any line information generated by the failed
@@ -1976,6 +1950,12 @@ CompileCmdCompileProc(
 	mapPtr->loc[mapPtr->nuloc].line = NULL;
     }
 
+    /*
+     * Reset the index of next command.
+     * Toss out any from failed nested partial compiles.
+     */
+    envPtr->numCommands = mapPtr->nuloc;
+
     return TCL_ERROR;
 }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index f70f8f7..56315db 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -984,6 +984,9 @@ MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
  *----------------------------------------------------------------
  */
 
+MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
+			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
 MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
 			    ExceptionAux *auxPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index e4f96c0..bab63c9 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -35,9 +35,6 @@ static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
 static void		FreeEnsembleCmdRep(Tcl_Obj *objPtr);
 static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
 static void		StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
-static int		CompileToCompiledCommand(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
-			    CompileEnv *envPtr);
 static void		CompileToInvokedCommand(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Tcl_Obj *replacements,
 			    Command *cmdPtr, CompileEnv *envPtr);
@@ -2994,8 +2991,8 @@ TclCompileEnsemble(
      */
 
     invokeAnyway = 1;
-    if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr,
-	    envPtr) == TCL_OK) {
+    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr,
+	    envPtr)) {
 	ourResult = TCL_OK;
 	goto cleanup;
     }
@@ -3029,8 +3026,8 @@ TclCompileEnsemble(
     return ourResult;
 }
 
-static int
-CompileToCompiledCommand(
+int
+TclAttemptCompileProc(
     Tcl_Interp *interp,
     Tcl_Parse *parsePtr,
     int depth,
@@ -3092,6 +3089,23 @@ CompileToCompiledCommand(
     if (result != TCL_OK) {
 	envPtr->currStackDepth = savedStackDepth;
 	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+#ifdef TCL_COMPILE_DEBUG
+    } else {
+	/*
+	 * Confirm that the command compiler generated a single value on
+	 * the stack as its result. This is only done in debugging mode,
+	 * as it *should* be correct and normal users have no reasonable
+	 * way to fix it anyway.
+	 */
+
+	int diff = envPtr->currStackDepth - savedStackDepth;
+
+	if (diff != 1) {
+	    Tcl_Panic("bad stack adjustment when compiling"
+		    " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
+		    parsePtr->tokenPtr->start, diff);
+	}
+#endif
     }
 
     return result;
-- 
cgit v0.12