* generic/tclTest.c: Added two new functions to allocate memory

	from the execution stack (TclStackAlloc, TclStackFree). Added
	functions TclPushStackFrame and TclPopStackFrame that do the work
	of Tcl_PushCallFrame and Tcl_PopCallFrame, but using frames
	allocated in the execution stack - i.e., heap instead of
	C-stack. The core uses these two new functions exclusively; the
	old ones remain for backwards compat, as at least two popular
	extensions (itcl, xotcl) are known to use them.

9 files changed, 247 insertions, 33 deletions

diff --git a/ChangeLog b/ChangeLog
index 8f832b9..154fdfa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,21 @@
+2004-12-15  Miguel Sofer <msofer@users.sf.net>
+
+	* generic/tclBasic.c:
+	* generic/tclExecute.c:
+	* generic/tclInt.decls:
+	* generic/tclIntDecls.h:
+	* generic/tclNamesp.c:
+	* generic/tclProc.c:
+	* generic/tclStubInit.c:
+	* generic/tclTest.c: Added two new functions to allocate memory
+	from the execution stack (TclStackAlloc, TclStackFree). Added
+	functions TclPushStackFrame and TclPopStackFrame that do the work
+	of Tcl_PushCallFrame and Tcl_PopCallFrame, but using frames
+	allocated in the execution stack - i.e., heap instead of
+	C-stack. The core uses these two new functions exclusively; the
+	old ones remain for backwards compat, as at least two popular
+	extensions (itcl, xotcl) are known to use them.
+	
 2004-12-14  Miguel Sofer <msofer@users.sf.net>
 
 	* generic/tclCmdIL.c:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d4c9382..45a3c4b 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.136 2004/11/30 19:34:46 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.137 2004/12/15 20:44:34 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4145,22 +4145,22 @@ TclObjInvokeNamespace(interp, objc, objv, nsPtr, flags)
 				 * TCL_INVOKE_NO_UNKNOWN, or
 				 * TCL_INVOKE_NO_TRACEBACK. */
 {
-    Tcl_CallFrame frame;
     int result;
+    Tcl_CallFrame *framePtr;
 
     /*
      * Make the specified namespace the current namespace and invoke
      * the command.
      */
 
-    result = Tcl_PushCallFrame(interp, &frame, nsPtr, /*isProcCallFrame*/ 0);
+    result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcCallFrame*/ 0);
     if (result != TCL_OK) {
         return TCL_ERROR;
     }
 
     result = TclObjInvoke(interp, objc, objv, flags);
 
-    Tcl_PopCallFrame(interp);
+    TclPopStackFrame(interp);
     return result;
 }
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 99cf90a..afbb4aa 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.167 2004/11/12 19:16:50 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.168 2004/12/15 20:44:36 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -659,6 +659,87 @@ GrowEvaluationStack(eePtr)
 /*
  *--------------------------------------------------------------
  *
+ * TclStackAlloc --
+ *
+ *	Allocate memory from the execution stack; it has to be returned later
+ *	with a call to TclStackFree
+ *
+ * Results:
+ *	A pointer to the first byte allocated, or panics if the allocation did 
+ *      not succeed.
+ *
+ * Side effects:
+ *	The execution stack may be grown.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+TclStackAlloc(interp, numBytes)
+    Tcl_Interp *interp;
+    int numBytes;
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    int numWords;
+    Tcl_Obj **tosPtr = eePtr->tosPtr;
+    char **stackRefCountPtr;
+    
+    /*
+     * Add two words to store
+     *   - a pointer to the used execution stack
+     *   - the number of words reserved
+     * These will be used later by TclStackFree. 
+     */
+    
+    numWords = (numBytes + 3*sizeof(void *) - 1)/sizeof(void *);
+
+    while ((tosPtr + numWords) > eePtr->endPtr) {
+	GrowEvaluationStack(eePtr);
+	tosPtr = eePtr->tosPtr;
+    }
+
+    /*
+     * Increase the stack's reference count, to make sure it is not freed
+     * prematurely. 
+     */ 
+
+    stackRefCountPtr = (char **) (eePtr->stackPtr-1);
+    ++*stackRefCountPtr;
+    
+    /*
+     * Reserve the space in the exec stack, and store the data for freeing.
+     */
+    
+    eePtr->tosPtr += numWords;
+    *(eePtr->tosPtr-1) = (Tcl_Obj *) stackRefCountPtr;
+    *(eePtr->tosPtr)   = (Tcl_Obj *) numWords;
+
+    return (char *) (tosPtr+1);    
+}
+
+void
+TclStackFree(interp) 
+    Tcl_Interp *interp;
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    char **stackRefCountPtr;
+
+    
+    stackRefCountPtr = (char **) *(eePtr->tosPtr-1);
+    eePtr->tosPtr -= (int) *(eePtr->tosPtr);
+    
+    --*stackRefCountPtr;
+    if (*stackRefCountPtr == (char *) 0) {
+	ckfree((VOID *) stackRefCountPtr);
+    }	    
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
  * Tcl_ExprObj --
  *
  *	Evaluate an expression in a Tcl_Obj.
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index e497298..f59d01e 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.84 2004/12/01 23:18:50 dgp Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.85 2004/12/15 20:44:38 msofer Exp $
 
 library tcl
 
