* doc/interp.n: [3081184] TIP #378.

	* doc/tclvars.n: Performance fix for TIP #280.
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* tests/info.test:
	* tests/interp.test:

4 files changed, 132 insertions, 12 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0c57652..e686237 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.295.2.18 2010/07/25 10:13:49 nijtmans Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.295.2.19 2010/11/15 21:32:31 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -501,6 +501,15 @@ Tcl_CreateInterp(void)
     iPtr->resultSpace[0] = 0;
     iPtr->threadId = Tcl_GetCurrentThread();
 
+    /* TIP #378 */
+#ifdef TCL_INTERP_DEBUG_FRAME
+    iPtr->flags |= INTERP_DEBUG_FRAME;
+#else
+    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
+        iPtr->flags |= INTERP_DEBUG_FRAME;
+    }
+#endif
+
     /*
      * Initialise the tables for variable traces and searches *before*
      * creating the global ns - so that the trace on errorInfo can be
@@ -3442,7 +3451,9 @@ int
 TclInterpReady(
     Tcl_Interp *interp)
 {
+#if !defined(TCL_NO_STACK_CHECK)
     int localInt; /* used for checking the stack */
+#endif
     register Interp *iPtr = (Interp *) interp;
 
     /*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d70fcba..2f38758 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.369.2.18 2010/10/09 16:31:28 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.369.2.19 2010/11/15 21:32:31 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -2412,14 +2412,18 @@ TclExecuteByteCode(
 
 	    bcFramePtr->data.tebc.pc = (char *) pc;
 	    iPtr->cmdFramePtr = bcFramePtr;
-	    TclArgumentBCEnter((Tcl_Interp*) iPtr, objv, objc,
-		    codePtr, bcFramePtr, pc - codePtr->codeStart);
+	    if (iPtr->flags & INTERP_DEBUG_FRAME) {
+		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+			codePtr, bcFramePtr, pc - codePtr->codeStart);
+	    }
 	    DECACHE_STACK_INFO();
 	    result = TclEvalObjvInternal(interp, objc, objv,
 		    /* call from TEBC */(char *) -1, -1, 0);
 	    CACHE_STACK_INFO();
-	    TclArgumentBCRelease((Tcl_Interp*) iPtr, objv, objc,
-		    codePtr, pc - codePtr->codeStart);
+	    if (iPtr->flags & INTERP_DEBUG_FRAME) {
+		TclArgumentBCRelease((Tcl_Interp *) iPtr, objv, objc,
+			codePtr, pc - codePtr->codeStart);
+	    }
 	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
 
 	    if (result == TCL_OK) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index eb88ef0..31c9628 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,12 +13,14 @@
  * 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.362.2.14 2010/07/25 10:13:48 nijtmans Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.362.2.15 2010/11/15 21:32:32 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
 #define _TCLINT
 
+#define TCL_NO_STACK_CHECK /* DISABLE C RUNTIME STACK CHECK - Test AIX */
+
 /*
  * Some numerics configuration options.
  */
