code reorganisation and factorisation.

3 files changed, 105 insertions, 99 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 18acb81..13b15e8 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.39 2001/11/20 19:45:19 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.40 2001/11/20 21:17:38 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2723,10 +2723,74 @@ Tcl_ListMathFuncs(interp, pattern)
 /*
  *----------------------------------------------------------------------
  *
+ * TclInterpReady --
+ *
+ *	Check if an interpreter is ready to eval commands or scripts, 
+ *      i.e., if it was not deleted and if the nesting level is not 
+ *      too high.
+ *
+ * Results:
+ *	The return value is TCL_OK if it the interpreter is ready, 
+ *      TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *	The interpreters object and string results are cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int 
+TclInterpReady(interp)
+    Tcl_Interp *interp;
+{
+    register Interp *iPtr = (Interp *) interp;
+
+    /*
+     * Reset both the interpreter's string and object results and clear 
+     * out any previous error information. 
+     */
+
+    Tcl_ResetResult(interp);
+
+    /*
+     * If the interpreter has been deleted, return an error.
+     */
+    
+    if (iPtr->flags & DELETED) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "attempt to call eval in deleted interpreter", -1);
+	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+	        "attempt to call eval in deleted interpreter",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
+     * it's probably because of an infinite loop somewhere.
+     */
+
+    if (((iPtr->numLevels) >= iPtr->maxNestingDepth) 
+	    || (TclpCheckStackSpace() == 0)) {
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"too many nested calls to Tcl_Eval (infinite loop?)", -1); 
+	return TCL_ERROR;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclEvalObjvInternal --
  *
  *	This procedure evaluates a Tcl command that has already been
- *	parsed into words, with one Tcl_Obj holding each word.
+ *	parsed into words, with one Tcl_Obj holding each word. The caller
+ *      is responsible for checking that the interpreter is ready to
+ *      evaluate (by calling TclInterpReady), and also to manage the
+ *      iPtr->numLevels.
  *
  * Results:
  *	The return value is a standard Tcl completion code such as
@@ -2773,46 +2837,11 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
     CallFrame *savedVarFramePtr;	/* Saves old copy of iPtr->varFramePtr
 					 * in case TCL_EVAL_GLOBAL was set. */
 
-    Tcl_ResetResult(interp);
     if (objc == 0) {
 	return TCL_OK;
     }
 
     /*
-     * If the interpreter was deleted, return an error.
-     */
-    
-    if (iPtr->flags & DELETED) {
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"attempt to call eval in deleted interpreter", -1);
-	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
-		"attempt to call eval in deleted interpreter",
-		(char *) NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
-     * it's probably because of an infinite loop somewhere.
-     */
-
-    if (iPtr->numLevels > iPtr->maxNestingDepth) {
-	iPtr->result =  "too many nested calls to Tcl_Eval (infinite loop?)";
-	return TCL_ERROR;
-    }
-
-    /*
-     * On the Mac, we will never reach the default recursion limit before
-     * blowing the stack. So we need to do a check here.
-     */
-    
-    if (TclpCheckStackSpace() == 0) {
-	/*NOTREACHED*/
-	iPtr->result =  "too many nested calls to Tcl_Eval (infinite loop?)";
-	return TCL_ERROR;
-    }
-    
-    /*
      * Find the procedure to execute this command. If there isn't one,
      * then see if there is a command "unknown".  If so, create a new
      * word array with "unknown" as the first word and the original
@@ -2835,6 +2864,8 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
 		    "invalid command name \"", Tcl_GetString(objv[0]), "\"",
 		    (char *) NULL);
 	    code = TCL_ERROR;
+	} else if (TclInterpReady(interp) == TCL_ERROR) {
+	    code = TCL_ERROR;
 	} else {
 	    iPtr->numLevels++;
 	    code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0);
@@ -2983,9 +3014,13 @@ Tcl_EvalObjv(interp, objc, objv, flags)
      */
     switch (code) {
 	case TCL_OK:
-	    iPtr->numLevels++;
-	    code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
-	    iPtr->numLevels--;
+	    if (TclInterpReady(interp) == TCL_ERROR) {
+		code = TCL_ERROR;
+	    } else {
+		iPtr->numLevels++;
+		code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
+		iPtr->numLevels--;
+	    }
 	    if (code == TCL_ERROR && cmdLen == 0)
 		goto cmdtraced;
 	    break;
@@ -3416,9 +3451,13 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	     * Execute the command and free the objects for its words.
 	     */
 
-	    iPtr->numLevels++;    
-	    code = TclEvalObjvInternal(interp, objectsUsed, objv, p, bytesLeft, 0);
-	    iPtr->numLevels--;
+	    if (TclInterpReady(interp) == TCL_ERROR) {
+		code = TCL_ERROR;
+	    } else {
+		iPtr->numLevels++;    
+		code = TclEvalObjvInternal(interp, objectsUsed, objv, p, bytesLeft, 0);
+		iPtr->numLevels--;
+	    }
 	    if (code != TCL_OK) {
 		goto error;
 	    }
@@ -3706,64 +3745,20 @@ Tcl_EvalObjEx(interp, objPtr, flags)
     }
 
     /*
-     * Prevent the object from being deleted as a side effect of evaling it.
+     * Check that the interpreter is ready to eval the bytecode.
      */
 