@@ -859,6 +859,20 @@ declare 213 generic {
 declare 214 generic {
     void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
 }
+declare 215 generic {
+    char * TclStackAlloc(Tcl_Interp *interp, int numBytes)
+}
+declare 216 generic {
+    void TclStackFree(Tcl_Interp *interp)
+}
+declare 217 generic {
+    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
+            Tcl_Namespace *namespacePtr, int isProcCallFrame )
+}
+declare 218 generic {
+    void TclPopStackFrame(Tcl_Interp *interp)
+}
+
 
 ##############################################################################
 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index ed4b443..23acb90 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -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: tclIntDecls.h,v 1.75 2004/12/01 23:18:52 dgp Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.76 2004/12/15 20:44:39 msofer Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -1118,6 +1118,30 @@ EXTERN Tcl_Obj *	TclGetObjNameOfExecutable _ANSI_ARGS_((void));
 EXTERN void		TclSetObjNameOfExecutable _ANSI_ARGS_((
 				Tcl_Obj * name, Tcl_Encoding encoding));
 #endif
+#ifndef TclStackAlloc_TCL_DECLARED
+#define TclStackAlloc_TCL_DECLARED
+/* 215 */
+EXTERN char *		TclStackAlloc _ANSI_ARGS_((Tcl_Interp * interp, 
+				int numBytes));
+#endif
+#ifndef TclStackFree_TCL_DECLARED
+#define TclStackFree_TCL_DECLARED
+/* 216 */
+EXTERN void		TclStackFree _ANSI_ARGS_((Tcl_Interp * interp));
+#endif
+#ifndef TclPushStackFrame_TCL_DECLARED
+#define TclPushStackFrame_TCL_DECLARED
+/* 217 */
+EXTERN int		TclPushStackFrame _ANSI_ARGS_((Tcl_Interp * interp, 
+				Tcl_CallFrame ** framePtrPtr, 
+				Tcl_Namespace * namespacePtr, 
+				int isProcCallFrame));
+#endif
+#ifndef TclPopStackFrame_TCL_DECLARED
+#define TclPopStackFrame_TCL_DECLARED
+/* 218 */
+EXTERN void		TclPopStackFrame _ANSI_ARGS_((Tcl_Interp * interp));
+#endif
 
 typedef struct TclIntStubs {
     int magic;
@@ -1353,6 +1377,10 @@ typedef struct TclIntStubs {
     void (*tclpFindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 212 */
     Tcl_Obj * (*tclGetObjNameOfExecutable) _ANSI_ARGS_((void)); /* 213 */
     void (*tclSetObjNameOfExecutable) _ANSI_ARGS_((Tcl_Obj * name, Tcl_Encoding encoding)); /* 214 */
+    char * (*tclStackAlloc) _ANSI_ARGS_((Tcl_Interp * interp, int numBytes)); /* 215 */
+    void (*tclStackFree) _ANSI_ARGS_((Tcl_Interp * interp)); /* 216 */
+    int (*tclPushStackFrame) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_CallFrame ** framePtrPtr, Tcl_Namespace * namespacePtr, int isProcCallFrame)); /* 217 */
+    void (*tclPopStackFrame) _ANSI_ARGS_((Tcl_Interp * interp)); /* 218 */
 } TclIntStubs;
 
 #ifdef __cplusplus