@@ -2032,6 +2034,9 @@ typedef struct InterpList {
  * SAFE_INTERP:		Non zero means that the current interp is a safe
  *			interp (i.e. it has only the safe commands installed,
  *			less priviledge than a regular interp).
+ * INTERP_DEBUG_FRAME:	Used for switching on various extra interpreter
+ *			debug/info mechanisms (e.g. info frame eval/uplevel
+ *			tracing) which are performance intensive.
  * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
  *			active; so no further trace callbacks should be
  *			invoked.
@@ -2047,6 +2052,7 @@ typedef struct InterpList {
 
 #define DELETED				     1
 #define ERR_ALREADY_LOGGED		     4
+#define INTERP_DEBUG_FRAME		  0x10
 #define DONT_COMPILE_CMDS_INLINE	  0x20
 #define RAND_SEED_INITIALIZED		  0x40
 #define SAFE_INTERP			  0x80
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index e7ad80d..219b059 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.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: tclInterp.c,v 1.83.2.4 2009/12/29 13:13:18 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.83.2.5 2010/11/15 21:32:32 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -207,6 +207,9 @@ static int		SlaveBgerror(Tcl_Interp *interp,
 			    Tcl_Obj *const objv[]);
 static Tcl_Interp *	SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    int safe);
+static int		SlaveDebugCmd(Tcl_Interp *interp,
+			    Tcl_Interp *slaveInterp,
+			    int objc, Tcl_Obj *const objv[]);
 static int		SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		SlaveExpose(Tcl_Interp *interp,
@@ -558,7 +561,7 @@ Tcl_InterpObjCmd(
     int index;
     static const char *options[] = {
 	"alias",	"aliases",	"bgerror",	"create",
-	"delete",	"eval",		"exists",	"expose",
+	"debug",	"delete",	"eval",		"exists",	"expose",
 	"hide",		"hidden",	"issafe",	"invokehidden",
 	"limit",	"marktrusted",	"recursionlimit","slaves",
 	"share",	"target",	"transfer",
@@ -566,7 +569,7 @@ Tcl_InterpObjCmd(
     };
     enum option {
 	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CREATE,
-	OPT_DELETE,	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,
+	OPT_DEBUG,	OPT_DELETE,	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,
 	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
 	OPT_LIMIT,	OPT_MARKTRUSTED,OPT_RECLIMIT,	OPT_SLAVES,
 	OPT_SHARE,	OPT_TARGET,	OPT_TRANSFER
@@ -706,6 +709,23 @@ Tcl_InterpObjCmd(
 	Tcl_SetObjResult(interp, slavePtr);
 	return TCL_OK;
     }
+    case OPT_DEBUG: {
+	/* TIP #378 */
+	Tcl_Interp *slaveInterp;
+
+	/*
+	 * Currently only -frame supported, otherwise ?-option ?value??
+	 */
+	if (objc < 3 || objc > 5) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
+	    return TCL_ERROR;
+	}
+	slaveInterp = GetInterp(interp, objv[2]);
+	if (slaveInterp == NULL) {
+	    return TCL_ERROR;
+	}
+	return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
+    }
     case OPT_DELETE: {
 	int i;
 	InterpInfo *iiPtr;
@@ -2228,12 +2248,12 @@ SlaveObjCmd(
     Tcl_Interp *slaveInterp = clientData;
     int index;
     static const char *options[] = {
-	"alias",	"aliases",	"bgerror",	"eval",
+	"alias",	"aliases",	"bgerror",	"debug",	"eval",
 	"expose",	"hide",		"hidden",	"issafe",
 	"invokehidden",	"limit",	"marktrusted",	"recursionlimit", NULL
     };
     enum options {
-	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_EVAL,
+	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,	OPT_EVAL,
 	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,
 	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED, OPT_RECLIMIT
     };
@@ -2280,6 +2300,16 @@ SlaveObjCmd(
 	    return TCL_ERROR;
 	}
 	return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
+    case OPT_DEBUG:
+	/*
+	 * TIP #378 *
+	 * Currently only -frame supported, otherwise ?-option ?value? ...?
+	 */
+	if (objc > 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??");
+	    return TCL_ERROR;
+	}
+	return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
     case OPT_EVAL:
 	if (objc < 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
@@ -2443,6 +2473,75 @@ SlaveObjCmdDeleteProc(
 /*
  *----------------------------------------------------------------------
  *
+ * SlaveDebugCmd -- TIP #378
+ *
+ *	Helper function to handle 'debug' command in a slave interpreter.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May modify INTERP_DEBUG flag in the slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveDebugCmd(
+    Tcl_Interp *interp,		/* Interp for error return. */
+    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command
+				 * will be evaluated. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *const debugTypes[] = {
+	"-frame", NULL
+    };
+    enum DebugTypes {
+	DEBUG_TYPE_FRAME
+    };
+    int debugType;
+    Interp *iPtr;
+    Tcl_Obj *resultPtr;
+
+    iPtr = (Interp *) slaveInterp;
+    if (objc == 0) {
+	resultPtr = Tcl_NewObj();
+	Tcl_ListObjAppendElement(NULL, resultPtr,
+		Tcl_NewStringObj("-frame", -1));
+	Tcl_ListObjAppendElement(NULL, resultPtr,
+		Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+	Tcl_SetObjResult(interp, resultPtr);
+    } else {
+	if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes,
+			"debug option", 0, &debugType) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (debugType == DEBUG_TYPE_FRAME) {
+	    if (objc == 2) { /* set */
+		if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType)
+			!= TCL_OK) {
+		    return TCL_ERROR;
+		}
+		/*
+		 * Quietly ignore attempts to disable interp debugging.
+		 * This is a one-way switch as frame debug info is maintained
+		 * in a stack that must be consistent once turned on.
+		 */
+		if (debugType) {
+		    iPtr->flags |= INTERP_DEBUG_FRAME;
+		}
+	    }
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * SlaveEval --
  *
  *	Helper function to evaluate a command in a slave interpreter.