+    if (TclInterpReady(interp) == TCL_ERROR) {
+	Tcl_DecrRefCount(objPtr);
+	return  TCL_ERROR;
+    } 
+
     savedVarFramePtr = iPtr->varFramePtr;
     if (flags & TCL_EVAL_GLOBAL) {
 	iPtr->varFramePtr = NULL;
     }
 
     /*
-     * Reset both the interpreter's string and object results and clear out
-     * any error information. This makes sure that we return an empty
-     * result if there are no commands in the command string.
-     */
-
-    Tcl_ResetResult(interp);
-
-    /*
-     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
-     * it's probably because of an infinite loop somewhere.
-     */
-
-    iPtr->numLevels++;
-    if (iPtr->numLevels > iPtr->maxNestingDepth) {
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"too many nested calls to Tcl_Eval (infinite loop?)", -1); 
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * On the Mac, we will never reach the default recursion limit before
-     * blowing the stack. So we need to do a check here.
-     */
-    
-    if (TclpCheckStackSpace() == 0) {
-	/*NOTREACHED*/
-    	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		"too many nested calls to Tcl_Eval (infinite loop?)", -1);
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * If the interpreter has been deleted, return an error.
-     */
-    
-    if (iPtr->flags & DELETED) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-	        "attempt to call eval in deleted interpreter", -1);
-	Tcl_SetErrorCode(interp, "CORE", "IDELETE",
-	        "attempt to call eval in deleted interpreter",
-		(char *) NULL);
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    /*
      * Get the ByteCode from the object. If it exists, make sure it hasn't
      * been invalidated by, e.g., someone redefining a command with a
      * compile procedure (this might make the compiled code wrong). If
@@ -3845,6 +3840,7 @@ Tcl_EvalObjEx(interp, objPtr, flags)
      */
 
     numSrcBytes = codePtr->numSrcBytes;
+    iPtr->numLevels++;
     if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
 	/*
 	 * Increment the code's ref count while it is being executed. If
@@ -3907,11 +3903,11 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 
     iPtr->termOffset = numSrcBytes;
     iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    iPtr->numLevels--;
 
     done:
     TclDecrRefCount(objPtr);
     iPtr->varFramePtr = savedVarFramePtr; 
-    iPtr->numLevels--;
     return result;
 }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5caa4e1..d26bdd9 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,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.h,v 1.20 2001/11/16 20:14:27 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.21 2001/11/20 21:17:39 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -718,6 +718,18 @@ typedef struct ForeachInfo {
 
 extern AuxDataType		tclForeachInfoType;
 
+
+/*
+ *----------------------------------------------------------------
+ * Procedures exported by tclBasic.c to be used within the engine.
+ *----------------------------------------------------------------
+ */
+
+EXTERN int		TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[], char *command, int length,
+			    int flags));
+EXTERN int              TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
+
 /*
  *----------------------------------------------------------------
  * Procedures shared among Tcl bytecode compilation and execution
@@ -754,9 +766,6 @@ EXTERN void		TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
 EXTERN ExceptionRange *	TclGetExceptionRangeForPc _ANSI_ARGS_((
 			    unsigned char *pc, int catchOnly,
 			    ByteCode* codePtr));
-EXTERN int		TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[], char *command, int length,
-			    int flags));
 EXTERN int		TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
 			    ByteCode *codePtr));
 EXTERN void		TclExpandJumpFixupArray _ANSI_ARGS_((
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cb3b5cc..8ca2772 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.40 2001/11/20 19:45:19 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.41 2001/11/20 21:17:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -792,6 +792,7 @@ TclExecuteByteCode(interp, codePtr)
 		 * Finally, let TclEvalObjvInternal handle the command. 
 		 */
 
+		Tcl_ResetResult(interp);
 		DECACHE_STACK_INFO();
 		result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
 		CACHE_STACK_INFO();