@@ -2100,6 +2128,22 @@ extern TclIntStubs *tclIntStubsPtr;
 #define TclSetObjNameOfExecutable \
 	(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
 #endif
+#ifndef TclStackAlloc
+#define TclStackAlloc \
+	(tclIntStubsPtr->tclStackAlloc) /* 215 */
+#endif
+#ifndef TclStackFree
+#define TclStackFree \
+	(tclIntStubsPtr->tclStackFree) /* 216 */
+#endif
+#ifndef TclPushStackFrame
+#define TclPushStackFrame \
+	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
+#endif
+#ifndef TclPopStackFrame
+#define TclPopStackFrame \
+	(tclIntStubsPtr->tclPopStackFrame) /* 218 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index b9818a1..48a306d 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,7 +21,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.69 2004/12/11 14:41:47 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.70 2004/12/15 20:44:41 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -533,6 +533,59 @@ Tcl_PopCallFrame(interp)
 /*
  *----------------------------------------------------------------------
  *
+ * TclPushStackFrame --
+ *
+ *	Allocates a new call frame in the interpreter's execution stack, then
+ *	pushes it onto the interpreter's Tcl call stack.
+ *	Called when executing a Tcl procedure or a "namespace eval" or
+ *	"namespace inscope" command. 
+ *
+ * Results:
+ *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ *	message in the interpreter's result object) if something goes wrong.
+ *
+ * Side effects:
+ *	Modifies the interpreter's Tcl call stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPushStackFrame(interp, framePtrPtr, namespacePtr, isProcCallFrame)
+    Tcl_Interp *interp;		 /* Interpreter in which the new call frame
+				  * is to be pushed. */
+    Tcl_CallFrame **framePtrPtr; /* Place to store a pointer to the stack
+				  * allocated call frame.*/
+    Tcl_Namespace *namespacePtr; /* Points to the namespace in which the
+				  * frame will execute. If NULL, the
+				  * interpreter's current namespace will
+				  * be used. */
+    int isProcCallFrame;	 /* If nonzero, the frame represents a
+				  * called Tcl procedure and may have local
+				  * vars. Vars will ordinarily be looked up
+				  * in the frame. If new variables are
+				  * created, they will be created in the
+				  * frame. If 0, the frame is for a
+				  * "namespace eval" or "namespace inscope"
+				  * command and var references are treated
+				  * as references to namespace variables. */
+{
+
+    *framePtrPtr = (Tcl_CallFrame *) TclStackAlloc(interp, sizeof(CallFrame));
+    return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr, isProcCallFrame);
+}
+
+void
+TclPopStackFrame(interp)
+    Tcl_Interp* interp;		/* Interpreter with call frame to pop. */
+{
+    Tcl_PopCallFrame(interp);
+    TclStackFree(interp);    
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * EstablishErrorCodeTraces --
  *
  *	Creates traces on the ::errorCode variable to keep its value
@@ -2046,14 +2099,14 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
 	    if (entryPtr != NULL) {
 		nsPtr = (Namespace *) Tcl_GetHashValue(entryPtr);
 	    } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
-		Tcl_CallFrame frame;
+		Tcl_CallFrame *framePtr;
 
-		(void) Tcl_PushCallFrame(interp, &frame,
+		(void) TclPushStackFrame(interp, &framePtr,
 			(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
 
 		nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
 			(ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
-		Tcl_PopCallFrame(interp);
+		TclPopStackFrame(interp);
 
 		if (nsPtr == NULL) {
 		    Tcl_Panic("Could not create namespace '%s'", nsName);
@@ -3183,7 +3236,7 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
-    CallFrame frame, *framePtr;
+    CallFrame *framePtr, **framePtrPtr;
     Tcl_Obj *objPtr;
     int result;
 
@@ -3221,14 +3274,14 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
      */
 
     /* This is needed to satisfy GCC 3.3's strict aliasing rules */
-    framePtr = &frame;
-    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, 
+    framePtrPtr = &framePtr;
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, 
 	    namespacePtr, /*isProcCallFrame*/ 0);
     if (result != TCL_OK) {
 	return TCL_ERROR;
     }
-    frame.objc = objc;
-    frame.objv = objv;	/* ref counts do not need to be incremented here */
+    framePtr->objc = objc;
+    framePtr->objv = objv;	/* ref counts do not need to be incremented here */
 
     if (objc == 4) {
 	result = Tcl_EvalObjEx(interp, objv[3], 0);
@@ -3260,7 +3313,7 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
      * Restore the previous "current" namespace.
      */
 
-    Tcl_PopCallFrame(interp);
+    TclPopStackFrame(interp);
     return result;
 }
 
@@ -3596,7 +3649,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Tcl_Namespace *namespacePtr;
-    Tcl_CallFrame frame;
+    Tcl_CallFrame *framePtr;
     int i, result;
 
     if (objc < 4) {
@@ -3622,7 +3675,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
      * Make the specified namespace the current namespace.
      */
 
-    result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+    result = TclPushStackFrame(interp, &framePtr, namespacePtr,
 	    /*isProcCallFrame*/ 0);
     if (result != TCL_OK) {
 	return result;
@@ -3675,7 +3728,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
      * Restore the previous "current" namespace.
      */
 
-    Tcl_PopCallFrame(interp);
+    TclPopStackFrame(interp);
     return result;
 }
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index bcf82d2..feda831 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.68 2004/12/14 21:11:47 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.69 2004/12/15 20:44:41 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -918,8 +918,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
 {
     register Proc *procPtr = (Proc *) clientData;
     Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
-    CallFrame frame;
-    register CallFrame *framePtr = &frame;
+    CallFrame *framePtr, **framePtrPtr;
     register Var *varPtr;
     register CompiledLocal *localPtr;
     char *procName;
@@ -975,7 +974,8 @@ TclObjInterpProc(clientData, interp, objc, objv)
      * from one namespace to another.
      */
 
-    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+    framePtrPtr = &framePtr;
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
 	    (Tcl_Namespace *) nsPtr, FRAME_IS_PROC);
 
     if (result != TCL_OK) {
@@ -1139,7 +1139,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
      */
 
     procDone:
-    Tcl_PopCallFrame(interp);
+    TclPopStackFrame(interp);
     if (compiledLocals != localStorage) {
 	ckfree((char *) compiledLocals);
     }
@@ -1181,7 +1181,7 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
 {
     Interp *iPtr = (Interp*)interp;
     int result;
-    Tcl_CallFrame frame;
+    Tcl_CallFrame *framePtr;
     Proc *saveProcPtr;
     ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
 
@@ -1247,12 +1247,12 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
  	saveProcPtr = iPtr->compiledProcPtr;
  	iPtr->compiledProcPtr = procPtr;
 
- 	result = Tcl_PushCallFrame(interp, &frame,
+ 	result = TclPushStackFrame(interp, &framePtr,
 		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
 
  	if (result == TCL_OK) {
 	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
-	    Tcl_PopCallFrame(interp);
+	    TclPopStackFrame(interp);
 	}
 
  	iPtr->compiledProcPtr = saveProcPtr;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 83218f9..7c302bc 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -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: tclStubInit.c,v 1.109 2004/12/01 23:18:53 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.110 2004/12/15 20:44:42 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -299,6 +299,10 @@ TclIntStubs tclIntStubs = {
     TclpFindExecutable, /* 212 */
     TclGetObjNameOfExecutable, /* 213 */
     TclSetObjNameOfExecutable, /* 214 */
+    TclStackAlloc, /* 215 */
+    TclStackFree, /* 216 */
+    TclPushStackFrame, /* 217 */
+    TclPopStackFrame, /* 218 */
 };
 
 TclIntPlatStubs tclIntPlatStubs = {
diff --git a/generic/tclTest.c b/generic/tclTest.c
index c2f9dd0..72c8cef 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.86 2004/11/30 19:34:50 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.87 2004/12/15 20:44:43 msofer Exp $
  */
 
 #define TCL_TEST
@@ -4191,7 +4191,7 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
     char *name, *arg;
     int flags = 0;
     Tcl_Namespace *namespacePtr;
-    Tcl_CallFrame frame;
+    Tcl_CallFrame *framePtr;
     Tcl_Var variable;
     int result;
 
@@ -4222,7 +4222,7 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
 	if (namespacePtr == NULL) {
 	    return TCL_ERROR;
 	}
-	result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+	result = TclPushStackFrame(interp, &framePtr, namespacePtr,
                 /*isProcCallFrame*/ 0);
 	if (result != TCL_OK) {
 	    return result;
@@ -4233,7 +4233,7 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
 	    (flags | TCL_LEAVE_ERR_MSG));
 
     if (flags == TCL_NAMESPACE_ONLY) {
-	Tcl_PopCallFrame(interp);
+	TclPopStackFrame(interp);
     }
     if (variable == (Tcl_Var) NULL) {
 	return TCL_ERROR;