Fix [Bug 1587618], eliminating the callObjc and callObjv fields from the Interp

structure.

4 files changed, 52 insertions, 90 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9a40f38..194864b 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.206 2006/10/31 00:15:17 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.207 2006/10/31 13:46:31 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -362,8 +362,6 @@ Tcl_CreateInterp(void)
     if (iPtr->globalNsPtr == NULL) {
 	Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
     }
-    iPtr->callObjc = 0;
-    iPtr->callObjv = NULL;
 
     /*
      * Initialise the rootCallframe. It cannot be allocated on the stack, as
@@ -3286,10 +3284,11 @@ TclEvalObjvInternal(
 	return TCL_OK;
     }
 
-    /* Configure evaluation context to match the requested flags */
+    /*
+     * Configure evaluation context to match the requested flags.
+     */
 
-    if ((flags & TCL_EVAL_GLOBAL)
-	    && (varFramePtr != iPtr->rootFramePtr)) {
+    if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)) {
 	varFramePtr = iPtr->rootFramePtr;
 	savedVarFramePtr = iPtr->varFramePtr;
 	iPtr->varFramePtr = varFramePtr; 
@@ -3303,15 +3302,6 @@ TclEvalObjvInternal(
     }
 
     /*
-     * Record the calling objc/objv except if requested not to
-     */
-    
-    if (!(flags & TCL_EVAL_NOREWRITE)) {
-	iPtr->callObjc = objc;
-	iPtr->callObjv = objv;
-    }
-
-    /*
      * Find the function to execute this command. If there isn't one, then see
      * if there is an unknown command handler registered for this namespace.
      * If so, create a new word array with the handler as the first words and
@@ -3389,7 +3379,7 @@ TclEvalObjvInternal(
      */
 
     cmdEpoch = cmdPtr->cmdEpoch;
-    if ((checkTraces) && (command != NULL)) {
+    if (checkTraces && (command != NULL)) {
 	cmdPtr->refCount++;
 
 	/*
@@ -3401,27 +3391,16 @@ TclEvalObjvInternal(
 	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
 	    traceCode = TclCheckInterpTraces(interp, command, length,
 		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
-	    checkTraces = 0;
 	}
 	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
 	    traceCode = TclCheckExecutionTraces(interp, command, length,
 		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
-	    checkTraces = 0;
 	}
 	cmdPtr->refCount--;
-
-	/*
-	 * Restore the calling objc/objv, in case it was spoiled by traces 
-	 */
-	
-	if (!(checkTraces && (flags & TCL_EVAL_NOREWRITE))) {
-	    iPtr->callObjc = objc;
-	    iPtr->callObjv = objv;
-	}
-	
     }
     if (cmdEpoch != cmdPtr->cmdEpoch) {
 	/* The command has been modified in some way. */
+	checkTraces = 0;
 	goto reparseBecauseOfTraces;
     }
 
@@ -3432,7 +3411,7 @@ TclEvalObjvInternal(
     cmdPtr->refCount++;
     iPtr->cmdCount++;
     if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) {
-	if (!(flags & TCL_EVAL_INVOKE) &&
+	if (!(flags & (TCL_EVAL_INVOKE|TCL_EVAL_NOREWRITE)) &&
 		(iPtr->ensembleRewrite.sourceObjs != NULL)) {
 	    iPtr->ensembleRewrite.sourceObjs = NULL;
 	}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 62a8fee..25a150a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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.h,v 1.288 2006/10/28 23:36:18 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.289 2006/10/31 13:46:31 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -1547,19 +1547,6 @@ typedef struct Interp {
     int packagePrefer;          /* Current package selection mode. */
 
     /*
-     * Let [info level] know about ensemble rewriting. Note that this is just
-     * a temporary storage location until such time as it can be written into
-     * the call frame; it has to go there because that makes reentrant calls
-     * through the command dispatcher work.
-     */
-
-    int callObjc;		/* Number of arguments to report through [info
-				 * level]. */
-    Tcl_Obj *CONST *callObjv;	/* Array of arguments to report through [info
-				 * level]. */
-    
-    
-    /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
      */
@@ -1577,8 +1564,8 @@ typedef struct Interp {
 
 typedef struct InterpList {
     Interp *interpPtr;
-    struct InterpList* prevPtr;
-    struct InterpList* nextPtr;
+    struct InterpList *prevPtr;
+    struct InterpList *nextPtr;
 } InterpList;
 
 /*
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 95c348e..fe4a3f8 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,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.111 2006/10/30 14:27:59 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.112 2006/10/31 13:46:32 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -423,8 +423,8 @@ Tcl_PushCallFrame(
     nsPtr->activationCount++;
     framePtr->nsPtr = nsPtr;
     framePtr->isProcCallFrame = isProcCallFrame;
-    framePtr->objc = iPtr->callObjc;
-    framePtr->objv = iPtr->callObjv;
+    framePtr->objc = 0;
+    framePtr->objv = NULL;
     framePtr->callerPtr = iPtr->framePtr;
     framePtr->callerVarPtr = iPtr->varFramePtr;
     if (iPtr->varFramePtr != NULL) {
@@ -3433,6 +3433,9 @@ NamespaceEvalCmd(
 	return TCL_ERROR;
     }
 
+    framePtr->objc = objc;
+    framePtr->objv = objv;
+
     if (objc == 4) {
 	result = Tcl_EvalObjEx(interp, objv[3], 0);
     } else {
@@ -3832,6 +3835,9 @@ NamespaceInscopeCmd(
 	return result;
     }
 
+    framePtr->objc = objc;
+    framePtr->objv = objv;
+
     /*
      * Execute the command. If there is just one argument, just treat it as a
      * script and evaluate it. Otherwise, create a list from the arguments
@@ -6296,7 +6302,6 @@ NsEnsembleImplementationCmd(
      */
 
     if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
-	Interp *iPtr = (Interp *) interp;
 	int paramc, i;
 	Tcl_Obj **paramv, *unknownCmd, *ensObj;
 
@@ -6342,14 +6347,6 @@ NsEnsembleImplementationCmd(
 	    }
 
 	    /*
-	     * Restore the interp's call data, which may have been wiped out
-	     * while processing the unknown handler.
-	     */
-
-	    iPtr->callObjc = objc;
-	    iPtr->callObjv = objv;
-
-	    /*
 	     * Namespace alive & empty result => reparse.
 	     */
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index b4c5696..1dfe606 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.101 2006/10/28 22:48:43 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.102 2006/10/31 13:46:32 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -38,7 +38,7 @@ static void		MakeProcError(Tcl_Interp *interp,
 static void		MakeLambdaError(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj);
 static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static int		ProcCompileProc (Tcl_Interp *interp, Proc *procPtr,
+static int		ProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
 			    Tcl_Obj *bodyPtr, Namespace *nsPtr,
 			    CONST char *description, CONST char *procName,
 			    Proc **procPtrPtr);
@@ -309,7 +309,7 @@ TclCreateProc(
 	 * will be holding a reference to it.
 	 */
 
-	procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
+	procPtr = bodyPtr->internalRep.otherValuePtr;
 	procPtr->iPtr = iPtr;
 	procPtr->refCount++;
 	precompiled = 1;
@@ -1106,7 +1106,7 @@ TclInitCompiledLocals(
     if (bodyPtr->typePtr != &tclByteCodeType) {
 	Tcl_Panic("body object for proc attached to frame is not a byte code type");
     }
-    codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+    codePtr = bodyPtr->internalRep.otherValuePtr;
 
     InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr);
 }
@@ -1169,7 +1169,8 @@ ObjInterpProcEx(
      */
 
     result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
-	    "body of proc", TclGetString(objv[0]), &procPtr);
+	    (isLambda ? "body of lambda term" : "body of proc"),
+	    TclGetString(objv[isLambda]), &procPtr);
 
     if (result != TCL_OK) {
 	return result;
@@ -1195,8 +1196,8 @@ ObjInterpProcEx(
     framePtr->objv = objv;
     framePtr->procPtr = procPtr;
 
-    return TclObjInterpProcCore(interp, framePtr, objv[0], isLambda, 1,
-	    errorProc);
+    return TclObjInterpProcCore(interp, framePtr, objv[isLambda], isLambda,
+	    isLambda+1, errorProc);
 }
 
 /*
@@ -1321,7 +1322,7 @@ TclObjInterpProcCore(
      */
 
     if (localPtr->flags & VAR_IS_ARGS) {
-	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, &(argObjs[i]));
+	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
 	varPtr->value.objPtr = listPtr;
 	Tcl_IncrRefCount(listPtr);	/* local var is a reference */
     } else if (argCt == numArgs) {
@@ -1333,8 +1334,9 @@ TclObjInterpProcCore(
 	varPtr->value.objPtr = objPtr;
 	Tcl_IncrRefCount(objPtr);	/* local var is a reference */
     } else {
-	Tcl_Obj **desiredObjs, *argObj;
+	Tcl_Obj **desiredObjs;
 	ByteCode *codePtr;
+	const char *final;
 
 	/*
 	 * Do initialise all compiled locals, to avoid problems at
@@ -1342,30 +1344,34 @@ TclObjInterpProcCore(
 	 */
 
     incorrectArgs:
-	codePtr = (ByteCode *) procPtr->bodyPtr->internalRep.otherValuePtr;
+	final = NULL;
+	codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
 	InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr);
 
 	/*
 	 * Build up desired argument list for Tcl_WrongNumArgs
 	 */
 
-	desiredObjs = (Tcl_Obj **)
-		ckalloc(sizeof(Tcl_Obj *) * (unsigned)(numArgs+1));
+	desiredObjs = (Tcl_Obj **) TclStackAlloc(interp,
+		sizeof(Tcl_Obj *) * (unsigned)(numArgs+1));
 
 #ifdef AVOID_HACKS_FOR_ITCL
-	desiredObjs[0] = framePtr->objv[0];
+	desiredObjs[0] = framePtr->objv[skip-1];
 #else
-	desiredObjs[0] = (isLambda ? framePtr->objv[0] :
-		Tcl_NewListObj(1, framePtr->objv));
+	desiredObjs[0] = (isLambda ? framePtr->objv[skip-1] :
+		Tcl_NewListObj(skip, framePtr->objv));
 #endif /* AVOID_HACKS_FOR_ITCL */
 
 	localPtr = procPtr->firstLocalPtr;
 	for (i=1 ; i<=numArgs ; i++) {
+	    Tcl_Obj *argObj;
+
 	    TclNewObj(argObj);
 	    if (localPtr->defValuePtr != NULL) {
 		Tcl_AppendStringsToObj(argObj, "?", localPtr->name, "?", NULL);
 	    } else if ((i==numArgs) && !strcmp(localPtr->name, "args")) {
-		Tcl_AppendStringsToObj(argObj, "...", NULL);
+		numArgs--;
+		final = "...";
 	    } else {
 		Tcl_AppendStringsToObj(argObj, localPtr->name, NULL);
 	    }
@@ -1374,7 +1380,7 @@ TclObjInterpProcCore(
 	}
 
 	Tcl_ResetResult(interp);
-	Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, NULL);
+	Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);
 	result = TCL_ERROR;
 
 #ifndef AVOID_HACKS_FOR_ITCL
@@ -1386,7 +1392,7 @@ TclObjInterpProcCore(
 	for (i=1 ; i<=numArgs ; i++) {
 	    TclDecrRefCount(desiredObjs[i]);
 	}
-	ckfree((char *) desiredObjs);
+	TclStackFree(interp);
 	goto procDone;
     }
 
@@ -1407,19 +1413,11 @@ TclObjInterpProcCore(
 
   runProc:
     if (localPtr) {
-	ByteCode *codePtr = (ByteCode *)
-		procPtr->bodyPtr->internalRep.otherValuePtr;
+	ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
 
 	InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr);
     }
 
-    /*
-     * Set the callframe's objc/objv to be what [info level] expects.
-     */
-
-    framePtr->objc = ((Interp *) interp)->callObjc;
-    framePtr->objv = ((Interp *) interp)->callObjv;
-
 #if defined(TCL_COMPILE_DEBUG)
     if (tclTraceExec >= 1) {
 	if (isLambda) {
@@ -1562,7 +1560,7 @@ ProcCompileProc(
     int i, result;
     Tcl_CallFrame *framePtr;
     Proc *saveProcPtr;
-    ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+    ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
     CompiledLocal *localPtr;
 
     /*
@@ -1935,7 +1933,7 @@ TclNewProcBodyObj(
 
     if (objPtr) {
 	objPtr->typePtr = &tclProcBodyType;
-	objPtr->internalRep.otherValuePtr = (void *) procPtr;
+	objPtr->internalRep.otherValuePtr = procPtr;
 
 	procPtr->refCount++;
     }
@@ -1965,10 +1963,10 @@ ProcBodyDup(
     Tcl_Obj *srcPtr,		/* object to copy */
     Tcl_Obj *dupPtr)		/* target object for the duplication */
 {
-    Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
+    Proc *procPtr = srcPtr->internalRep.otherValuePtr;
 
     dupPtr->typePtr = &tclProcBodyType;
-    dupPtr->internalRep.otherValuePtr = (void *) procPtr;
+    dupPtr->internalRep.otherValuePtr = procPtr;
     procPtr->refCount++;
 }
 
@@ -1995,7 +1993,8 @@ static void
 ProcBodyFree(
     Tcl_Obj *objPtr)		/* the object to clean up */
 {
-    Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
+    Proc *procPtr = objPtr->internalRep.otherValuePtr;
+
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
 	TclProcCleanupProc(procPtr);
@@ -2234,7 +2233,7 @@ Tcl_ApplyObjCmd(
 	iPtr->ensembleRewrite.numInsertedObjs -= 1;
     }
 
-    result = ObjInterpProcEx((ClientData) procPtr, interp, objc-1, objv+1, 1,
+    result = ObjInterpProcEx((ClientData) procPtr, interp, objc, objv, 1,
 	    &MakeLambdaError);
 
     if (isRootEnsemble) {