replace indirect with direct jumps where possible; little effect for now, pending mods will increase the impact

TODO_DONE

@@ -0,0 +1,76 @@
+*************************************************************************
+**** TODO ***************************************************************
+*************************************************************************
+
+* review the whole interp/execEnv relationship - who's boss?
+
+* improve local var handling in tebc? restrict, etc
+
+* optimize proc setup and teardown - any gains to be had in there?
+
+* mod NRE api - nreProc with the same sig as Tcl_NRPostProc (callbacks)?
+  Should be a win on the sibling jumps model: direct jump on 'diving in',
+  to complement the indirect jumps on rewinding
+
+* mig-alloc-reform: what can be brought in? At least forget -DPURIFY, make
+  it usable from normal builds.
+
+*************************************************************************
+**** DONE ***************************************************************
+*************************************************************************
+
+* changes to compiler and engine: old .tbc will not run, except with a
+  "sufficiently clever" tbcload. The compiler and tbcload will probably
+  need some work to adapt to the changes. This branch completely ignores
+  these issues.
+
+* tclAssembly.c and related are gone; it was an added burden adapting them
+  while modifying the bytecodes and tebc, the decision was taken to remove
+  it and do the work again "at the end"
+
+* INCOMPATIBILITY - no more cmdCount
+  There is no more [info cmdcount], or cmdCount based interpreter limits
+
+* the compiler was simplified a bit, removing quite a few "premature"
+  optimizations; these are now handled by the optimizer. In particular: all
+  instructions are issued in the 4-byte variant (so that the optimizer can
+  use the extra space), break/continue are not optimized to jumps until
+  later, etc.
+
+* there is a new optimizer that produces better bytecodes, especially in
+  the handling of logic and exceptions. The optimizer itself is extremely
+  suboptimal, the way it works can definitely be improved.
+
+* INCOMPATIBILITY (?) - NRE stack is a real stack
+  Tcl_NRAddCallback now OVERWRITES the currently executing callback!! Users
+  now have to make sure that they save the received data[] in local vars if
+  they plan to use them after pushing a new callback!
+
+* remove [case]
+
+* remove interp->result and all supporting code; remove other deprecated
+  apis 
+
+* remove [info frame] and [info errortsack], as well as all supporting
+  code. These should be recoded using the data that NRE is
+  keeping. Anything additional should ALWAYS choose to recompute on demand
+  over precomputing things during normal operation
+
+* NRE mods - reduce trampoline jumps: indirect jumps on rewinding. Replace
+  NRRunCallbacks with optimized sibling calls. Tests nre-0.1 and stack-3.1
+  should fail if the compiler is not optimizing the indirect calls between
+  NRE_callback to jumps.
+
+* INCOMPATIBILITY ... or at least, no attention paid to windows: we are
+  just assuming that __thread works (and using it in the memory allocator),
+  which is __declspec(thread) on windows, and thread_local in C11.
+  This is done by defining HAVE_FAST_TSD in the defaut build; can remove it
+  later on for the default - handy while developing. FIXME!!
+
+* mod the callback struct: make it have only 3 data fields, 4 in
+  total. This will reduce the size, possible improvements due to cache and 
+  memory alignment issues.
+
+* INCOMPATIBILITY ... or at least, no attention paid to windows. We are
+  using __atribute__ to insure good cache alignment of NRE_callback, this
+  is certainly not portable.

generic/tcl.decls

@@ -260,9 +260,9 @@ declare 67 {
 declare 68 {
     void Tcl_AllowExceptions(Tcl_Interp *interp)
 }
-declare 69 {
-    void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
-}
+#declare 69 {
+#    void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
+#}
 declare 70 {
     void Tcl_AppendResult(Tcl_Interp *interp, ...)
 }
@@ -524,9 +524,9 @@ declare 145 {
 declare 146 {
     int Tcl_Flush(Tcl_Channel chan)
 }
-declare 147 {
-    void Tcl_FreeResult(Tcl_Interp *interp)
-}
+#declare 147 {
+#    void Tcl_FreeResult(Tcl_Interp *interp)
+#}
 declare 148 {
     int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
 	    Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
@@ -1894,9 +1894,9 @@ declare 523 {
 declare 524 {
     int Tcl_LimitExceeded(Tcl_Interp *interp)
 }
-declare 525 {
-    void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit)
-}
+#declare 525 {
+#    void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit)
+#}
 declare 526 {
     void Tcl_LimitSetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr)
 }
@@ -1915,9 +1915,9 @@ declare 530 {
 declare 531 {
     void Tcl_LimitTypeReset(Tcl_Interp *interp, int type)
 }
-declare 532 {
-    int Tcl_LimitGetCommands(Tcl_Interp *interp)
-}
+#declare 532 {
+#    int Tcl_LimitGetCommands(Tcl_Interp *interp)
+#}
 declare 533 {
     void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr)
 }
@@ -2147,8 +2147,7 @@ declare 586 {
 }
 declare 587 {
     void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr,
-	    ClientData data0, ClientData data1, ClientData data2,
-	    ClientData data3)
+	    ClientData data0, ClientData data1, ClientData data2)
 }
 # For use by NR extenders, to have a simple way to also provide a (required!)
 # classic objProc

generic/tcl.h

@@ -136,14 +136,10 @@ extern "C" {
  */
 
 #include <stdarg.h>
-#ifndef TCL_NO_DEPRECATED
-#    define TCL_VARARGS(type, name) (type name, ...)
-#    define TCL_VARARGS_DEF(type, name) (type name, ...)
-#    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
-#endif
 #if defined(__GNUC__) && (__GNUC__ > 2)
 #   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
 #   define TCL_NORETURN __attribute__ ((noreturn))
+#   define TCL_NOINLINE __attribute__ ((noinline))
 #   if defined(BUILD_tcl) || defined(BUILD_tk)
 #	define TCL_NORETURN1 __attribute__ ((noreturn))
 #   else
@@ -153,8 +149,10 @@ extern "C" {
 #   define TCL_FORMAT_PRINTF(a,b)
 #   if defined(_MSC_VER) && (_MSC_VER >= 1310)
 #	define TCL_NORETURN _declspec(noreturn)
+#	define TCL_NOINLINE __declspec(noinline)
 #   else
 #	define TCL_NORETURN /* nothing */
+#	define TCL_NOINLINE /* nothing */
 #   endif
 #   define TCL_NORETURN1 /* nothing */
 #endif
@@ -242,19 +240,6 @@ extern "C" {
 #   endif
 #endif
 
-/*
- * The following _ANSI_ARGS_ macro is to support old extensions
- * written for older versions of Tcl where it permitted support
- * for compilers written in the pre-prototype era of C.
- *
- * New code should use prototypes.
- */
-
-#ifndef TCL_NO_DEPRECATED
-#   undef _ANSI_ARGS_
-#   define _ANSI_ARGS_(x)	x
-#endif
-
 /*
  * Definitions that allow this header file to be used either with or without
  * ANSI C features.
@@ -495,39 +480,7 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
  * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
  */
 
-typedef struct Tcl_Interp
-#ifndef TCL_NO_DEPRECATED
-{
-    /* TIP #330: Strongly discourage extensions from using the string
-     * result. */
-#ifdef USE_INTERP_RESULT
-    char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
-				/* If the last command returned a string
-				 * result, this points to it. */
-    void (*freeProc) (char *blockPtr)
-	    TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
-				/* Zero means the string result is statically
-				 * allocated. TCL_DYNAMIC means it was
-				 * allocated with ckalloc and should be freed
-				 * with ckfree. Other values give the address
-				 * of function to invoke to free the result.
-				 * Tcl_Eval must free it before executing next
-				 * command. */
-#else
-    char *resultDontUse; /* Don't use in extensions! */
-    void (*freeProcDontUse) (char *); /* Don't use in extensions! */
-#endif
-#ifdef USE_INTERP_ERRORLINE
-    int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
-				/* When TCL_ERROR is returned, this gives the
-				 * line number within the command where the
-				 * error occurred (1 if first line). */
-#else
-    int errorLineDontUse; /* Don't use in extensions! */
-#endif
-}
-#endif /* TCL_NO_DEPRECATED */
-Tcl_Interp;
+typedef struct Tcl_Interp Tcl_Interp;
 
 typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
 typedef struct Tcl_Channel_ *Tcl_Channel;
@@ -867,13 +820,7 @@ int		Tcl_IsShared(Tcl_Obj *objPtr);
  */
 
 typedef struct Tcl_SavedResult {
-    char *result;
-    Tcl_FreeProc *freeProc;
     Tcl_Obj *objResultPtr;
-    char *appendResult;
-    int appendAvl;
-    int appendUsed;
-    char resultSpace[TCL_RESULT_SIZE+1];
 } Tcl_SavedResult;
 
 /*
@@ -1118,17 +1065,6 @@ typedef struct Tcl_DString {
 
 #define TCL_ALLOW_INLINE_COMPILATION 0x20000
 
-/*
- * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
- * always parsed whenever the part2 is NULL. (This is to avoid a common error
- * when converting code to use the new object based APIs and forgetting to
- * give the flag)
- */
-
-#ifndef TCL_NO_DEPRECATED
-#   define TCL_PARSE_PART1	0x400
-#endif
-
 /*
  * Types for linked variables:
  */
@@ -2615,26 +2551,6 @@ EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
 #define Tcl_ConditionFinalize(condPtr)
 #endif /* TCL_THREADS */
 
-/*
- *----------------------------------------------------------------------------
- * Deprecated Tcl functions:
- */
-
-#ifndef TCL_NO_DEPRECATED
-/*
- * These function have been renamed. The old names are deprecated, but we
- * define these macros for backwards compatibilty.
- */
-
-#   define Tcl_Ckalloc		Tcl_Alloc
-#   define Tcl_Ckfree		Tcl_Free
-#   define Tcl_Ckrealloc	Tcl_Realloc
-#   define Tcl_Return		Tcl_SetResult
-#   define Tcl_TildeSubst	Tcl_TranslateFileName
-#   define panic		Tcl_Panic
-#   define panicVA		Tcl_PanicVA
-#endif /* !TCL_NO_DEPRECATED */
-
 /*
  *----------------------------------------------------------------------------
  * Convenience declaration of Tcl_AppInit for backwards compatibility. This

generic/tclCmdAH.c

@@ -129,142 +129,6 @@ Tcl_BreakObjCmd(
     return TCL_BREAK;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CaseObjCmd --
- *
- *	This procedure is invoked to process the "case" Tcl command. See the
- *	user documentation for details on what it does. THIS COMMAND IS
- *	OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-Tcl_CaseObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    register int i;
-    int body, result, caseObjc;
-    const char *stringPtr, *arg;
-    Tcl_Obj *const *caseObjv;
-    Tcl_Obj *armPtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"string ?in? ?pattern body ...? ?default body?");
-	return TCL_ERROR;
-    }
-
-    stringPtr = TclGetString(objv[1]);
-    body = -1;
-
-    arg = TclGetString(objv[2]);
-    if (strcmp(arg, "in") == 0) {
-	i = 3;
-    } else {
-	i = 2;
-    }
-    caseObjc = objc - i;
-    caseObjv = objv + i;
-
-    /*
-     * If all of the pattern/command pairs are lumped into a single argument,
-     * split them out again.
-     */
-
-    if (caseObjc == 1) {
-	Tcl_Obj **newObjv;
-
-	TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
-	caseObjv = newObjv;
-    }
-
-    for (i = 0;  i < caseObjc;  i += 2) {
-	int patObjc, j;
-	const char **patObjv;
-	const char *pat, *p;
-
-	if (i == caseObjc-1) {
-	    Tcl_ResetResult(interp);
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "extra case pattern with no body", -1));
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Check for special case of single pattern (no list) with no
-	 * backslash sequences.
-	 */
-
-	pat = TclGetString(caseObjv[i]);
-	for (p = pat; *p != '\0'; p++) {
-	    if (TclIsSpaceProc(*p) || (*p == '\\')) {
-		break;
-	    }
-	}
-	if (*p == '\0') {
-	    if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
-		body = i + 1;
-	    }
-	    if (Tcl_StringMatch(stringPtr, pat)) {
-		body = i + 1;
-		goto match;
-	    }
-	    continue;
-	}
-
-	/*
-	 * Break up pattern lists, then check each of the patterns in the
-	 * list.
-	 */
-
-	result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	for (j = 0; j < patObjc; j++) {
-	    if (Tcl_StringMatch(stringPtr, patObjv[j])) {
-		body = i + 1;
-		break;
-	    }
-	}
-	ckfree(patObjv);
-	if (j < patObjc) {
-	    break;
-	}
-    }
-
-  match:
-    if (body != -1) {
-	armPtr = caseObjv[body - 1];
-	result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
-	if (result == TCL_ERROR) {
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (\"%.50s\" arm line %d)",
-		    TclGetString(armPtr), Tcl_GetErrorLine(interp)));
-	}
-	return result;
-    }
-
-    /*
-     * Nothing matched: return nothing.
-     */
-
-    return TCL_OK;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -302,7 +166,6 @@ TclNRCatchObjCmd(
 {
     Tcl_Obj *varNamePtr = NULL;
     Tcl_Obj *optionVarNamePtr = NULL;
-    Interp *iPtr = (Interp *) interp;
 
     if ((objc < 2) || (objc > 4)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -318,13 +181,8 @@ TclNRCatchObjCmd(
     }
 
     TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
-	    varNamePtr, optionVarNamePtr, NULL);
-
-    /*
-     * TIP #280. Make invoking context available to caught script.
-     */
-
-    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+	    varNamePtr, optionVarNamePtr);
+    return TclNREvalObjEx(interp, objv[1], 0);
 }
 
 static int
@@ -352,7 +210,7 @@ CatchObjCmdCallback(
     if (objc >= 3) {
 	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
 		Tcl_GetObjResult(interp), TCL_LEAVE_ERR_MSG)) {
-	    return TCL_ERROR;
+	    NRE_NEXT(TCL_ERROR);
 	}
     }
     if (objc == 4) {
@@ -368,7 +226,7 @@ CatchObjCmdCallback(
 
     Tcl_ResetResult(interp);
     Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
-    return TCL_OK;
+    NRE_NEXT(TCL_OK);
 }
 
 /*
@@ -738,7 +596,7 @@ EvalCmdErrMsg(
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (\"eval\" body line %d)", Tcl_GetErrorLine(interp)));
     }
-    return result;
+    NRE_NEXT(result);
 }
 
 int
@@ -759,9 +617,6 @@ TclNREvalObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Tcl_Obj *objPtr;
-    Interp *iPtr = (Interp *) interp;
-    CmdFrame *invoker = NULL;
-    int word = 0;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -769,28 +624,18 @@ TclNREvalObjCmd(
     }
 
     if (objc == 2) {
-	/*
-	 * TIP #280. Make argument location available to eval'd script.
-	 */
-
-	invoker = iPtr->cmdFramePtr;
-	word = 1;
 	objPtr = objv[1];
-	TclArgumentGet(interp, objPtr, &invoker, &word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
 	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
 	 * object when it decrements its refcount after eval'ing it.
-	 *
-	 * TIP #280. Make invoking context available to eval'd script, done
-	 * with the default values.
 	 */
 
 	objPtr = Tcl_ConcatObj(objc-1, objv+1);
     }
-    TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
+    TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL);
+    return TclNREvalObjEx(interp, objPtr, 0);
 }
 
 /*
@@ -888,10 +733,10 @@ TclNRExprObjCmd(
     Tcl_IncrRefCount(resultPtr);
     if (objc == 2) {
 	objPtr = objv[1];
-	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
+	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL);
     } else {
 	objPtr = Tcl_ConcatObj(objc-1, objv+1);
-	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
+	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL);
     }
 
     return Tcl_NRExprObj(interp, objPtr, resultPtr);
@@ -914,7 +759,7 @@ ExprCallback(
 	Tcl_SetObjResult(interp, resultPtr);
     }
     Tcl_DecrRefCount(resultPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -2407,28 +2252,14 @@ TclNRForObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
-    ForIterData *iterPtr;
-
     if (objc != 5) {
 	Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
 	return TCL_ERROR;
     }
 
-    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
-    iterPtr->cond = objv[2];
-    iterPtr->body = objv[4];
-    iterPtr->next = objv[3];
-    iterPtr->msg  = "\n    (\"for\" body line %d)";
-    iterPtr->word = 4;
-
-    TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);
-
-    /*
-     * TIP #280. Make invoking context available to initial script.
-     */
-
-    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+    TclNRAddCallback(interp, ForSetupCallback, /*cond*/ objv[2],
+	    /*body*/ objv[4], /*next*/ objv[3]);
+    return TclNREvalObjEx(interp, objv[1], 0);
 }
 
 static int
@@ -2437,17 +2268,13 @@ ForSetupCallback(
     Tcl_Interp *interp,
     int result)
 {
-    ForIterData *iterPtr = data[0];
-
     if (result != TCL_OK) {
 	if (result == TCL_ERROR) {
 	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
 	}
-	TclSmallFreeEx(interp, iterPtr);
-	return result;
+	NRE_NEXT(result);
     }
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
-    return TCL_OK;
+    NRE_JUMP(interp, TclNRForIterCallback, data[0], data[1], data[2]);
 }
 
 int
@@ -2456,9 +2283,9 @@ TclNRForIterCallback(
     Tcl_Interp *interp,
     int result)
 {
-    ForIterData *iterPtr = data[0];
     Tcl_Obj *boolObj;
-
+    ClientData *extra;
+    
     switch (result) {
     case TCL_OK:
     case TCL_CONTINUE:
@@ -2469,20 +2296,21 @@ TclNRForIterCallback(
 	 */
 
 	Tcl_ResetResult(interp);
+        NRE_newExtra(extra);
+	extra[0] = data[2];
 	TclNewObj(boolObj);
-	TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL,
-		NULL);
-	return Tcl_NRExprObj(interp, iterPtr->cond, boolObj);
+	extra[1] = boolObj;
+	TclNRAddCallback(interp, ForCondCallback, data[0], data[1], extra);
+	return Tcl_NRExprObj(interp, /*cond*/ data[0], boolObj);
     case TCL_BREAK:
 	result = TCL_OK;
 	Tcl_ResetResult(interp);
 	break;
     case TCL_ERROR:
-	Tcl_AppendObjToErrorInfo(interp,
-		Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp)));
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (loop body line %d)", Tcl_GetErrorLine(interp)));
     }
-    TclSmallFreeEx(interp, iterPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 static int
@@ -2491,36 +2319,34 @@ ForCondCallback(
     Tcl_Interp *interp,
     int result)
 {
-    Interp *iPtr = (Interp *) interp;
-    ForIterData *iterPtr = data[0];
-    Tcl_Obj *boolObj = data[1];
+    ClientData *extra = data[2];    
+    Tcl_Obj *boolObj = extra[1];
     int value;
 
+    data[2] = extra[0];
+    NRE_freeExtra(extra);
+
     if (result != TCL_OK) {
 	Tcl_DecrRefCount(boolObj);
-	TclSmallFreeEx(interp, iterPtr);
-	return result;
+	NRE_NEXT(result);
     } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
 	Tcl_DecrRefCount(boolObj);
-	TclSmallFreeEx(interp, iterPtr);
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
     Tcl_DecrRefCount(boolObj);
 
-    if (value) {
-	/* TIP #280. */
-	if (iterPtr->next) {
-	    TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
-		    NULL);
-	} else {
-	    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
-		    NULL, NULL);
-	}
-	return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
-		iterPtr->word);
+    if (!value) {
+	NRE_NEXT(result);
     }
-    TclSmallFreeEx(interp, iterPtr);
-    return result;
+    
+    if (/*next*/ data[2]) {
+	TclNRAddCallback(interp, ForNextCallback,  data[0], data[1],
+		data[2]);
+    } else {
+	TclNRAddCallback(interp, TclNRForIterCallback, data[0], data[1],
+		data[2]);
+    }
+    return TclNREvalObjEx(interp, /*body*/ data[1], 0);
 }
 
 static int
@@ -2529,23 +2355,17 @@ ForNextCallback(
     Tcl_Interp *interp,
     int result)
 {
-    Interp *iPtr = (Interp *) interp;
-    ForIterData *iterPtr = data[0];
-    Tcl_Obj *next = iterPtr->next;
+    Tcl_Obj *next = /*body*/ data[2];
 
     if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
-	TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
-		NULL);
-
-	/*
-	 * TIP #280. Make invoking context available to next script.
-	 */
-
-	return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3);
+	TclNRAddCallback(interp, ForPostNextCallback, data[0], data[1],
+		    data[2]);
+	return TclNREvalObjEx(interp, next, 0);
     }
 
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
-    return result;
+    TclNRAddCallback(interp, TclNRForIterCallback, data[0], data[1],
+		    data[2]);
+    NRE_NEXT(result);
 }
 
 static int
@@ -2554,17 +2374,15 @@ ForPostNextCallback(
     Tcl_Interp *interp,
     int result)
 {
-    ForIterData *iterPtr = data[0];
-
     if ((result != TCL_BREAK) && (result != TCL_OK)) {
 	if (result == TCL_ERROR) {
 	    Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
-	    TclSmallFreeEx(interp, iterPtr);
 	}
-	return result;
+	NRE_NEXT(result);
     }
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
-    return result;
+    TclNRAddCallback(interp, TclNRForIterCallback, data[0], data[1],
+		    data[2]);
+    NRE_NEXT(result);
 }
 
 /*
@@ -2734,9 +2552,8 @@ EachloopCmd(
 	    goto done;
 	}
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
-	return TclNREvalObjEx(interp, objv[objc-1], 0,
-		((Interp *) interp)->cmdFramePtr, objc-1);
+	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL);
+	return TclNREvalObjEx(interp, objv[objc-1], 0);
     }
 
     /*
@@ -2800,9 +2617,8 @@ ForeachLoopStep(
 	    goto done;
 	}
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
-	return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
-		((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
+	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL);
+	return TclNREvalObjEx(interp, statePtr->bodyPtr, 0);
     }
 
     /*
@@ -2819,7 +2635,7 @@ ForeachLoopStep(
 
   done:
     ForeachCleanup(interp, statePtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*

generic/tclCmdIL.c

@@ -111,20 +111,12 @@ static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
-static int		InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
 static int		InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
-/* TIP #348 - New 'info' subcommand 'errorstack' */
-static int		InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-/* TIP #280 - New 'info' subcommand 'frame' */
-static int		InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
 static int		InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
@@ -163,14 +155,11 @@ static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
 static const EnsembleImplMap defaultInfoMap[] = {
     {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
-    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
     {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
     {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
     {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
-    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
-    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"hostname",	   InfoHostnameCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
@@ -227,7 +216,8 @@ TclNRIfObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Obj *boolObj;
-
+    ClientData *extra;
+    
     if (objc <= 1) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"wrong # args: no expression after \"%s\" argument",
@@ -242,9 +232,12 @@ TclNRIfObjCmd(
      * to execute if the expression is true.
      */
 
+    NRE_newExtra(extra);
     TclNewObj(boolObj);
+    extra[0] = INT2PTR(1);
+    extra[1] = boolObj;
     Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc),
-	    (ClientData) objv, INT2PTR(1), boolObj);
+	    (ClientData) objv, extra);
     return Tcl_NRExprObj(interp, objv[1], boolObj);
 }
 
@@ -254,21 +247,22 @@ IfConditionCallback(
     Tcl_Interp *interp,
     int result)
 {
-    Interp *iPtr = (Interp *) interp;
     int objc = PTR2INT(data[0]);
     Tcl_Obj *const *objv = data[1];
-    int i = PTR2INT(data[2]);
-    Tcl_Obj *boolObj = data[3];
+    ClientData *extra = data[2];
+    int i = PTR2INT(extra[0]);
+    Tcl_Obj *boolObj = extra[1];
     int value, thenScriptIndex = 0;
     const char *clause;
 
+    NRE_freeExtra(extra);
     if (result != TCL_OK) {
 	TclDecrRefCount(boolObj);
-	return result;
+	NRE_NEXT(result);
     }
     if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
 	TclDecrRefCount(boolObj);
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
     TclDecrRefCount(boolObj);
 
@@ -301,8 +295,7 @@ IfConditionCallback(
 		 * TIP #280. Make invoking context available to branch.
 		 */
 
-		return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
-			iPtr->cmdFramePtr, thenScriptIndex);
+		return TclNREvalObjEx(interp, objv[thenScriptIndex], 0);
 	    }
 	    return TCL_OK;
 	}
@@ -327,9 +320,12 @@ IfConditionCallback(
 	    return TCL_ERROR;
 	}
 	if (!thenScriptIndex) {
+	    NRE_newExtra(extra);
 	    TclNewObj(boolObj);
+	    extra[0] = INT2PTR(i);
+	    extra[1] = boolObj;
 	    Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
-		    INT2PTR(i), boolObj);
+		    extra);
 	    return Tcl_NRExprObj(interp, objv[i], boolObj);
 	}
     }
@@ -358,10 +354,9 @@ IfConditionCallback(
 	 * TIP #280. Make invoking context available to branch/else.
 	 */
 
-	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
-		iPtr->cmdFramePtr, thenScriptIndex);
+	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0);
     }
-    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
+    return TclNREvalObjEx(interp, objv[i], 0);
 
   missingScript:
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -586,45 +581,6 @@ InfoBodyCmd(
     return TCL_OK;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * InfoCmdCountCmd --
- *
- *	Called to implement the "info cmdcount" command that returns the
- *	number of commands that have been executed. Handles the following
- *	syntax:
- *
- *	    info cmdcount
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoCmdCountCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount));
-    return TCL_OK;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -1025,55 +981,6 @@ InfoDefaultCmd(
     return TCL_ERROR;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * InfoErrorStackCmd --
- *
- *	Called to implement the "info errorstack" command that returns information
- *	about the last error's call stack. Handles the following syntax:
- *
- *	    info errorstack ?interp?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoErrorStackCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Interp *target;
-    Interp *iPtr;
-
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
-	return TCL_ERROR;
-    }
-
-    target = interp;
-    if (objc == 2) {
-	target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
-	if (target == NULL) {
-	    return TCL_ERROR;
-	}
-    }
-
-    iPtr = (Interp *) target;
-    Tcl_SetObjResult(interp, iPtr->errorStack);
-
-    return TCL_OK;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -1117,347 +1024,6 @@ TclInfoExistsCmd(
     return TCL_OK;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * InfoFrameCmd --
- *	TIP #280
- *
- *	Called to implement the "info frame" command that returns the location
- *	of either the currently executing command, or its caller. Handles the
- *	following syntax:
- *
- *		info frame ?number?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoFrameCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    int level, code = TCL_OK;
-    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
-    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-    int topLevel = 0;
-
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
-	return TCL_ERROR;
-    }
-
-    while (corPtr) {
-	while (*cmdFramePtrPtr) {
-	    topLevel++;
-	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
-	}
-	if (corPtr->caller.cmdFramePtr) {
-	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
-	}
-	corPtr = corPtr->callerEEPtr->corPtr;
-    }
-    topLevel += (*cmdFramePtrPtr)->level;
-
-    if (topLevel != iPtr->cmdFramePtr->level) {
-	framePtr = iPtr->cmdFramePtr;
-	while (framePtr) {
-	    framePtr->level = topLevel--;
-	    framePtr = framePtr->nextPtr;
-	}
-	if (topLevel) {
-	    Tcl_Panic("Broken frame level calculation");
-	}
-	topLevel = iPtr->cmdFramePtr->level;
-    }
-
-    if (objc == 1) {
-	/*
-	 * Just "info frame".
-	 */
-
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
-	goto done;
-    }
-
-    /*
-     * We've got "info frame level" and must parse the level first.
-     */
-
-    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
-	code = TCL_ERROR;
-	goto done;
-    }
-
-    if ((level > topLevel) || (level <= - topLevel)) {
-    levelError:
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"bad level \"%s\"", TclGetString(objv[1])));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
-		TclGetString(objv[1]), NULL);
-	code = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Let us convert to relative so that we know how many levels to go back
-     */
-
-    if (level > 0) {
-	level -= topLevel;
-    }
-
-    framePtr = iPtr->cmdFramePtr;
-    while (++level <= 0) {
-	framePtr = framePtr->nextPtr;
-	if (!framePtr) {
-	    goto levelError;
-	}
-    }
-
-    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
-
-  done:
-    cmdFramePtrPtr = &iPtr->cmdFramePtr;
-    corPtr = iPtr->execEnvPtr->corPtr;
-    while (corPtr) {
-	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
-
-	if (endPtr) {
-	    if (*cmdFramePtrPtr == endPtr) {
-		*cmdFramePtrPtr = NULL;
-	    } else {
-		CmdFrame *runPtr = *cmdFramePtrPtr;
-
-		while (runPtr->nextPtr != endPtr) {
-		    runPtr->level -= endPtr->level;
-		    runPtr = runPtr->nextPtr;
-		}
-		runPtr->level = 1;
-		runPtr->nextPtr = NULL;
-	    }
-	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
-	}
-	corPtr = corPtr->callerEEPtr->corPtr;
-    }
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInfoFrame --
- *
- *	Core of InfoFrameCmd, returns TIP280 dict for a given frame.
- *
- * Results:
- *	Returns TIP280 dict.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclInfoFrame(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    CmdFrame *framePtr)		/* Frame to get info for. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *tmpObj;
-    Tcl_Obj *lv[20];		/* Keep uptodate when more keys are added to
-				 * the dict. */
-    int lc = 0;
-    /*
-     * This array is indexed by the TCL_LOCATION_... values, except
-     * for _LAST.
-     */
-    static const char *const typeString[TCL_LOCATION_LAST] = {
-	"eval", "eval", "eval", "precompiled", "source", "proc"
-    };
-    Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
-    int needsFree = -1;
-
-    /*
-     * Pull the information and construct the dictionary to return, as list.
-     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
-     */
-
-#define ADD_PAIR(name, value) \
-	TclNewLiteralStringObj(tmpObj, name); \
-	lv[lc++] = tmpObj; \
-	lv[lc++] = (value)
-
-    switch (framePtr->type) {
-    case TCL_LOCATION_EVAL:
-	/*
-	 * Evaluation, dynamic script. Type, line, cmd, the latter through
-	 * str.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	if (framePtr->line) {
-	    ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
-	} else {
-	    ADD_PAIR("line", Tcl_NewIntObj(1));
-	}
-	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
-	break;
-
-    case TCL_LOCATION_PREBC:
-	/*
-	 * Precompiled. Result contains the type as signal, nothing else.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	break;
-
-    case TCL_LOCATION_BC: {
-	/*
-	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
-	 */
-
-	CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-
-	*fPtr = *framePtr;
-
-	/*
-	 * Note:
-	 * Type BC => f.data.eval.path	  is not used.
-	 *	      f.data.tebc.codePtr is used instead.
-	 */
-
-	TclGetSrcInfoForPc(fPtr);
-
-	/*
-	 * Now filled: cmd.str.(cmd,len), line
-	 * Possibly modified: type, path!
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
-	if (fPtr->line) {
-	    ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
-	}
-
-	if (fPtr->type == TCL_LOCATION_SOURCE) {
-	    ADD_PAIR("file", fPtr->data.eval.path);
-
-	    /*
-	     * Death of reference by TclGetSrcInfoForPc.
-	     */
-
-	    Tcl_DecrRefCount(fPtr->data.eval.path);
-	}
-
-	ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
-	if (fPtr->cmdObj && framePtr->cmdObj == NULL) {
-	    needsFree = lc - 1;
-	}
-	TclStackFree(interp, fPtr);
-	break;
-    }
-
-    case TCL_LOCATION_SOURCE:
-	/*
-	 * Evaluation of a script file.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
-	ADD_PAIR("file", framePtr->data.eval.path);
-
-	/*
-	 * Refcount framePtr->data.eval.path goes up when lv is converted into
-	 * the result list object.
-	 */
-
-	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
-	break;
-
-    case TCL_LOCATION_PROC:
-	Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
-	break;
-    }
-
-    /*
-     * 'proc'. Common to all frame types. Conditional on having an associated
-     * Procedure CallFrame.
-     */
-
-    if (procPtr != NULL) {
-	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
-
-	if (namePtr) {
-	    Tcl_Obj *procNameObj;
-
-	    /*
-	     * This is a regular command.
-	     */
-
-	    TclNewObj(procNameObj);
-	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
-		    procNameObj);
-	    ADD_PAIR("proc", procNameObj);
-	} else if (procPtr->cmdPtr->clientData) {
-	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
-	    int i;
-
-	    /*
-	     * This is a non-standard command. Luckily, it's told us how to
-	     * render extra information about its frame.
-	     */
-
-	    for (i=0 ; i<efiPtr->length ; i++) {
-		lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
-		if (efiPtr->fields[i].proc) {
-		    lv[lc++] =
-			efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
-		} else {
-		    lv[lc++] = efiPtr->fields[i].clientData;
-		}
-	    }
-	}
-    }
-
-    /*
-     * 'level'. Common to all frame types. Conditional on having an associated
-     * _visible_ CallFrame.
-     */
-
-    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
-	CallFrame *current = framePtr->framePtr;
-	CallFrame *top = iPtr->varFramePtr;
-	CallFrame *idx;
-
-	for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
-	    if (idx == current) {
-		int c = framePtr->framePtr->level;
-		int t = iPtr->varFramePtr->level;
-
-		ADD_PAIR("level", Tcl_NewIntObj(t - c));
-		break;
-	    }
-	}
-    }
-
-    tmpObj = Tcl_NewListObj(lc, lv);
-    if (needsFree >= 0) {
-	Tcl_DecrRefCount(lv[needsFree]);
-    }
-    return tmpObj;
-}
-
 /*
  *----------------------------------------------------------------------
  *

generic/tclCmdMZ.c

@@ -3539,12 +3539,6 @@ TclNRSwitchObjCmd(
     Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
     Tcl_Obj *const *savedObjv = objv;
     Tcl_RegExp regExpr = NULL;
-    Interp *iPtr = (Interp *) interp;
-    int pc = 0;
-    int bidx = 0;		/* Index of body argument. */
-    Tcl_Obj *blist = NULL;	/* List obj which is the body */
-    CmdFrame *ctxPtr;		/* Copy of the topmost cmdframe, to allow us
-				 * to mess with the line information */
 
     /*
      * If you add options that make -e and -g not unique prefixes of -exact or
@@ -3668,22 +3662,16 @@ TclNRSwitchObjCmd(
     stringObj = objv[i];
     objc -= i + 1;
     objv += i + 1;
-    bidx = i + 1;		/* First after the match string. */
 
     /*
      * If all of the pattern/command pairs are lumped into a single argument,
      * split them out again.
-     *
-     * TIP #280: Determine the lines the words in the list start at, based on
-     * the same data for the list word itself. The cmdFramePtr line
-     * information is manipulated directly.
      */
 
     splitObjs = 0;
     if (objc == 1) {
 	Tcl_Obj **listv;
 
-	blist = objv[0];
 	if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){
 	    return TCL_ERROR;
 	}
@@ -3911,58 +3899,6 @@ TclNRSwitchObjCmd(
      */
 
   matchFound:
-    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-    *ctxPtr = *iPtr->cmdFramePtr;
-
-    if (splitObjs) {
-	/*
-	 * We have to perform the GetSrc and other type dependent handling of
-	 * the frame here because we are munging with the line numbers,
-	 * something the other commands like if, etc. are not doing. Them are
-	 * fine with simply passing the CmdFrame through and having the
-	 * special handling done in 'info frame', or the bc compiler
-	 */
-
-	if (ctxPtr->type == TCL_LOCATION_BC) {
-	    /*
-	     * Type BC => ctxPtr->data.eval.path    is not used.
-	     *		  ctxPtr->data.tebc.codePtr is used instead.
-	     */
-
-	    TclGetSrcInfoForPc(ctxPtr);
-	    pc = 1;
-
-	    /*
-	     * The line information in the cmdFrame is now a copy we do not
-	     * own.
-	     */
-	}
-
-	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
-	    int bline = ctxPtr->line[bidx];
-
-	    ctxPtr->line = ckalloc(objc * sizeof(int));
-	    ctxPtr->nline = objc;
-	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
-	} else {
-	    /*
-	     * This is either a dynamic code word, when all elements are
-	     * relative to themselves, or something else less expected and
-	     * where we have no information. The result is the same in both
-	     * cases; tell the code to come that it doesn't know where it is,
-	     * which triggers reversion to the old behavior.
-	     */
-
-	    int k;
-
-	    ctxPtr->line = ckalloc(objc * sizeof(int));
-	    ctxPtr->nline = objc;
-	    for (k=0; k < objc; k++) {
-		ctxPtr->line[k] = -1;
-	    }
-	}
-    }
-
     for (j = i + 1; ; j += 2) {
 	if (j >= objc) {
 	    /*
@@ -3977,13 +3913,9 @@ TclNRSwitchObjCmd(
 	}
     }
 
-    /*
-     * TIP #280: Make invoking context available to switch branch.
-     */
-
-    Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr,
-	    INT2PTR(pc), (ClientData) pattern);
-    return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
+    Tcl_NRAddCallback(interp, SwitchPostProc, (ClientData) pattern,
+	    NULL, NULL);
+    return TclNREvalObjEx(interp, objv[j], 0);
 }
 
 static int
@@ -3994,27 +3926,9 @@ SwitchPostProc(
 {
     /* Unpack the preserved data */
 
-    int splitObjs = PTR2INT(data[0]);
-    CmdFrame *ctxPtr = data[1];
-    int pc = PTR2INT(data[2]);
-    const char *pattern = data[3];
+    const char *pattern = data[0];
     int patternLength = strlen(pattern);
 
-    /*
-     * Clean up TIP 280 context information
-     */
-
-    if (splitObjs) {
-	ckfree(ctxPtr->line);
-	if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
-	    /*
-	     * Death of SrcInfo reference.
-	     */
-
-	    Tcl_DecrRefCount(ctxPtr->data.eval.path);
-	}
-    }
-
     /*
      * Generate an error message if necessary.
      */
@@ -4028,8 +3942,7 @@ SwitchPostProc(
 		(overflow ? limit : patternLength), pattern,
 		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
     }
-    TclStackFree(interp, ctxPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -4223,6 +4136,7 @@ TclNRTryObjCmd(
 {
     Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL;
     int i, bodyShared, haveHandlers, dummy, code;
+    ClientData *extra;
     static const char *const handlerNames[] = {
 	"finally", "on", "trap", NULL
     };
@@ -4355,10 +4269,12 @@ TclNRTryObjCmd(
      * Execute the body.
      */
 
-    Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
-	    (ClientData)objv, INT2PTR(objc));
-    return TclNREvalObjEx(interp, bodyObj, 0,
-	    ((Interp *) interp)->cmdFramePtr, 1);
+    NRE_newExtra(extra);
+    extra[0] = (ClientData)objv;
+    extra[1] = INT2PTR(objc);
+    Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj, extra);
+    
+    return TclNREvalObjEx(interp, bodyObj, 0);
 }
 
 /*
@@ -4424,9 +4340,11 @@ TryPostBody(
 
     handlersObj = data[0];
     finallyObj = data[1];
-    objv = data[2];
-    objc = PTR2INT(data[3]);
+    ClientData *extra = data[2];
+    objv = extra[0];
+    objc = PTR2INT(extra[1]);
 
+    NRE_freeExtra(extra);
     cmdObj = objv[0];
 
     /*
@@ -4440,7 +4358,7 @@ TryPostBody(
 	if (handlersObj != NULL) {
 	    Tcl_DecrRefCount(handlersObj);
 	}
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
 
     /*
@@ -4570,11 +4488,13 @@ TryPostBody(
 	     */
 
 	    handlerBodyObj = info[4];
-	    Tcl_NRAddCallback(interp, TryPostHandler, objv, options, info[0],
-		    INT2PTR((finallyObj == NULL) ? 0 : objc - 1));
+
+	    NRE_newExtra(extra);
+	    extra[0] = info[0];
+	    extra[1] = INT2PTR((finallyObj == NULL) ? 0 : objc - 1);
+	    Tcl_NRAddCallback(interp, TryPostHandler, objv, options, extra);
 	    Tcl_DecrRefCount(handlersObj);
-	    return TclNREvalObjEx(interp, handlerBodyObj, 0,
-		    ((Interp *) interp)->cmdFramePtr, 4*i + 5);
+	    return TclNREvalObjEx(interp, handlerBodyObj, 0);
 
 	handlerFailed:
 	    resultObj = Tcl_GetObjResult(interp);
@@ -4598,10 +4518,8 @@ TryPostBody(
      */
 
     if (finallyObj != NULL) {
-	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
-		NULL);
-	return TclNREvalObjEx(interp, finallyObj, 0,
-		((Interp *) interp)->cmdFramePtr, objc - 1);
+	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj);
+	return TclNREvalObjEx(interp, finallyObj, 0);
     }
 
     /*
@@ -4613,7 +4531,7 @@ TryPostBody(
     Tcl_DecrRefCount(options);
     Tcl_SetObjResult(interp, resultObj);
     Tcl_DecrRefCount(resultObj);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -4639,9 +4557,11 @@ TryPostHandler(
 
     objv = data[0];
     options = data[1];
-    handlerKindObj = data[2];
-    finally = PTR2INT(data[3]);
+    ClientData *extra = data[2];
+    handlerKindObj = extra[0];
+    finally = PTR2INT(extra[1]);
 
+    NRE_freeExtra(extra);
     cmdObj = objv[0];
     finallyObj = finally ? objv[finally] : 0;
 
@@ -4655,7 +4575,7 @@ TryPostHandler(
 		TclGetString(cmdObj), TclGetString(handlerKindObj),
 		Tcl_GetErrorLine(interp)));
 	Tcl_DecrRefCount(options);
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
 
     /*
@@ -4680,14 +4600,10 @@ TryPostHandler(
      */
 
     if (finallyObj != NULL) {
-	Interp *iPtr = (Interp *) interp;
-
-	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
-		NULL);
+	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj);
 
 	/* The 'finally' script is always the last argument word. */
-	return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr,
-		finally);
+	return TclNREvalObjEx(interp, finallyObj, 0);
     }
 
     /*
@@ -4699,7 +4615,7 @@ TryPostHandler(
     Tcl_DecrRefCount(options);
     Tcl_SetObjResult(interp, resultObj);
     Tcl_DecrRefCount(resultObj);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -4756,7 +4672,7 @@ TryPostFinal(
 	Tcl_SetObjResult(interp, resultObj);
 	Tcl_DecrRefCount(resultObj);
     }
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -4797,8 +4713,6 @@ TclNRWhileObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    ForIterData *iterPtr;
-
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "test command");
 	return TCL_ERROR;
@@ -4807,16 +4721,8 @@ TclNRWhileObjCmd(
     /*
      * We reuse [for]'s callback, passing a NULL for the 'next' script.
      */
-
-    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
-    iterPtr->cond = objv[1];
-    iterPtr->body = objv[2];
-    iterPtr->next = NULL;
-    iterPtr->msg  = "\n    (\"while\" body line %d)";
-    iterPtr->word = 2;
-
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
-	    NULL, NULL);
+    TclNRAddCallback(interp, TclNRForIterCallback, /*cond*/ objv[1],
+	    /*body*/ objv[2], /*next*/ NULL);
     return TCL_OK;
 }
 
@@ -4848,27 +4754,12 @@ TclListLines(
 				 * derived continuation data */
 {
     const char *listStr = Tcl_GetString(listObj);
-    const char *listHead = listStr;
     int i, length = strlen(listStr);
     const char *element = NULL, *next = NULL;
-    ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
-    int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
 
     for (i = 0; i < n; i++) {
 	TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
 
-	TclAdvanceLines(&line, listStr, element);
-				/* Leading whitespace */
-	TclAdvanceContinuations(&line, &clNext, element - listHead);
-	if (elems && clNext) {
-	    TclContinuationsEnterDerived(elems[i], element-listHead, clNext);
-	}
-	lines[i] = line;
-	length -= (next - listStr);
-	TclAdvanceLines(&line, element, next);
-				/* Element */
-	listStr = next;
-
 	if (*element == 0) {
 	    /* ASSERT i == n */
 	    break;

generic/tclCompCmdsGR.c

@@ -110,7 +110,6 @@ TclCompileGlobalCmd(
 {
     Tcl_Token *varTokenPtr;
     int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
 
     /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords;
@@ -147,7 +146,7 @@ TclCompileGlobalCmd(
 	/* TODO: Consider what value can pass throug the
 	 * IndexTailVarIfKnown() screen.  Full CompileWord()
 	 * likely does not apply here.  Push known value instead. */
-	CompileWord(envPtr, varTokenPtr, interp, i);
+	CompileWord(envPtr, varTokenPtr, interp);
 	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
     }
 
@@ -196,13 +195,12 @@ TclCompileIfCmd(
 				 * determined. */
     Tcl_Token *tokenPtr, *testTokenPtr;
     int jumpIndex = 0;		/* Avoid compiler warning. */
-    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
+    int numWords, wordIdx, numBytes, j, code;
     const char *word;
     int realCond = 1;		/* Set to 0 for static conditions:
 				 * "if 0 {..}" */
     int boolVal;		/* Value of static condition. */
     int compileScripts = 1;
-    DefineLineInformation;	/* TIP #280 */
 
     /*
      * Only compile the "if" command if all arguments are simple words, in
@@ -278,7 +276,6 @@ TclCompileIfCmd(
 		    compileScripts = 0;
 		}
 	    } else {
-		SetLineInformation(wordIdx);
 		Tcl_ResetResult(interp);
 		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
 		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
@@ -286,7 +283,7 @@ TclCompileIfCmd(
 		}
 		jumpIndex = jumpFalseFixupArray.next;
 		jumpFalseFixupArray.next++;
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+		TclEmitForwardJump(envPtr, JUMP_FALSE,
 			jumpFalseFixupArray.fixup+jumpIndex);
 	    }
 	    code = TCL_OK;
@@ -333,27 +330,15 @@ TclCompileIfCmd(
 		TclExpandJumpFixupArray(&jumpEndFixupArray);
 	    }
 	    jumpEndFixupArray.next++;
-	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+	    TclEmitForwardJump(envPtr, JUMP,
 		    jumpEndFixupArray.fixup+jumpIndex);
 
 	    /*
-	     * Fix the target of the jumpFalse after the test. Generate a 4
-	     * byte jump if the distance is > 120 bytes. This is conservative,
-	     * and ensures that we won't have to replace this jump if we later
-	     * also need to replace the proceeding jump to the end of the "if"
-	     * with a 4 byte jump.
+	     * Fix the target of the jumpFalse after the test. 
 	     */
 
 	    TclAdjustStackDepth(-1, envPtr);
-	    if (TclFixupForwardJumpToHere(envPtr,
-		    jumpFalseFixupArray.fixup+jumpIndex, 120)) {
-		/*
-		 * Adjust the code offset for the proceeding jump to the end
-		 * of the "if" command.
-		 */
-
-		jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
-	    }
+	    TclFixupForwardJumpToHere(envPtr, jumpFalseFixupArray.fixup[jumpIndex]);
 	} else if (boolVal) {
 	    /*
 	     * We were processing an "if 1 {...}"; stop compiling scripts.
@@ -428,29 +413,7 @@ TclCompileIfCmd(
 
     for (j = jumpEndFixupArray.next;  j > 0;  j--) {
 	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
-	if (TclFixupForwardJumpToHere(envPtr,
-		jumpEndFixupArray.fixup+jumpIndex, 127)) {
-	    /*
-	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
-	     * target (just after this jump) down three bytes.
-	     */
-
-	    unsigned char *ifFalsePc = envPtr->codeStart
-		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
-	    unsigned char opCode = *ifFalsePc;
-
-	    if (opCode == INST_JUMP_FALSE1) {
-		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
-		jumpFalseDist += 3;
-		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
-	    } else if (opCode == INST_JUMP_FALSE4) {
-		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
-		jumpFalseDist += 3;
-		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
-	    } else {
-		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
-	    }
-	}
+	TclFixupForwardJumpToHere(envPtr, jumpEndFixupArray.fixup[jumpIndex]);
     }
 
     /*
@@ -492,7 +455,6 @@ TclCompileIncrCmd(
 {
     Tcl_Token *varTokenPtr, *incrTokenPtr;
     int isScalar, localIndex, haveImmValue, immValue;
-    DefineLineInformation;	/* TIP #280 */
 
     if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
 	return TCL_ERROR;
@@ -500,8 +462,8 @@ TclCompileIncrCmd(
 
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
-	    &localIndex, &isScalar, 1);
+    TclPushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
+	    &localIndex, &isScalar);
 
     /*
      * If an increment is given, push it, but see first if it's a small
@@ -528,7 +490,6 @@ TclCompileIncrCmd(
 		PushLiteral(envPtr, word, numBytes);
 	    }
 	} else {
-	    SetLineInformation(2);
 	    CompileTokens(envPtr, incrTokenPtr, interp);
 	}
     } else {			/* No incr amount given so use 1. */
@@ -601,7 +562,6 @@ TclCompileInfoCommandsCmd(
 				 * compiled. */
     CompileEnv *envPtr)
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr;
     Tcl_Obj *objPtr;
     char *bytes;
@@ -640,11 +600,11 @@ TclCompileInfoCommandsCmd(
      */
 
     /* TODO: Just push the known value */
-    CompileWord(envPtr, tokenPtr,		interp, 1);
+    CompileWord(envPtr, tokenPtr,		interp);
     TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
     TclEmitOpcode(	INST_DUP,		envPtr);
     TclEmitOpcode(	INST_STR_LEN,		envPtr);
-    TclEmitInstInt1(	INST_JUMP_FALSE1, 7,	envPtr);
+    TclEmitInstInt4(	INST_JUMP_FALSE4, 10,	envPtr);
     TclEmitInstInt4(	INST_LIST, 1,		envPtr);
     return TCL_OK;
 
@@ -689,7 +649,6 @@ TclCompileInfoExistsCmd(
 {
     Tcl_Token *tokenPtr;
     int isScalar, localIndex;
-    DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
@@ -704,7 +663,7 @@ TclCompileInfoExistsCmd(
      */
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &isScalar, 1);
+    TclPushVarName(interp, tokenPtr, envPtr, 0, &localIndex, &isScalar);
 
     /*
      * Emit instruction to check the variable for existence.
@@ -749,14 +708,12 @@ TclCompileInfoLevelCmd(
     } else if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     } else {
-	DefineLineInformation;	/* TIP #280 */
-
 	/*
 	 * Compile the argument, then add the instruction to convert it into a
 	 * list of arguments.
 	 */
 
-	CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
+	CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp);
 	TclEmitOpcode(		INST_INFO_LEVEL_ARGS,		envPtr);
     }
     return TCL_OK;
@@ -771,13 +728,12 @@ TclCompileInfoObjectClassCmd(
 				 * compiled. */
     CompileEnv *envPtr)
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     }
-    CompileWord(envPtr,		tokenPtr,		interp, 1);
+    CompileWord(envPtr,		tokenPtr,		interp);
     TclEmitOpcode(		INST_TCLOO_CLASS,	envPtr);
     return TCL_OK;
 }
@@ -791,7 +747,6 @@ TclCompileInfoObjectIsACmd(
 				 * compiled. */
     CompileEnv *envPtr)
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     /*
@@ -813,7 +768,7 @@ TclCompileInfoObjectIsACmd(
      * Issue the code.
      */
 
-    CompileWord(envPtr,		tokenPtr,		interp, 2);
+    CompileWord(envPtr,		tokenPtr,		interp);
     TclEmitOpcode(		INST_TCLOO_IS_OBJECT,	envPtr);
     return TCL_OK;
 }
@@ -827,13 +782,12 @@ TclCompileInfoObjectNamespaceCmd(
 				 * compiled. */
     CompileEnv *envPtr)
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     }
-    CompileWord(envPtr,		tokenPtr,		interp, 1);
+    CompileWord(envPtr,		tokenPtr,		interp);
     TclEmitOpcode(		INST_TCLOO_NS,		envPtr);
     return TCL_OK;
 }
@@ -867,7 +821,6 @@ TclCompileLappendCmd(
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int isScalar, localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
 
     /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords;
@@ -889,8 +842,8 @@ TclCompileLappendCmd(
 
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-	    &localIndex, &isScalar, 1);
+    TclPushVarName(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar);
 
     /*
      * If we are doing an assignment, push the new value. In the no values
@@ -900,7 +853,7 @@ TclCompileLappendCmd(
     if (numWords > 2) {
 	Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
 
-	CompileWord(envPtr, valueTokenPtr, interp, 2);
+	CompileWord(envPtr, valueTokenPtr, interp);
     }
 
     /*
@@ -930,11 +883,11 @@ TclCompileLappendCmd(
 
   lappendMultiple:
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-	    &localIndex, &isScalar, 1);
+    TclPushVarName(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar);
     valueTokenPtr = TokenAfter(varTokenPtr);
     for (i = 2 ; i < numWords ; i++) {
-	CompileWord(envPtr, valueTokenPtr, interp, i);
+	CompileWord(envPtr, valueTokenPtr, interp);
 	valueTokenPtr = TokenAfter(valueTokenPtr);
     }
     TclEmitInstInt4(	    INST_LIST, numWords-2,		envPtr);
@@ -983,7 +936,6 @@ TclCompileLassignCmd(
 {
     Tcl_Token *tokenPtr;
     int isScalar, localIndex, numWords, idx;
-    DefineLineInformation;	/* TIP #280 */
 
     numWords = parsePtr->numWords;
 
@@ -1000,7 +952,7 @@ TclCompileLassignCmd(
      */
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    CompileWord(envPtr, tokenPtr, interp, 1);
+    CompileWord(envPtr, tokenPtr, interp);
 
     /*
      * Generate code to assign values from the list to variables.
@@ -1013,8 +965,8 @@ TclCompileLassignCmd(
 	 * Generate the next variable name.
 	 */
 
-	PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
-		&isScalar, idx+2);
+	TclPushVarName(interp, tokenPtr, envPtr, 0, &localIndex,
+		&isScalar);
 
 	/*
 	 * Emit instructions to get the idx'th item out of the list value on
@@ -1087,7 +1039,6 @@ TclCompileLindexCmd(
 {
     Tcl_Token *idxTokenPtr, *valTokenPtr;
     int i, idx, numWords = parsePtr->numWords;
-    DefineLineInformation;	/* TIP #280 */
 
     /*
      * Quit if too few args.
@@ -1114,7 +1065,7 @@ TclCompileLindexCmd(
 	 * an "immediate lindex" which is the most efficient variety.
 	 */
 
-	CompileWord(envPtr, valTokenPtr, interp, 1);
+	CompileWord(envPtr, valTokenPtr, interp);
 	TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
 	return TCL_OK;
     }
@@ -1131,7 +1082,7 @@ TclCompileLindexCmd(
 
   emitComplexLindex:
     for (i=1 ; i<numWords ; i++) {
-	CompileWord(envPtr, valTokenPtr, interp, i);
+	CompileWord(envPtr, valTokenPtr, interp);
 	valTokenPtr = TokenAfter(valTokenPtr);
     }
 
@@ -1176,7 +1127,6 @@ TclCompileListCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *valueTokenPtr;
     int i, numWords, concat, build;
     Tcl_Obj *listObj, *objPtr;
@@ -1230,7 +1180,7 @@ TclCompileListCmd(
 	    build = 0;
 	    concat = 1;
 	}
-	CompileWord(envPtr, valueTokenPtr, interp, i);
+	CompileWord(envPtr, valueTokenPtr, interp);
 	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
 	    if (concat) {
 		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
@@ -1291,14 +1241,13 @@ TclCompileLlengthCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     }
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    CompileWord(envPtr, varTokenPtr, interp, 1);
+    CompileWord(envPtr, varTokenPtr, interp);
     TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
     return TCL_OK;
 }
@@ -1324,7 +1273,6 @@ TclCompileLrangeCmd(
     CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     Tcl_Token *tokenPtr, *listTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
     int idx1, idx2;
 
     if (parsePtr->numWords != 4) {
@@ -1354,7 +1302,7 @@ TclCompileLrangeCmd(
      * is worth trying to do that given current knowledge.
      */
 
-    CompileWord(envPtr, listTokenPtr, interp, 1);
+    CompileWord(envPtr, listTokenPtr, interp);
     TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
     TclEmitInt4(		idx2,				envPtr);
     return TCL_OK;
@@ -1381,7 +1329,6 @@ TclCompileLinsertCmd(
     CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     Tcl_Token *tokenPtr, *listTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
     int idx, i;
 
     if (parsePtr->numWords < 3) {
@@ -1407,7 +1354,7 @@ TclCompileLinsertCmd(
      * this is a splice (== split, insert values as list, concat-3).
      */
 
-    CompileWord(envPtr, listTokenPtr, interp, 1);
+    CompileWord(envPtr, listTokenPtr, interp);
     if (parsePtr->numWords == 3) {
 	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
 	TclEmitInt4(			INDEX_END,		envPtr);
@@ -1416,7 +1363,7 @@ TclCompileLinsertCmd(
 
     for (i=3 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, i);
+	CompileWord(envPtr, tokenPtr, interp);
     }
     TclEmitInstInt4(		INST_LIST, i-3,			envPtr);
 
@@ -1463,7 +1410,6 @@ TclCompileLreplaceCmd(
     CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     Tcl_Token *tokenPtr, *listTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Obj *tmpObj;
     int idx1, idx2, i, offset, offset2;
 
@@ -1497,7 +1443,7 @@ TclCompileLreplaceCmd(
      */
 
     tmpObj = NULL;
-    CompileWord(envPtr, listTokenPtr, interp, 1);
+    CompileWord(envPtr, listTokenPtr, interp);
     if (parsePtr->numWords == 4) {
 	if (idx1 == 0) {
 	    if (idx2 == INDEX_END) {
@@ -1521,7 +1467,7 @@ TclCompileLreplaceCmd(
 
     tokenPtr = TokenAfter(tokenPtr);
     for (i=4 ; i<parsePtr->numWords ; i++) {
-	CompileWord(envPtr, tokenPtr, interp, i);
+	CompileWord(envPtr, tokenPtr, interp);
 	tokenPtr = TokenAfter(tokenPtr);
     }
     TclEmitInstInt4(		INST_LIST, i - 4,		envPtr);
@@ -1574,18 +1520,18 @@ TclCompileLreplaceCmd(
 	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
 	TclEmitOpcode(		INST_GT,			envPtr);
 	offset = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+	TclEmitInstInt4(	INST_JUMP_TRUE4, 0,		envPtr);
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
 	offset2 = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
+	TclEmitInstInt4(	INST_JUMP_FALSE4, 0,		envPtr);
 	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
 		"list doesn't contain element %d", idx1), NULL), envPtr);
 	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
 		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+	TclStoreInt4AtPtr(CurrentOffset(envPtr) - offset,
 		envPtr->codeStart + offset + 1);
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+	TclStoreInt4AtPtr(CurrentOffset(envPtr) - offset2,
 		envPtr->codeStart + offset2 + 1);
 	TclAdjustStackDepth(-1, envPtr);
     }
@@ -1630,18 +1576,18 @@ TclCompileLreplaceCmd(
 	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
 	TclEmitOpcode(		INST_GT,			envPtr);
 	offset = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+	TclEmitInstInt4(	INST_JUMP_TRUE4, 0,		envPtr);
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
 	offset2 = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+	TclEmitInstInt4(	INST_JUMP_TRUE4, 0,		envPtr);
 	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
 		"list doesn't contain element %d", idx1), NULL), envPtr);
 	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
 		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
+	TclStoreInt4AtPtr(CurrentOffset(envPtr) - offset,
 		envPtr->codeStart + offset + 1);
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
+	TclStoreInt4AtPtr(CurrentOffset(envPtr) - offset2,
 		envPtr->codeStart + offset2 + 1);
 	TclAdjustStackDepth(-1, envPtr);
     }
@@ -1724,7 +1670,6 @@ TclCompileLsetCmd(
     int localIndex;		/* Index of var in local var table. */
     int isScalar;		/* Flag == 1 if scalar, 0 if array. */
     int i;
-    DefineLineInformation;	/* TIP #280 */
 
     /*
      * Check argument count.
@@ -1748,8 +1693,8 @@ TclCompileLsetCmd(
      */
 
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-	    &localIndex, &isScalar, 1);
+    TclPushVarName(interp, varTokenPtr, envPtr, 0,
+	    &localIndex, &isScalar);
 
     /*
      * Push the "index" args and the new element value.
@@ -1757,7 +1702,7 @@ TclCompileLsetCmd(
 
     for (i=2 ; i<parsePtr->numWords ; ++i) {
 	varTokenPtr = TokenAfter(varTokenPtr);
-	CompileWord(envPtr, varTokenPtr, interp, i);
+	CompileWord(envPtr, varTokenPtr, interp);
     }
 
     /*
@@ -1890,7 +1835,6 @@ TclCompileNamespaceCodeCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *tokenPtr;
-    DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
@@ -1925,7 +1869,7 @@ TclCompileNamespaceCodeCmd(
     PushStringLiteral(envPtr,		"::namespace");
     PushStringLiteral(envPtr,		"inscope");
     TclEmitOpcode(		INST_NS_CURRENT,	envPtr);
-    CompileWord(envPtr,		tokenPtr,		interp, 1);
+    CompileWord(envPtr,		tokenPtr,		interp);
     TclEmitInstInt4(		INST_LIST, 4,		envPtr);
     return TCL_OK;
 }
@@ -1940,14 +1884,13 @@ TclCompileNamespaceOriginCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *tokenPtr;
-    DefineLineInformation;	/* TIP #280 */
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     }
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    CompileWord(envPtr,	tokenPtr,			interp, 1);
+    CompileWord(envPtr,	tokenPtr,			interp);
     TclEmitOpcode(	INST_ORIGIN_COMMAND,		envPtr);
     return TCL_OK;
 }
@@ -1962,14 +1905,13 @@ TclCompileNamespaceQualifiersCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    DefineLineInformation;	/* TIP #280 */
     int off;
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     }
 
-    CompileWord(envPtr, tokenPtr, interp, 1);
+    CompileWord(envPtr, tokenPtr, interp);
     PushStringLiteral(envPtr, "0");
     PushStringLiteral(envPtr, "::");
     TclEmitInstInt4(	INST_OVER, 2,			envPtr);
@@ -1983,7 +1925,7 @@ TclCompileNamespaceQualifiersCmd(
     PushStringLiteral(envPtr, ":");
     TclEmitOpcode(	INST_STR_EQ,			envPtr);
     off = off - CurrentOffset(envPtr);
-    TclEmitInstInt1(	INST_JUMP_TRUE1, off,		envPtr);
+    TclEmitInstInt4(	INST_JUMP_TRUE4, off,		envPtr);
     TclEmitOpcode(	INST_STR_RANGE,			envPtr);
     return TCL_OK;
 }
@@ -1998,8 +1940,7 @@ TclCompileNamespaceTailCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    DefineLineInformation;	/* TIP #280 */
-    JumpFixup jumpFixup;
+    int jumpFixup;
 
     if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
@@ -2009,17 +1950,17 @@ TclCompileNamespaceTailCmd(
      * Take care; only add 2 to found index if the string was actually found.
      */
 
-    CompileWord(envPtr, tokenPtr, interp, 1);
+    CompileWord(envPtr, tokenPtr, interp);
     PushStringLiteral(envPtr, "::");
     TclEmitInstInt4(	INST_OVER, 1,			envPtr);
     TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
     TclEmitOpcode(	INST_DUP,			envPtr);
     PushStringLiteral(envPtr, "0");
     TclEmitOpcode(	INST_GE,			envPtr);
-    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
+    TclEmitForwardJump(envPtr, JUMP_FALSE, &jumpFixup);
     PushStringLiteral(envPtr, "2");
     TclEmitOpcode(	INST_ADD,			envPtr);
-    TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
+    TclFixupForwardJumpToHere(envPtr, jumpFixup);
     PushStringLiteral(envPtr, "end");
     TclEmitOpcode(	INST_STR_RANGE,			envPtr);
     return TCL_OK;
@@ -2036,7 +1977,6 @@ TclCompileNamespaceUpvarCmd(
 {
     Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
     int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
 
     if (envPtr->procPtr == NULL) {
 	return TCL_ERROR;
@@ -2056,7 +1996,7 @@ TclCompileNamespaceUpvarCmd(
      */
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    CompileWord(envPtr, tokenPtr, interp, 1);
+    CompileWord(envPtr, tokenPtr, interp);
 
     /*
      * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
@@ -2069,7 +2009,7 @@ TclCompileNamespaceUpvarCmd(
 	otherTokenPtr = TokenAfter(localTokenPtr);
 	localTokenPtr = TokenAfter(otherTokenPtr);
 
-	CompileWord(envPtr, otherTokenPtr, interp, i);
+	CompileWord(envPtr, otherTokenPtr, interp);
 	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
 	if (localIndex < 0) {
 	    return TCL_ERROR;
@@ -2095,7 +2035,6 @@ TclCompileNamespaceWhichCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr, *opt;
     int idx;
 
@@ -2127,7 +2066,7 @@ TclCompileNamespaceWhichCmd(
      * Issue the bytecode.
      */
 
-    CompileWord(envPtr,		tokenPtr,		interp, idx);
+    CompileWord(envPtr,		tokenPtr,		interp);
     TclEmitOpcode(		INST_RESOLVE_COMMAND,	envPtr);
     return TCL_OK;
 }
@@ -2163,7 +2102,6 @@ TclCompileRegexpCmd(
 				 * parse of the RE or string. */
     int i, len, nocase, exact, sawLast, simple;
     const char *str;
-    DefineLineInformation;	/* TIP #280 */
 
     /*
      * We are only interested in compiling simple regexp cases. Currently
@@ -2266,7 +2204,7 @@ TclCompileRegexpCmd(
     }
 
     if (!simple) {
-	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
+	CompileWord(envPtr, varTokenPtr, interp);
     }
 
     /*
@@ -2274,7 +2212,7 @@ TclCompileRegexpCmd(
      */
 
     varTokenPtr = TokenAfter(varTokenPtr);
-    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
+    CompileWord(envPtr, varTokenPtr, interp);
 
     if (simple) {
 	if (exact && !nocase) {
@@ -2344,7 +2282,6 @@ TclCompileRegsubCmd(
      * The only optional part is the "--", and no other options are handled.
      */
 
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr, *stringTokenPtr;
     Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
     Tcl_DString pattern;
@@ -2458,7 +2395,7 @@ TclCompileRegsubCmd(
     PushLiteral(envPtr,	bytes, len);
     bytes = Tcl_GetStringFromObj(replacementObj, &len);
     PushLiteral(envPtr,	bytes, len);
-    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords-2);
+    CompileWord(envPtr,	stringTokenPtr, interp);
     TclEmitOpcode(	INST_STR_MAP,	envPtr);
 
   done:
@@ -2509,7 +2446,6 @@ TclCompileReturnCmd(
     int numOptionWords = numWords - 1 - explicitResult;
     Tcl_Obj *returnOpts, **objv;
     Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    DefineLineInformation;	/* TIP #280 */
 
     /*
      * Check for special case which can always be compiled:
@@ -2526,8 +2462,9 @@ TclCompileReturnCmd(
 	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
 	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);
 
-	CompileWord(envPtr, optsTokenPtr, interp, 2);
-	CompileWord(envPtr, msgTokenPtr,  interp, 3);
+	CompileWord(envPtr, optsTokenPtr, interp);
+	CompileWord(envPtr, msgTokenPtr,  interp);
+	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
 	TclEmitInvoke(envPtr, INST_RETURN_STK);
 	return TCL_OK;
     }
@@ -2587,7 +2524,7 @@ TclCompileReturnCmd(
      */
 
     if (explicitResult) {
-	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+	 CompileWord(envPtr, wordTokenPtr, interp);
     } else {
 	/*
 	 * No explict result argument, so default result is empty string.
@@ -2607,29 +2544,22 @@ TclCompileReturnCmd(
 	 * We have default return options and we're in a proc ...
 	 */
 
-	int index = envPtr->exceptArrayNext - 1;
-	int enclosingCatch = 0;
+	if (envPtr->exceptArrayNext) {
+	    int last = envPtr->exceptArrayNext -1;
+	    ExceptionRange *rangePtr = TclGetExceptionRange(CurrentOffset(envPtr),
+		    TCL_ERROR, &envPtr->exceptArrayPtr[last],
+		    &envPtr->exceptArrayPtr[0]);
+	    if (!rangePtr) {
+		/*
+		 * ... and there is no enclosing catch. Issue the maximally
+		 * efficient exit instruction.
+		 */
 
-	while (index >= 0) {
-	    ExceptionRange range = envPtr->exceptArrayPtr[index];
-
-	    if ((range.type == CATCH_EXCEPTION_RANGE)
-		    && (range.catchOffset == -1)) {
-		enclosingCatch = 1;
-		break;
+		Tcl_DecrRefCount(returnOpts);
+		TclEmitOpcode(INST_DONE, envPtr);
+		TclAdjustStackDepth(1, envPtr);
+		return TCL_OK;
 	    }
-	    index--;
-	}
-	if (!enclosingCatch) {
-	    /*
-	     * ... and there is no enclosing catch. Issue the maximally
-	     * efficient exit instruction.
-	     */
-
-	    Tcl_DecrRefCount(returnOpts);
-	    TclEmitOpcode(INST_DONE, envPtr);
-	    TclAdjustStackDepth(1, envPtr);
-	    return TCL_OK;
 	}
     }
 
@@ -2655,7 +2585,7 @@ TclCompileReturnCmd(
 
     wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
     for (objc=1 ; objc<=numOptionWords ; objc++) {
-	CompileWord(envPtr, wordTokenPtr, interp, objc);
+	CompileWord(envPtr, wordTokenPtr, interp);
 	wordTokenPtr = TokenAfter(wordTokenPtr);
     }
     TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);
@@ -2665,7 +2595,7 @@ TclCompileReturnCmd(
      */
 
     if (explicitResult) {
-	CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+	CompileWord(envPtr, wordTokenPtr, interp);
     } else {
 	PushStringLiteral(envPtr, "");
     }
@@ -2674,6 +2604,7 @@ TclCompileReturnCmd(
      * Issue the RETURN itself.
      */
 
+    TclEmitInstInt4(INST_REVERSE, 2, envPtr);
     TclEmitInvoke(envPtr, INST_RETURN_STK);
     return TCL_OK;
 }
@@ -2686,23 +2617,6 @@ CompileReturnInternal(
     int level,
     Tcl_Obj *returnOpts)
 {
-    if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) {
-	ExceptionRange *rangePtr;
-	ExceptionAux *exceptAux;
-
-	rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux);
-	if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
-	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
-	    if (code == TCL_BREAK) {
-		TclAddLoopBreakFixup(envPtr, exceptAux);
-	    } else {
-		TclAddLoopContinueFixup(envPtr, exceptAux);
-	    }
-	    Tcl_DecrRefCount(returnOpts);
-	    return;
-	}
-    }
-
     TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
     TclEmitInstInt4(op, code, envPtr);
     TclEmitInt4(level, envPtr);
@@ -2717,10 +2631,9 @@ TclCompileSyntaxError(
     int numBytes;
     const char *bytes = TclGetStringFromObj(msg, &numBytes);
 
-    TclErrorStackResetIf(interp, bytes, numBytes);
     TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
     CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
-	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
+	    Tcl_GetReturnOptions(interp, TCL_ERROR));
     Tcl_ResetResult(interp);
 }
 
@@ -2753,7 +2666,6 @@ TclCompileUpvarCmd(
 {
     Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
     int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Obj *objPtr;
 
     if (envPtr->procPtr == NULL) {
@@ -2789,7 +2701,7 @@ TclCompileUpvarCmd(
 		return TCL_ERROR;
 	    }
 	    /* TODO: Push the known value instead? */
-	    CompileWord(envPtr, tokenPtr, interp, 1);
+	    CompileWord(envPtr, tokenPtr, interp);
 	    otherTokenPtr = TokenAfter(tokenPtr);
 	    i = 2;
 	} else {
@@ -2814,7 +2726,7 @@ TclCompileUpvarCmd(
     for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
 	localTokenPtr = TokenAfter(otherTokenPtr);
 
-	CompileWord(envPtr, otherTokenPtr, interp, i);
+	CompileWord(envPtr, otherTokenPtr, interp);
 	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
 	if (localIndex < 0) {
 	    return TCL_ERROR;
@@ -2860,7 +2772,6 @@ TclCompileVariableCmd(
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
 
     numWords = parsePtr->numWords;
     if (numWords < 2) {
@@ -2893,7 +2804,7 @@ TclCompileVariableCmd(
 	/* TODO: Consider what value can pass throug the
 	 * IndexTailVarIfKnown() screen.  Full CompileWord()
 	 * likely does not apply here.  Push known value instead. */
-	CompileWord(envPtr, varTokenPtr, interp, i);
+	CompileWord(envPtr, varTokenPtr, interp);
 	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);
 
 	if (i+1 < numWords) {
@@ -2901,7 +2812,7 @@ TclCompileVariableCmd(
 	     * A value has been given: set the variable, pop the value
 	     */
 
-	    CompileWord(envPtr, valueTokenPtr, interp, i+1);
+	    CompileWord(envPtr, valueTokenPtr, interp);
 	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
 	    TclEmitOpcode(	INST_POP,			envPtr);
 	}
@@ -3030,7 +2941,6 @@ TclCompileObjectNextCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr = parsePtr->tokenPtr;
     int i;
 
@@ -3039,7 +2949,7 @@ TclCompileObjectNextCmd(
     }
 
     for (i=0 ; i<parsePtr->numWords ; i++) {
-	CompileWord(envPtr, tokenPtr, interp, i);
+	CompileWord(envPtr, tokenPtr, interp);
 	tokenPtr = TokenAfter(tokenPtr);
     }
     TclEmitInstInt1(	INST_TCLOO_NEXT, i,		envPtr);
@@ -3055,7 +2965,6 @@ TclCompileObjectNextToCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr = parsePtr->tokenPtr;
     int i;
 
@@ -3064,7 +2973,7 @@ TclCompileObjectNextToCmd(
     }
 
     for (i=0 ; i<parsePtr->numWords ; i++) {
-	CompileWord(envPtr, tokenPtr, interp, i);
+	CompileWord(envPtr, tokenPtr, interp);
 	tokenPtr = TokenAfter(tokenPtr);
     }
     TclEmitInstInt1(	INST_TCLOO_NEXT_CLASS, i,	envPtr);

generic/tclCompExpr.c

@@ -487,12 +487,21 @@ static const unsigned char Lexeme[] = {
  */
 
 typedef struct JumpList {
-    JumpFixup jump;		/* Pass this argument to matching calls of
+    int jump;		        /* Pass this argument to matching calls of
 				 * TclEmitForwardJump() and
 				 * TclFixupForwardJump(). */
     struct JumpList *next;	/* Point to next item on the stack */
 } JumpList;
 
+/*
+ * Macro to convert a jump to a different type
+ */
+
+#define CONVERT_JUMP(which, type)			\
+    TclUpdateInstInt4AtPc(INST_##type##4, 0,		\
+	    envPtr->codeStart + (which))
+ 
+
 /*
  * Declarations for local functions to this file:
  */
@@ -2134,10 +2143,6 @@ TclCompileExpr(
 	Tcl_Obj *const *litObjv;
 	Tcl_Obj **funcObjv;
 
-	/* TIP #280 : Track Lines within the expression */
-	TclAdvanceLines(&envPtr->line, script,
-		script + TclParseAllWhiteSpace(script, numBytes));
-
 	TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
 	TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
 	CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
@@ -2182,7 +2187,6 @@ ExecConstantExprTree(
     ByteCode *byteCodePtr;
     int code;
     Tcl_Obj *byteCodeObj = Tcl_NewObj();
-    NRE_callback *rootPtr = TOP_CB(interp);
 
     /*
      * Note we are compiling an expression with literal arguments. This means
@@ -2190,8 +2194,9 @@ ExecConstantExprTree(
      * bytecode, so there's no need to tend to TIP 280 issues.
      */
 
+    TclNRSetRoot(interp);
     envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
-    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
+    TclInitCompileEnv(interp, envPtr, NULL, 0);
     CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
 	    0 /* optimize */);
     TclEmitOpcode(INST_DONE, envPtr);
@@ -2201,7 +2206,7 @@ ExecConstantExprTree(
     TclStackFree(interp, envPtr);
     byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
     TclNRExecuteByteCode(interp, byteCodePtr);
-    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+    code = TclNRRunCallbacks(interp, TCL_OK);
     Tcl_DecrRefCount(byteCodeObj);
     return code;
 }
@@ -2290,17 +2295,16 @@ CompileExprTree(
 		newJump = TclStackAlloc(interp, sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
+		TclEmitForwardJump(envPtr, JUMP_FALSE, &jumpPtr->jump);
 		break;
 	    case COLON:
 		newJump = TclStackAlloc(interp, sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-			&jumpPtr->jump);
+		TclEmitForwardJump(envPtr, JUMP, &jumpPtr->jump);
 		TclAdjustStackDepth(-1, envPtr);
 		if (convert) {
-		    jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
+		    CONVERT_JUMP(jumpPtr->jump, JUMP_TRUE);
 		}
 		convert = 1;
 		break;
@@ -2309,8 +2313,11 @@ CompileExprTree(
 		newJump = TclStackAlloc(interp, sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
-			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
+		if (nodePtr->lexeme == AND) {
+		    TclEmitForwardJump(envPtr, JUMP_FALSE, &jumpPtr->jump);
+		} else {
+		    TclEmitForwardJump(envPtr, JUMP_TRUE, &jumpPtr->jump);
+		}
 		break;
 	    }
 	} else {
@@ -2355,19 +2362,19 @@ CompileExprTree(
 		break;
 	    case COLON:
 		CLANG_ASSERT(jumpPtr);
-		if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
-		    jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
+		if (*(envPtr->codeStart + jumpPtr->jump) ==
+			INST_JUMP_TRUE4) {
+		    CONVERT_JUMP(jumpPtr->jump, JUMP);
 		    convert = 1;
 		}
-		target = jumpPtr->jump.codeOffset + 2;
-		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
-		    target += 3;
-		}
+		target = jumpPtr->jump + 5;
+		TclFixupForwardJumpToHere(envPtr, jumpPtr->jump);
+		
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
-		TclFixupForwardJump(envPtr, &jumpPtr->jump,
-			target - jumpPtr->jump.codeOffset, 127);
+		TclFixupForwardJump(envPtr, jumpPtr->jump,
+			target - jumpPtr->jump);
 
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
@@ -2377,21 +2384,19 @@ CompileExprTree(
 	    case OR:
 		CLANG_ASSERT(jumpPtr);
 		pc1 = CurrentOffset(envPtr);
-		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
-			: INST_JUMP_TRUE1, 0, envPtr);
+		TclEmitInstInt4((nodePtr->lexeme == AND) ? INST_JUMP_FALSE4
+			: INST_JUMP_TRUE4, 0, envPtr);
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
 		pc2 = CurrentOffset(envPtr);
-		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
+		TclEmitInstInt4(INST_JUMP4, 0, envPtr);
 		TclAdjustStackDepth(-1, envPtr);
-		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
+		TclStoreInt4AtPtr(CurrentOffset(envPtr) - pc1,
 			envPtr->codeStart + pc1 + 1);
-		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
-		    pc2 += 3;
-		}
+		TclFixupForwardJumpToHere(envPtr, jumpPtr->jump);
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
-		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
+		TclStoreInt4AtPtr(CurrentOffset(envPtr) - pc2,
 			envPtr->codeStart + pc2 + 1);
 		convert = 0;
 		freePtr = jumpPtr;

generic/tclCompile.h

@@ -69,91 +69,54 @@ MODULE_SCOPE const Tcl_ObjType tclLambdaType;
  * ExceptionRange structure describes a range of code (e.g., a loop body), the
  * kind of exceptions (e.g., a break or continue) that might occur, and the PC
  * offsets to jump to if a matching exception does occur. Exception ranges can
- * nest so this structure includes a nesting level that is used at runtime to
- * find the closest exception range surrounding a PC. For example, when a
- * break command is executed, the ExceptionRange structure for the most deeply
- * nested loop, if any, is found and used. These structures are also generated
- * for the "next" subcommands of for loops since a break there terminates the
- * for command. This means a for command actually generates two LoopInfo
- * structures.
+ * nest, so we have to find the closest exception range surrounding a PC. For
+ * example, when a break command is executed, the ExceptionRange structure for
+ * the most deeply nested loop, if any, is found and used.
+ *
+ * The code ASSUMES that nested ranges come after their containing range in
+ * the arrays contained in CompileEnv and Bytecode structures, so this
+ * convention has to be respected by the compiler. The code also assumes that
+ * the range targets are *always* at the same stack depth as the range start.
+ *
+ * These structures are also generated for the "next" subcommands of for loops
+ * since a break there terminates the for command. This means a for command
+ * actually generates two of these structures.
  */
 
-typedef enum {
-    LOOP_EXCEPTION_RANGE,	/* Exception's range is part of a loop. Break
-				 * and continue "exceptions" cause jumps to
-				 * appropriate PC offsets. */
-    CATCH_EXCEPTION_RANGE	/* Exception's range is controlled by a catch
-				 * command. Errors in the range cause a jump
-				 * to a catch PC offset. */
-} ExceptionRangeType;
+/*
+ * Flags indicating the kind of ExceptionRange
+ */
+
+#define LOOP_EXCEPTION_RANGE     0x00
+#define CATCH_EXCEPTION_RANGE    0x01
+#define CATCH_PUSH_RESULT        0x02
+#define CATCH_PUSH_OPTIONS       0x04
+#define CATCH_EXCEPTION_FULL     0x07
+
+#define IS_CATCH_RANGE(rPtr) ((rPtr)->flags != 0)
 
 typedef struct ExceptionRange {
-    ExceptionRangeType type;	/* The kind of ExceptionRange. */
-    int nestingLevel;		/* Static depth of the exception range. Used
-				 * to find the most deeply-nested range
-				 * surrounding a PC at runtime. */
+    int stackDepth;             /* Stack depth at range start and targets */ 
+    int flags;                  /* Flags indicating the kind of ExceptionRange */
     int codeOffset;		/* Offset of the first instruction byte of the
 				 * code range. */
-    int numCodeBytes;		/* Number of bytes in the code range. */
-    int breakOffset;		/* If LOOP_EXCEPTION_RANGE, the target PC
-				 * offset for a break command in the range. */
+    int numCodeBytes;		/* Number of bytes in the code range. This is
+				 * negative while compiling, before the range
+				 * end is registered (used for keeping the
+				 * initial expand depth, as a negative number) */
+    int mainOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
+				 * offset for any "exception" in range. If
+				 * LOOP_EXCEPTION_RANGE, the target PC offset
+				 * for a break command in the range. */
     int continueOffset;		/* If LOOP_EXCEPTION_RANGE and not -1, the
 				 * target PC offset for a continue command in
 				 * the code range. Otherwise, ignore this
 				 * range when processing a continue
-				 * command. */
-    int catchOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
-				 * offset for any "exception" in range. */
+				 * command. During compilation, it may have
+				 * the value -2 to indicate that it will get
+				 * a proper value later on. */
 } ExceptionRange;
 
-/*
- * Auxiliary data used when issuing (currently just loop) exception ranges,
- * but which is not required during execution.
- */
-
-typedef struct ExceptionAux {
-    int supportsContinue;	/* Whether this exception range will have a
-				 * continueOffset created for it; if it is a
-				 * loop exception range that *doesn't* have
-				 * one (see [for] next-clause) then we must
-				 * not pick up the range when scanning for a
-				 * target to continue to. */
-    int stackDepth;		/* The stack depth at the point where the
-				 * exception range was created. This is used
-				 * to calculate the number of POPs required to
-				 * restore the stack to its prior state. */
-    int expandTarget;		/* The number of expansions expected on the
-				 * auxData stack at the time the loop starts;
-				 * we can't currently discard them except by
-				 * doing INST_INVOKE_EXPANDED; this is a known
-				 * problem. */
-    int expandTargetDepth;	/* The stack depth expected at the outermost
-				 * expansion within the loop. Not meaningful
-				 * if there are no open expansions between the
-				 * looping level and the point of jump
-				 * issue. */
-    int numBreakTargets;	/* The number of [break]s that want to be
-				 * targeted to the place where this loop
-				 * exception will be bound to. */
-    int *breakTargets;		/* The offsets of the INST_JUMP4 instructions
-				 * issued by the [break]s that we must
-				 * update. Note that resizing a jump (via
-				 * TclFixupForwardJump) can cause the contents
-				 * of this array to be updated. When
-				 * numBreakTargets==0, this is NULL. */
-    int allocBreakTargets;	/* The size of the breakTargets array. */
-    int numContinueTargets;	/* The number of [continue]s that want to be
-				 * targeted to the place where this loop
-				 * exception will be bound to. */
-    int *continueTargets;	/* The offsets of the INST_JUMP4 instructions
-				 * issued by the [continue]s that we must
-				 * update. Note that resizing a jump (via
-				 * TclFixupForwardJump) can cause the contents
-				 * of this array to be updated. When
-				 * numContinueTargets==0, this is NULL. */
-    int allocContinueTargets;	/* The size of the continueTargets array. */
-} ExceptionAux;
-
 /*
  * Structure used to map between instruction pc and source locations. It
  * defines for each compiled Tcl command its code's starting offset and its
@@ -169,39 +132,6 @@ typedef struct CmdLocation {
     int numSrcBytes;		/* Number of command source chars. */
 } CmdLocation;
 
-/*
- * TIP #280
- * Structure to record additional location information for byte code. This
- * information is internal and not saved. i.e. tbcload'ed code will not have
- * this information. It records the lines for all words of all commands found
- * in the byte code. The association with a ByteCode structure BC is done
- * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
- * Also recorded is information coming from the context, i.e. type of the
- * frame and associated information, like the path of a sourced file.
- */
-
-typedef struct ECL {
-    int srcOffset;		/* Command location to find the entry. */
-    int nline;			/* Number of words in the command */
-    int *line;			/* Line information for all words in the
-				 * command. */
-    int **next;			/* Transient information used by the compiler
-				 * for tracking of hidden continuation
-				 * lines. */
-} ECL;
-
-typedef struct ExtCmdLoc {
-    int type;			/* Context type. */
-    int start;			/* Starting line for compiled script. Needed
-				 * for the extended recompile check in
-				 * tclCompileObj. */
-    Tcl_Obj *path;		/* Path of the sourced file the command is
-				 * in. */
-    ECL *loc;			/* Command word locations (lines). */
-    int nloc;			/* Number of allocated entries in 'loc'. */
-    int nuloc;			/* Number of used entries in 'loc'. */
-} ExtCmdLoc;
-
 /*
  * CompileProcs need the ability to record information during compilation that
  * can be used by bytecode instructions during execution. The AuxData
@@ -297,10 +227,7 @@ typedef struct CompileEnv {
 				 * information provided by ObjInterpProc in
 				 * tclProc.c. */
     int numCommands;		/* Number of commands compiled. */
-    int exceptDepth;		/* Current exception range nesting level; -1
-				 * if not in any range currently. */
-    int maxExceptDepth;		/* Max nesting level of exception ranges; -1
-				 * if no ranges have been compiled. */
+    int expandDepth;		/* Current expansion nesting level. */
     int maxStackDepth;		/* Maximum number of stack elements needed to
 				 * execute the code. Set by compilation
 				 * procedures before returning. */
@@ -333,11 +260,6 @@ typedef struct CompileEnv {
 				 * entry. */
     int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
 				 * exceptArrayPtr points in heap, else 0. */
-    ExceptionAux *exceptAuxArrayPtr;
-				/* Array of information used to restore the
-				 * state when processing BREAK/CONTINUE
-				 * exceptions. Must be the same size as the
-				 * exceptArrayPtr. */
     CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
 				 * numCommands is the index of the next entry
 				 * to use; (numCommands-1) is the entry index
@@ -359,32 +281,10 @@ typedef struct CompileEnv {
 				/* Initial storage of LiteralEntry array. */
     ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
 				/* Initial ExceptionRange array storage. */
-    ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
-				/* Initial static except auxiliary info array
-				 * storage. */
     CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
 				/* Initial storage for cmd location map. */
     AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
 				/* Initial storage for aux data array. */
-    /* TIP #280 */
-    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information for
-				 * 'info frame'. */
-    int line;			/* First line of the script, based on the
-				 * invoking context, then the line of the
-				 * command currently compiled. */
-    int atCmdStart;		/* Flag to say whether an INST_START_CMD
-				 * should be issued; they should never be
-				 * issued repeatedly, as that is significantly
-				 * inefficient. If set to 2, that instruction
-				 * should not be issued at all (by the generic
-				 * part of the command compiler). */
-    int expandCount;		/* Number of INST_EXPAND_START instructions
-				 * encountered that have not yet been paired
-				 * with a corresponding
-				 * INST_INVOKE_EXPANDED. */
-    int *clNext;		/* If not NULL, it refers to the next slot in
-				 * clLoc to check for an invisible
-				 * continuation line. */
 } CompileEnv;
 
 /*
@@ -457,8 +357,6 @@ typedef struct ByteCode {
     int numAuxDataItems;	/* Number of AuxData items. */
     int numCmdLocBytes;		/* Number of bytes needed for encoded command
 				 * location information. */
-    int maxExceptDepth;		/* Maximum nesting level of ExceptionRanges;
-				 * -1 if no ranges were compiled. */
     int maxStackDepth;		/* Maximum number of stack elements needed to
 				 * execute the code. */
     unsigned char *codeStart;	/* Points to the first byte of the code. This
@@ -572,257 +470,242 @@ typedef struct ByteCode {
 #define INST_JUMP_FALSE4		39
 
 /* Opcodes 40 to 64 */
-#define INST_LOR			40
-#define INST_LAND			41
-#define INST_BITOR			42
-#define INST_BITXOR			43
-#define INST_BITAND			44
-#define INST_EQ				45
-#define INST_NEQ			46
-#define INST_LT				47
-#define INST_GT				48
-#define INST_LE				49
-#define INST_GE				50
-#define INST_LSHIFT			51
-#define INST_RSHIFT			52
-#define INST_ADD			53
-#define INST_SUB			54
-#define INST_MULT			55
-#define INST_DIV			56
-#define INST_MOD			57
-#define INST_UPLUS			58
-#define INST_UMINUS			59
-#define INST_BITNOT			60
-#define INST_LNOT			61
-#define INST_CALL_BUILTIN_FUNC1		62
-#define INST_CALL_FUNC1			63
-#define INST_TRY_CVT_TO_NUMERIC		64
+#define INST_BITOR			40
+#define INST_BITXOR			41
+#define INST_BITAND			42
+#define INST_EQ				43
+#define INST_NEQ			44
+#define INST_LT				45
+#define INST_GT				46
+#define INST_LE				47
+#define INST_GE				48
+#define INST_LSHIFT			49
+#define INST_RSHIFT			50
+#define INST_ADD			51
+#define INST_SUB			52
+#define INST_MULT			53
+#define INST_DIV			54
+#define INST_MOD			55
+#define INST_UPLUS			56
+#define INST_UMINUS			57
+#define INST_BITNOT			58
+#define INST_LNOT			59
+#define INST_TRY_CVT_TO_NUMERIC		60
 
 /* Opcodes 65 to 66 */
-#define INST_BREAK			65
-#define INST_CONTINUE			66
-
-/* Opcodes 67 to 68 */
-#define INST_FOREACH_START4		67 /* DEPRECATED */
-#define INST_FOREACH_STEP4		68 /* DEPRECATED */
+#define INST_BREAK			61
+#define INST_CONTINUE			62
 
 /* Opcodes 69 to 72 */
-#define INST_BEGIN_CATCH4		69
-#define INST_END_CATCH			70
-#define INST_PUSH_RESULT		71
-#define INST_PUSH_RETURN_CODE		72
 
 /* Opcodes 73 to 78 */
-#define INST_STR_EQ			73
-#define INST_STR_NEQ			74
-#define INST_STR_CMP			75
-#define INST_STR_LEN			76
-#define INST_STR_INDEX			77
-#define INST_STR_MATCH			78
+#define INST_STR_EQ			63
+#define INST_STR_NEQ			64
+#define INST_STR_CMP			65
+#define INST_STR_LEN			66
+#define INST_STR_INDEX			67
+#define INST_STR_MATCH			68
 
 /* Opcodes 78 to 81 */
-#define INST_LIST			79
-#define INST_LIST_INDEX			80
-#define INST_LIST_LENGTH		81
+#define INST_LIST			69
+#define INST_LIST_INDEX			70
+#define INST_LIST_LENGTH		71
 
 /* Opcodes 82 to 87 */
-#define INST_APPEND_SCALAR1		82
-#define INST_APPEND_SCALAR4		83
-#define INST_APPEND_ARRAY1		84
-#define INST_APPEND_ARRAY4		85
-#define INST_APPEND_ARRAY_STK		86
-#define INST_APPEND_STK			87
+#define INST_APPEND_SCALAR1		72
+#define INST_APPEND_SCALAR4		73
+#define INST_APPEND_ARRAY1		74
+#define INST_APPEND_ARRAY4		75
+#define INST_APPEND_ARRAY_STK		76
+#define INST_APPEND_STK			77
 
 /* Opcodes 88 to 93 */
-#define INST_LAPPEND_SCALAR1		88
-#define INST_LAPPEND_SCALAR4		89
-#define INST_LAPPEND_ARRAY1		90
-#define INST_LAPPEND_ARRAY4		91
-#define INST_LAPPEND_ARRAY_STK		92
-#define INST_LAPPEND_STK		93
+#define INST_LAPPEND_SCALAR1		78
+#define INST_LAPPEND_SCALAR4		79
+#define INST_LAPPEND_ARRAY1		80
+#define INST_LAPPEND_ARRAY4		81
+#define INST_LAPPEND_ARRAY_STK		82
+#define INST_LAPPEND_STK		83
 
 /* TIP #22 - LINDEX operator with flat arg list */
 
-#define INST_LIST_INDEX_MULTI		94
+#define INST_LIST_INDEX_MULTI		84
 
 /*
  * TIP #33 - 'lset' command. Code gen also required a Forth-like
  *	     OVER operation.
  */
 
-#define INST_OVER			95
-#define INST_LSET_LIST			96
-#define INST_LSET_FLAT			97
+#define INST_OVER			85
+#define INST_LSET_LIST			86
+#define INST_LSET_FLAT			87
 
 /* TIP#90 - 'return' command. */
 
-#define INST_RETURN_IMM			98
+#define INST_RETURN_IMM			88
 
 /* TIP#123 - exponentiation operator. */
 
-#define INST_EXPON			99
+#define INST_EXPON			89
 
 /* TIP #157 - {*}... (word expansion) language syntax support. */
 
-#define INST_EXPAND_START		100
-#define INST_EXPAND_STKTOP		101
-#define INST_INVOKE_EXPANDED		102
+#define INST_EXPAND_START		90
+#define INST_EXPAND_STKTOP		91
+#define INST_INVOKE_EXPANDED		92
 
 /*
  * TIP #57 - 'lassign' command. Code generation requires immediate
  *	     LINDEX and LRANGE operators.
  */
 
-#define INST_LIST_INDEX_IMM		103
-#define INST_LIST_RANGE_IMM		104
+#define INST_LIST_INDEX_IMM		93
+#define INST_LIST_RANGE_IMM		94
 
-#define INST_START_CMD			105
+#define INST_LIST_IN			95
+#define INST_LIST_NOT_IN		96
 
-#define INST_LIST_IN			106
-#define INST_LIST_NOT_IN		107
-
-#define INST_PUSH_RETURN_OPTIONS	108
-#define INST_RETURN_STK			109
+#define INST_PUSH_RETURN_OPTIONS	97
+#define INST_RETURN_STK			98
 
 /*
  * Dictionary (TIP#111) related commands.
  */
 
-#define INST_DICT_GET			110
-#define INST_DICT_SET			111
-#define INST_DICT_UNSET			112
-#define INST_DICT_INCR_IMM		113
-#define INST_DICT_APPEND		114
-#define INST_DICT_LAPPEND		115
-#define INST_DICT_FIRST			116
-#define INST_DICT_NEXT			117
-#define INST_DICT_DONE			118
-#define INST_DICT_UPDATE_START		119
-#define INST_DICT_UPDATE_END		120
+#define INST_DICT_GET			99
+#define INST_DICT_SET			100
+#define INST_DICT_UNSET			101
+#define INST_DICT_INCR_IMM		102
+#define INST_DICT_APPEND		103
+#define INST_DICT_LAPPEND		104
+#define INST_DICT_FIRST			105
+#define INST_DICT_NEXT			106
+#define INST_DICT_DONE			107
+#define INST_DICT_UPDATE_START		108
+#define INST_DICT_UPDATE_END		109
 
 /*
  * Instruction to support jumps defined by tables (instead of the classic
  * [switch] technique of chained comparisons).
  */
 
-#define INST_JUMP_TABLE			121
+#define INST_JUMP_TABLE			110
 
 /*
  * Instructions to support compilation of global, variable, upvar and
  * [namespace upvar].
  */
 
-#define INST_UPVAR			122
-#define INST_NSUPVAR			123
-#define INST_VARIABLE			124
+#define INST_UPVAR			111
+#define INST_NSUPVAR			112
+#define INST_VARIABLE			113
 
 /* Instruction to support compiling syntax error to bytecode */
 
-#define INST_SYNTAX			125
+#define INST_SYNTAX			114
 
 /* Instruction to reverse N items on top of stack */
 
-#define INST_REVERSE			126
+#define INST_REVERSE			115
 
 /* regexp instruction */
 
-#define INST_REGEXP			127
+#define INST_REGEXP			116
 
 /* For [info exists] compilation */
-#define INST_EXIST_SCALAR		128
-#define INST_EXIST_ARRAY		129
-#define INST_EXIST_ARRAY_STK		130
-#define INST_EXIST_STK			131
+#define INST_EXIST_SCALAR		117
+#define INST_EXIST_ARRAY		118
+#define INST_EXIST_ARRAY_STK		119
+#define INST_EXIST_STK			120
 
 /* For [subst] compilation */
-#define INST_NOP			132
-#define INST_RETURN_CODE_BRANCH		133
+#define INST_NOP			121
 
 /* For [unset] compilation */
-#define INST_UNSET_SCALAR		134
-#define INST_UNSET_ARRAY		135
-#define INST_UNSET_ARRAY_STK		136
-#define INST_UNSET_STK			137
+#define INST_UNSET_SCALAR		122
+#define INST_UNSET_ARRAY		123
+#define INST_UNSET_ARRAY_STK		124
+#define INST_UNSET_STK			125
 
 /* For [dict with], [dict exists], [dict create] and [dict merge] */
-#define INST_DICT_EXPAND		138
-#define INST_DICT_RECOMBINE_STK		139
-#define INST_DICT_RECOMBINE_IMM		140
-#define INST_DICT_EXISTS		141
-#define INST_DICT_VERIFY		142
+#define INST_DICT_EXPAND		126
+#define INST_DICT_RECOMBINE_STK		127
+#define INST_DICT_RECOMBINE_IMM		128
+#define INST_DICT_EXISTS		129
+#define INST_DICT_VERIFY		130
 
 /* For [string map] and [regsub] compilation */
-#define INST_STR_MAP			143
-#define INST_STR_FIND			144
-#define INST_STR_FIND_LAST		145
-#define INST_STR_RANGE_IMM		146
-#define INST_STR_RANGE			147
+#define INST_STR_MAP			131
+#define INST_STR_FIND			132
+#define INST_STR_FIND_LAST		133
+#define INST_STR_RANGE_IMM		134
+#define INST_STR_RANGE			135
 
 /* For operations to do with coroutines and other NRE-manipulators */
-#define INST_YIELD			148
-#define INST_COROUTINE_NAME		149
-#define INST_TAILCALL			150
+#define INST_YIELD			136
+#define INST_COROUTINE_NAME		137
+#define INST_TAILCALL			138
 
 /* For compilation of basic information operations */
-#define INST_NS_CURRENT			151
-#define INST_INFO_LEVEL_NUM		152
-#define INST_INFO_LEVEL_ARGS		153
-#define INST_RESOLVE_COMMAND		154
+#define INST_NS_CURRENT			139
+#define INST_INFO_LEVEL_NUM		140
+#define INST_INFO_LEVEL_ARGS		141
+#define INST_RESOLVE_COMMAND		142
 
 /* For compilation relating to TclOO */
-#define INST_TCLOO_SELF			155
-#define INST_TCLOO_CLASS		156
-#define INST_TCLOO_NS			157
-#define INST_TCLOO_IS_OBJECT		158
+#define INST_TCLOO_SELF			143
+#define INST_TCLOO_CLASS		144
+#define INST_TCLOO_NS			145
+#define INST_TCLOO_IS_OBJECT		146
 
 /* For compilation of [array] subcommands */
-#define INST_ARRAY_EXISTS_STK		159
-#define INST_ARRAY_EXISTS_IMM		160
-#define INST_ARRAY_MAKE_STK		161
-#define INST_ARRAY_MAKE_IMM		162
+#define INST_ARRAY_EXISTS_STK		147
+#define INST_ARRAY_EXISTS_IMM		148
+#define INST_ARRAY_MAKE_STK		149
+#define INST_ARRAY_MAKE_IMM		150
 
-#define INST_INVOKE_REPLACE		163
+#define INST_INVOKE_REPLACE		151
 
-#define INST_LIST_CONCAT		164
-
-#define INST_EXPAND_DROP		165
+#define INST_LIST_CONCAT		152
 
 /* New foreach implementation */
-#define INST_FOREACH_START              166
-#define INST_FOREACH_STEP               167
-#define INST_FOREACH_END                168
-#define INST_LMAP_COLLECT               169
+#define INST_FOREACH_START              153
+#define INST_FOREACH_STEP               154
+#define INST_FOREACH_END                155
+#define INST_LMAP_COLLECT               156
 
 /* For compilation of [string trim] and related */
-#define INST_STR_TRIM			170
-#define INST_STR_TRIM_LEFT		171
-#define INST_STR_TRIM_RIGHT		172
+#define INST_STR_TRIM			157
+#define INST_STR_TRIM_LEFT		158
+#define INST_STR_TRIM_RIGHT		159
 
-#define INST_CONCAT_STK			173
+#define INST_CONCAT_STK			160
 
-#define INST_STR_UPPER			174
-#define INST_STR_LOWER			175
-#define INST_STR_TITLE			176
-#define INST_STR_REPLACE		177
+#define INST_STR_UPPER			161
+#define INST_STR_LOWER			162
+#define INST_STR_TITLE			163
+#define INST_STR_REPLACE		164
 
-#define INST_ORIGIN_COMMAND		178
+#define INST_ORIGIN_COMMAND		165
 
-#define INST_TCLOO_NEXT			179
-#define INST_TCLOO_NEXT_CLASS		180
+#define INST_TCLOO_NEXT			166
+#define INST_TCLOO_NEXT_CLASS		167
 
-#define INST_YIELD_TO_INVOKE		181
+#define INST_YIELD_TO_INVOKE		168
 
-#define INST_NUM_TYPE			182
-#define INST_TRY_CVT_TO_BOOLEAN		183
-#define INST_STR_CLASS			184
+#define INST_NUM_TYPE			169
+#define INST_TRY_CVT_TO_BOOLEAN		170
+#define INST_STR_CLASS			171
 
-#define INST_LAPPEND_LIST		185
-#define INST_LAPPEND_LIST_ARRAY		186
-#define INST_LAPPEND_LIST_ARRAY_STK	187
-#define INST_LAPPEND_LIST_STK		188
+#define INST_LAPPEND_LIST		172
+#define INST_LAPPEND_LIST_ARRAY		173
+#define INST_LAPPEND_LIST_ARRAY_STK	174
+#define INST_LAPPEND_LIST_STK		175
+
+#define INST_CLEAR_RANGE		176
 
 /* The last opcode */
-#define LAST_INST_OPCODE		188
+#define LAST_INST_OPCODE		176
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -920,38 +803,15 @@ MODULE_SCOPE StringClassDesc const tclStringClassTable[];
  * commands between the jump and the target.
  */
 
-typedef enum {
-    TCL_UNCONDITIONAL_JUMP,
-    TCL_TRUE_JUMP,
-    TCL_FALSE_JUMP
-} TclJumpType;
-
-typedef struct JumpFixup {
-    TclJumpType jumpType;	/* Indicates the kind of jump. */
-    int codeOffset;		/* Offset of the first byte of the one-byte
-				 * forward jump's code. */
-    int cmdIndex;		/* Index of the first command after the one
-				 * for which the jump was emitted. Used to
-				 * update the code offsets for subsequent
-				 * commands if the two-byte jump at jumpPc
-				 * must be replaced with a five-byte one. */
-    int exceptIndex;		/* Index of the first range entry in the
-				 * ExceptionRange array after the current one.
-				 * This field is used to adjust the code
-				 * offsets in subsequent ExceptionRange
-				 * records when a jump is grown from 2 bytes
-				 * to 5 bytes. */
-} JumpFixup;
-
 #define JUMPFIXUP_INIT_ENTRIES	10
 
 typedef struct JumpFixupArray {
-    JumpFixup *fixup;		/* Points to start of jump fixup array. */
+    int *fixup;		        /* Points to start of codeOffset array. */
     int next;			/* Index of next free array entry. */
     int end;			/* Index of last usable entry in array. */
     int mallocedArray;		/* 1 if array was expanded and fixups points
 				 * into the heap, else 0. */
-    JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
+    int staticCodeOffsets[JUMPFIXUP_INIT_ENTRIES];
 				/* Initial storage for jump fixup array. */
 } JumpFixupArray;
 
@@ -980,19 +840,15 @@ typedef struct ForeachVarList {
  */
 
 typedef struct ForeachInfo {
+    int jumpSize;		/* Size of the jump between the the start of
+				 * the range and the continue target. */
     int numLists;		/* The number of both the variable and value
 				 * lists of the foreach command. */
-    int firstValueTemp;		/* Index of the first temp var in a proc frame
-				 * used to point to a value list. */
-    int loopCtTemp;		/* Index of temp var in a proc frame holding
-				 * the loop's iteration count. Used to
-				 * determine next value list element to assign
-				 * each loop var. */
     ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
 				 * structures describing each var list. The
 				 * actual size of this field will be large
-				 * enough to numVars indexes. THIS MUST BE THE
-				 * LAST FIELD IN THE STRUCTURE! */
+				 * enough contain to numLists structs. THIS
+				 * MUST BE THE LAST FIELD IN THE STRUCTURE! */
 } ForeachInfo;
 
 /*
@@ -1054,8 +910,7 @@ MODULE_SCOPE Tcl_ObjCmdProc	TclNRInterpCoroutine;
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-			    const CmdFrame *invoker, int word);
+MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
 
 /*
  *----------------------------------------------------------------
@@ -1068,8 +923,6 @@ 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);
 MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
 			    CompileEnv *envPtr);
@@ -1093,8 +946,7 @@ MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
 MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
 			    const AuxDataType *typePtr, CompileEnv *envPtr);
-MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
-			    CompileEnv *envPtr);
+MODULE_SCOPE int	TclCreateExceptRange(int type, CompileEnv *envPtr);
 MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
 MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, char *bytes,
 			    int length, unsigned int hash, int *newPtr,
@@ -1103,37 +955,25 @@ MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, char *bytes,
 MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
 MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
 			    LiteralTable *tablePtr);
-MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
-			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
 MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
-MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
-			    int catchOnly, ByteCode *codePtr);
+MODULE_SCOPE ExceptionRange * TclGetExceptionRange(int pcOffset, int catchOnly,
+	                    ExceptionRange *startPtr, ExceptionRange *endPtr);
 MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
 MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
 			    ByteCode *codePtr);
 MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
 MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
 			    int create, CompileEnv *envPtr);
-MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
-			    JumpFixup *jumpFixupPtr, int jumpDist,
-			    int distThreshold);
 MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
 MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
 MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
 			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
 			    CompileEnv *envPtr, const char *string,
-			    int numBytes, const CmdFrame *invoker, int word);
+			    int numBytes);
 MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
 MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
-MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
-			    int returnCode, ExceptionAux **auxPtrPtr);
-MODULE_SCOPE void	TclAddLoopBreakFixup(CompileEnv *envPtr,
-			    ExceptionAux *auxPtr);
-MODULE_SCOPE void	TclAddLoopContinueFixup(CompileEnv *envPtr,
-			    ExceptionAux *auxPtr);
-MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
-			    int range);
+
 #ifdef TCL_COMPILE_STATS
 MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
 MODULE_SCOPE int	TclLog2(int value);
@@ -1182,13 +1022,12 @@ MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
 			    const char *script, const char *command,
 			    int length, const unsigned char *pc,
 			    Tcl_Obj **tosPtr);
-MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
-			    const unsigned char *pc, Tcl_Obj **tosPtr);
 MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 			    register Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], int isLambda);
 
+MODULE_SCOPE int        NRCommand(ClientData data[], Tcl_Interp *interp, int result);
 
 /*
  *----------------------------------------------------------------
@@ -1286,18 +1125,6 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 	}							\
     } while (0)
 
-/*
- * Macros used to update the flag that indicates if we are at the start of a
- * command, based on whether the opcode is INST_START_COMMAND.
- *
- * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
- */
-
-#define TclUpdateAtCmdStart(op, envPtr) \
-    if ((envPtr)->atCmdStart < 2) {				     \
-	(envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0);     \
-    }
-
 /*
  * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
  * "prototype" for this macro is:
@@ -1311,7 +1138,6 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 	    TclExpandCodeArray(envPtr);				\
 	}							\
 	*(envPtr)->codeNext++ = (unsigned char) (op);		\
-	TclUpdateAtCmdStart(op, envPtr);			\
 	TclUpdateStackReqs(op, 0, envPtr);			\
     } while (0)
 
@@ -1363,7 +1189,6 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 	}								\
 	*(envPtr)->codeNext++ = (unsigned char) (op);			\
 	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
-	TclUpdateAtCmdStart(op, envPtr);				\
 	TclUpdateStackReqs(op, i, envPtr);				\
     } while (0)
 
@@ -1381,7 +1206,6 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 		(unsigned char) ((unsigned int) (i) >>  8);	\
 	*(envPtr)->codeNext++ =					\
 		(unsigned char) ((unsigned int) (i)      );	\
-	TclUpdateAtCmdStart(op, envPtr);			\
 	TclUpdateStackReqs(op, i, envPtr);			\
     } while (0)
 
@@ -1397,11 +1221,7 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 #define TclEmitPush(objIndex, envPtr) \
     do {							 \
 	register int objIndexCopy = (objIndex);			 \
-	if (objIndexCopy <= 255) {				 \
-	    TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
-	} else {						 \
-	    TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
-	}							 \
+	TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr));	 \
     } while (0)
 
 /*
@@ -1454,10 +1274,30 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
  *				 int threshold);
  */
 
-#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
-    TclFixupForwardJump((envPtr), (fixupPtr),				\
-	    (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
-	    (threshold))
+#define TclEmitForwardJump(envPtr, type, pcPtr)			\
+    *(pcPtr) = (envPtr)->codeNext - (envPtr)->codeStart;	\
+    TclEmitInstInt4(INST_##type##4, 0, (envPtr))
+
+#define TclEmitForwardJump1(envPtr, type, pcPtr)		\
+    *(pcPtr) = (envPtr)->codeNext - (envPtr)->codeStart;	\
+    TclEmitInstInt1(INST_##type##1, 0, (envPtr))
+
+#define TclFixupForwardJump(envPtr, pc, jumpDist)	\
+    TclStoreInt4AtPtr((jumpDist), (envPtr)->codeStart + (pc) + 1)
+
+#define TclFixupForwardJump1(envPtr, pc, jumpDist)			\
+    if (((jumpDist) > 127) && ((jumpDist) < -127)) {			\
+        Tcl_Panic("TclFixupForwardJump1: bad jump distance %li", jumpDist); \
+    }									\
+    TclStoreInt1AtPtr((jumpDist), (envPtr)->codeStart + (pc) + 1)
+
+#define TclFixupForwardJumpToHere(envPtr, fixup)		\
+    TclFixupForwardJump((envPtr), (fixup),			\
+	    (envPtr)->codeNext-(envPtr)->codeStart-(fixup))
+
+#define TclFixupForwardJumpToHere1(envPtr, fixup)			\
+    TclFixupForwardJump1((envPtr), (fixup),				\
+	    (envPtr)->codeNext-(envPtr)->codeStart-(fixup))
 
 /*
  * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
@@ -1502,6 +1342,37 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 		    (*((p)+2) <<  8) |				\
 		    (*((p)+3)))
 
+/*
+ * Override TclGetUInt4AtPtr or TclGetInt4AtPtr macros if
+ * a known better version exists.
+ */
+#ifdef WORDS_BIGENDIAN
+#define OVERRIDE_INT4(i) (i)
+#elif defined(__GNUC__) && (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 3))
+#define OVERRIDE_INT4(i) __builtin_bswap32(i)
+#elif defined(_MSC_VER) && _MSC_VER>=1300
+#define OVERRIDE_INT4(i) _byteswap_ulong(i)
+#endif
+
+#ifdef OVERRIDE_INT4
+#undef TclGetUInt4AtPtr
+static inline unsigned int
+TclGetUInt4AtPtr(const unsigned char *p)
+{
+    uint32_t i;
+    memcpy(&i,p,4);
+    return OVERRIDE_INT4(i);
+}
+#undef TclGetInt4AtPtr
+static inline signed int
+TclGetInt4AtPtr(const unsigned char *p)
+{
+    int32_t i;
+    memcpy(&i,p,4);
+    return OVERRIDE_INT4(i);
+}
+#endif /* OVERRIDE_INT4 */
+
 /*
  * Macros used to compute the minimum and maximum of two integers. The ANSI C
  * "prototypes" for these macros are:
@@ -1521,7 +1392,6 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
  */
 
 #define BODY(tokenPtr, word)						\
-    SetLineInformation((word));						\
     TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents,	\
 	    envPtr)
 
@@ -1572,28 +1442,42 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
     ((envPtr)->codeNext - (envPtr)->codeStart)
 
 /*
- * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
- * maximal depth of nested CATCH ranges in order to alloc runtime
- * memory. These macros should compute precisely that? OTOH, the nesting depth
- * of LOOP ranges is an interesting datum for debugging purposes, and that is
- * what we compute now.
- *
  * static int	ExceptionRangeStarts(CompileEnv *envPtr, int index);
  * static void	ExceptionRangeEnds(CompileEnv *envPtr, int index);
  * static void	ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
  */
 
-#define ExceptionRangeStarts(envPtr, index) \
-    (((envPtr)->exceptDepth++),						\
-    ((envPtr)->maxExceptDepth =						\
-	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)),	\
+#define ExceptionRangeStarts(envPtr, index)				\
+    (((envPtr)->exceptArrayPtr[(index)].stackDepth = (envPtr)->currStackDepth), \
+    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = ~(envPtr)->expandDepth), \
     ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
-#define ExceptionRangeEnds(envPtr, index) \
-    (((envPtr)->exceptDepth--),						\
+
+#define ExceptionRangeEnds(envPtr, index)				\
     ((envPtr)->exceptArrayPtr[(index)].numCodeBytes =			\
-	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
-#define ExceptionRangeTarget(envPtr, index, targetType) \
-    ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
+	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset)
+
+#define CatchTarget(envPtr, index)					\
+    do {								\
+	ExceptionRange *rPtr = &(envPtr)->exceptArrayPtr[(index)];	\
+	(envPtr)->currStackDepth = rPtr->stackDepth + 1 +		\
+	    ((rPtr->flags&CATCH_PUSH_RESULT)? 1 : 0) +			\
+	    ((rPtr->flags&CATCH_PUSH_OPTIONS)? 1 : 0);			\
+	rPtr->mainOffset = CurrentOffset(envPtr);			\
+    } while (0)
+
+#define BreakTarget(envPtr, index)					\
+    do {								\
+	ExceptionRange *rPtr = &(envPtr)->exceptArrayPtr[(index)];	\
+	(envPtr)->currStackDepth = rPtr->stackDepth;			\
+	rPtr->mainOffset = CurrentOffset(envPtr);			\
+    } while (0)
+
+#define ContinueTarget(envPtr, index)					\
+    do {								\
+	ExceptionRange *rPtr = &(envPtr)->exceptArrayPtr[(index)];	\
+	(envPtr)->currStackDepth = rPtr->stackDepth;			\
+	rPtr->continueOffset = CurrentOffset(envPtr);			\
+    } while (0)
 
 /*
  * Check if there is an LVT for compiled locals
@@ -1620,35 +1504,13 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
  *			    Tcl_Interp *interp, int word);
  */
 
-#define CompileWord(envPtr, tokenPtr, interp, word) \
+#define CompileWord(envPtr, tokenPtr, interp) \
     if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) {			\
 	PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size);	\
     } else {								\
-	SetLineInformation((word));					\
 	CompileTokens((envPtr), (tokenPtr), (interp));			\
     }
 
-/*
- * TIP #280: Remember the per-word line information of the current command. An
- * index is used instead of a pointer as recursive compilation may reallocate,
- * i.e. move, the array. This is also the reason to save the nuloc now, it may
- * change during the course of the function.
- *
- * Macro to encapsulate the variable definition and setup.
- */
-
-#define DefineLineInformation \
-    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
-    int eclIndex = mapPtr->nuloc - 1
-
-#define SetLineInformation(word) \
-    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
-    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
-
-#define PushVarNameWord(i,v,e,f,l,sc,word) \
-    SetLineInformation(word);						\
-    TclPushVarName(i,v,e,f,l,sc)
-
 /*
  * Often want to issue one of two versions of an instruction based on whether
  * the argument will fit in a single byte or not. This makes it much clearer.

generic/tclDecls.h

@@ -235,9 +235,7 @@ EXTERN void		Tcl_AddObjErrorInfo(Tcl_Interp *interp,
 				const char *message, int length);
 /* 68 */
 EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
-/* 69 */
-EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
-				const char *element);
+/* Slot 69 is reserved */
 /* 70 */
 EXTERN void		Tcl_AppendResult(Tcl_Interp *interp, ...);
 /* 71 */
@@ -454,8 +452,7 @@ EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
 				Tcl_HashSearch *searchPtr);
 /* 146 */
 EXTERN int		Tcl_Flush(Tcl_Channel chan);
-/* 147 */
-EXTERN void		Tcl_FreeResult(Tcl_Interp *interp);
+/* Slot 147 is reserved */
 /* 148 */
 EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
 				const char *slaveCmd,
@@ -1516,9 +1513,7 @@ EXTERN int		Tcl_LimitReady(Tcl_Interp *interp);
 EXTERN int		Tcl_LimitCheck(Tcl_Interp *interp);
 /* 524 */
 EXTERN int		Tcl_LimitExceeded(Tcl_Interp *interp);
-/* 525 */
-EXTERN void		Tcl_LimitSetCommands(Tcl_Interp *interp,
-				int commandLimit);
+/* Slot 525 is reserved */
 /* 526 */
 EXTERN void		Tcl_LimitSetTime(Tcl_Interp *interp,
 				Tcl_Time *timeLimitPtr);
@@ -1533,8 +1528,7 @@ EXTERN int		Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type);
 EXTERN void		Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
 /* 531 */
 EXTERN void		Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
-/* 532 */
-EXTERN int		Tcl_LimitGetCommands(Tcl_Interp *interp);
+/* Slot 532 is reserved */
 /* 533 */
 EXTERN void		Tcl_LimitGetTime(Tcl_Interp *interp,
 				Tcl_Time *timeLimitPtr);
@@ -1700,7 +1694,7 @@ EXTERN int		Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd,
 EXTERN void		Tcl_NRAddCallback(Tcl_Interp *interp,
 				Tcl_NRPostProc *postProcPtr,
 				ClientData data0, ClientData data1,
-				ClientData data2, ClientData data3);
+				ClientData data2);
 /* 588 */
 EXTERN int		Tcl_NRCallObjProc(Tcl_Interp *interp,
 				Tcl_ObjCmdProc *objProc,
@@ -1912,7 +1906,7 @@ typedef struct TclStubs {
     void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
     void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
     void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
-    void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
+    void (*reserved69)(void);
     void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
     Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
     void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
@@ -1990,7 +1984,7 @@ typedef struct TclStubs {
     void (*tcl_FindExecutable) (const char *argv0); /* 144 */
     Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
     int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
-    void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
+    void (*reserved147)(void);
     int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
     int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
     ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
@@ -2376,14 +2370,14 @@ typedef struct TclStubs {
     int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
     int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */
     int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */
-    void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */
+    void (*reserved525)(void);
     void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */
     void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity); /* 527 */
     int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type); /* 528 */
     int (*tcl_LimitTypeExceeded) (Tcl_Interp *interp, int type); /* 529 */
     void (*tcl_LimitTypeSet) (Tcl_Interp *interp, int type); /* 530 */
     void (*tcl_LimitTypeReset) (Tcl_Interp *interp, int type); /* 531 */
-    int (*tcl_LimitGetCommands) (Tcl_Interp *interp); /* 532 */
+    void (*reserved532)(void);
     void (*tcl_LimitGetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 533 */
     int (*tcl_LimitGetGranularity) (Tcl_Interp *interp, int type); /* 534 */
     Tcl_InterpState (*tcl_SaveInterpState) (Tcl_Interp *interp, int status); /* 535 */
@@ -2438,7 +2432,7 @@ typedef struct TclStubs {
     int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */
     int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */
     int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */
-    void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */
+    void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2); /* 587 */
     int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */
     unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */
     unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */
@@ -2646,8 +2640,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
 #define Tcl_AllowExceptions \
 	(tclStubsPtr->tcl_AllowExceptions) /* 68 */
-#define Tcl_AppendElement \
-	(tclStubsPtr->tcl_AppendElement) /* 69 */
+/* Slot 69 is reserved */
 #define Tcl_AppendResult \
 	(tclStubsPtr->tcl_AppendResult) /* 70 */
 #define Tcl_AsyncCreate \
@@ -2802,8 +2795,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
 #define Tcl_Flush \
 	(tclStubsPtr->tcl_Flush) /* 146 */
-#define Tcl_FreeResult \
-	(tclStubsPtr->tcl_FreeResult) /* 147 */
+/* Slot 147 is reserved */
 #define Tcl_GetAlias \
 	(tclStubsPtr->tcl_GetAlias) /* 148 */
 #define Tcl_GetAliasObj \
@@ -3562,8 +3554,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_LimitCheck) /* 523 */
 #define Tcl_LimitExceeded \
 	(tclStubsPtr->tcl_LimitExceeded) /* 524 */
-#define Tcl_LimitSetCommands \
-	(tclStubsPtr->tcl_LimitSetCommands) /* 525 */
+/* Slot 525 is reserved */
 #define Tcl_LimitSetTime \
 	(tclStubsPtr->tcl_LimitSetTime) /* 526 */
 #define Tcl_LimitSetGranularity \
@@ -3576,8 +3567,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_LimitTypeSet) /* 530 */
 #define Tcl_LimitTypeReset \
 	(tclStubsPtr->tcl_LimitTypeReset) /* 531 */
-#define Tcl_LimitGetCommands \
-	(tclStubsPtr->tcl_LimitGetCommands) /* 532 */
+/* Slot 532 is reserved */
 #define Tcl_LimitGetTime \
 	(tclStubsPtr->tcl_LimitGetTime) /* 533 */
 #define Tcl_LimitGetGranularity \

generic/tclDictObj.c

@@ -2357,11 +2357,11 @@ DictForNRCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Interp *iPtr = (Interp *) interp;
     Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
     Tcl_Obj **varv, *keyObj, *valueObj;
     Tcl_DictSearch *searchPtr;
     int varc, done;
+    ClientData *extra;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -2428,9 +2428,12 @@ DictForNRCmd(
      * Run the script.
      */
 
+    NRE_newExtra(extra);
+    extra[0] = valueVarObj;
+    extra[1] = scriptObj;
     TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
-	    valueVarObj, scriptObj);
-    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+	    extra);
+    return TclNREvalObjEx(interp, scriptObj, 0);
 
     /*
      * For unwinding everything on error.
@@ -2451,14 +2454,16 @@ DictForLoopCallback(
     Tcl_Interp *interp,
     int result)
 {
-    Interp *iPtr = (Interp *) interp;
     Tcl_DictSearch *searchPtr = data[0];
     Tcl_Obj *keyVarObj = data[1];
-    Tcl_Obj *valueVarObj = data[2];
-    Tcl_Obj *scriptObj = data[3];
+    ClientData *extra = data[2];
+    Tcl_Obj *valueVarObj = extra[0];
+    Tcl_Obj *scriptObj = extra[1];
     Tcl_Obj *keyObj, *valueObj;
     int done;
 
+    NRE_freeExtra(extra);
+    
     /*
      * Process the result from the previous execution of the script body.
      */
@@ -2510,9 +2515,12 @@ DictForLoopCallback(
      * Run the script.
      */
 
+    NRE_newExtra(extra);
+    extra[0] = valueVarObj;
+    extra[1] = scriptObj;
     TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
-	    valueVarObj, scriptObj);
-    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+	    extra);
+    return TclNREvalObjEx(interp, scriptObj, 0);
 
     /*
      * For unwinding everything once the iterating is done.
@@ -2524,7 +2532,7 @@ DictForLoopCallback(
     TclDecrRefCount(scriptObj);
     Tcl_DictObjDone(searchPtr);
     TclStackFree(interp, searchPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -2552,7 +2560,6 @@ DictMapNRCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Interp *iPtr = (Interp *) interp;
     Tcl_Obj **varv, *keyObj, *valueObj;
     DictMapStorage *storagePtr;
     int varc, done;
@@ -2631,9 +2638,8 @@ DictMapNRCmd(
      * Run the script.
      */
 
-    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
-    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
-	    iPtr->cmdFramePtr, 3);
+    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL);
+    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0);
 
     /*
      * For unwinding everything on error.
@@ -2655,7 +2661,6 @@ DictMapLoopCallback(
     Tcl_Interp *interp,
     int result)
 {
-    Interp *iPtr = (Interp *) interp;
     DictMapStorage *storagePtr = data[0];
     Tcl_Obj *keyObj, *valueObj;
     int done;
@@ -2721,9 +2726,8 @@ DictMapLoopCallback(
      * Run the script.
      */
 
-    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
-    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
-	    iPtr->cmdFramePtr, 3);
+    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL);
+    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0);
 
     /*
      * For unwinding everything once the iterating is done.
@@ -2736,7 +2740,7 @@ DictMapLoopCallback(
     TclDecrRefCount(storagePtr->accumulatorObj);
     Tcl_DictObjDone(&storagePtr->search);
     TclStackFree(interp, storagePtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -2883,7 +2887,6 @@ DictFilterCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Interp *iPtr = (Interp *) interp;
     static const char *const filters[] = {
 	"key", "script", "value", NULL
     };
@@ -3068,7 +3071,7 @@ DictFilterCmd(
 	     * TIP #280. Make invoking context available to loop body.
 	     */
 
-	    result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 4);
+	    result = Tcl_EvalObjEx(interp, scriptObj, 0);
 	    switch (result) {
 	    case TCL_OK:
 		boolObj = Tcl_GetObjResult(interp);
@@ -3167,7 +3170,6 @@ DictUpdateCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Interp *iPtr = (Interp *) interp;
     Tcl_Obj *dictPtr, *objPtr;
     int i, dummy;
 
@@ -3209,9 +3211,9 @@ DictUpdateCmd(
     objPtr = Tcl_NewListObj(objc-3, objv+2);
     Tcl_IncrRefCount(objPtr);
     Tcl_IncrRefCount(objv[1]);
-    TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
+    TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL);
 
-    return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+    return TclNREvalObjEx(interp, objv[objc-1], 0);
 }
 
 static int
@@ -3242,7 +3244,7 @@ FinalizeDictUpdate(
     if (dictPtr == NULL) {
 	TclDecrRefCount(varName);
 	TclDecrRefCount(argsObj);
-	return result;
+	NRE_NEXT(result);
     }
 
     /*
@@ -3254,7 +3256,7 @@ FinalizeDictUpdate(
 	Tcl_DiscardInterpState(state);
 	TclDecrRefCount(varName);
 	TclDecrRefCount(argsObj);
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
 
     if (Tcl_IsShared(dictPtr)) {
@@ -3293,7 +3295,7 @@ FinalizeDictUpdate(
 	    TCL_LEAVE_ERR_MSG) == NULL) {
 	Tcl_DiscardInterpState(state);
 	TclDecrRefCount(varName);
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
 
     TclDecrRefCount(varName);
@@ -3325,7 +3327,6 @@ DictWithCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Interp *iPtr = (Interp *) interp;
     Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
 
     if (objc < 3) {
@@ -3359,10 +3360,9 @@ DictWithCmd(
 	Tcl_IncrRefCount(pathPtr);
     }
     Tcl_IncrRefCount(objv[1]);
-    TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
-	    NULL);
+    TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr);
 
-    return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+    return TclNREvalObjEx(interp, objv[objc-1], 0);
 }
 
 static int
@@ -3420,7 +3420,7 @@ FinalizeDictWith(
     }
     if (result != TCL_OK) {
 	Tcl_DiscardInterpState(state);
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
     return Tcl_RestoreInterpState(interp, state);
 }

generic/tclDisassemble.c

@@ -21,15 +21,9 @@
  * Prototypes for procedures defined later in this file:
  */
 
-static Tcl_Obj *	DisassembleByteCodeAsDicts(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
-static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
+static Tcl_Obj *	DisassembleByteCodeAsDicts(Tcl_Obj *objPtr);
 static int		FormatInstruction(ByteCode *codePtr,
 			    const unsigned char *pc, Tcl_Obj *bufferObj);
-static void		GetLocationInformation(Tcl_Interp *interp,
-			    Proc *procPtr, Tcl_Obj **fileObjPtr,
-			    int *linePtr);
 static void		PrintSourceToObj(Tcl_Obj *appendObj,
 			    const char *stringPtr, int maxChars);
 static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
@@ -54,57 +48,6 @@ static const Tcl_ObjType tclInstNameType = {
 #define BYTECODE(objPtr)					\
     ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1)
 
-/*
- *----------------------------------------------------------------------
- *
- * GetLocationInformation --
- *
- *	This procedure looks up the information about where a procedure was
- *	originally declared.
- *
- * Results:
- *	Writes to the variables pointed at by fileObjPtr and linePtr.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-GetLocationInformation(
-    Tcl_Interp *interp,		/* Where to look up the location
-				 * information. */
-    Proc *procPtr,		/* What to look up the information for. */
-    Tcl_Obj **fileObjPtr,	/* Where to write the information about what
-				 * file the code came from. Will be written
-				 * to, either with the object (assume shared!)
-				 * that describes what the file was, or with
-				 * NULL if the information is not
-				 * available. */
-    int *linePtr)		/* Where to write the information about what
-				 * line number represented the start of the
-				 * code in question. Will be written to,
-				 * either with the line number or with -1 if
-				 * the information is not available. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr;
-    CmdFrame *cfPtr;
-
-    *fileObjPtr = NULL;
-    *linePtr = -1;
-    if (iPtr != NULL && procPtr != NULL) {
-	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, procPtr);
-	if (hePtr != NULL && (cfPtr = Tcl_GetHashValue(hePtr)) != NULL) {
-	    *linePtr = cfPtr->line[0];
-	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-		*fileObjPtr = cfPtr->data.eval.path;
-	    }
-	}
-    }
-}
-
 #ifdef TCL_COMPILE_DEBUG
 /*
  *----------------------------------------------------------------------
@@ -125,10 +68,10 @@ GetLocationInformation(
 
 void
 TclPrintByteCodeObj(
-    Tcl_Interp *interp,		/* Used only for getting location info. */
+    Tcl_Interp *interp,		/* Used only for Tcl_GetStringFromObj. */
     Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
 {
-    Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr);
+    Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);
 
     fprintf(stdout, "\n%s", TclGetString(bufPtr));
     Tcl_DecrRefCount(bufPtr);
@@ -233,7 +176,7 @@ TclPrintSource(
 /*
  *----------------------------------------------------------------------
  *
- * DisassembleByteCodeObj --
+ * TclDisassembleByteCodeObj --
  *
  *	Given an object which is of bytecode type, return a disassembled
  *	version of the bytecode (in a new refcount 0 object). No guarantees
@@ -242,18 +185,17 @@ TclPrintSource(
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj *
-DisassembleByteCodeObj(
-    Tcl_Interp *interp,
+Tcl_Obj *
+TclDisassembleByteCodeObj(
     Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
 {
     ByteCode *codePtr = BYTECODE(objPtr);
     unsigned char *codeStart, *codeLimit, *pc;
     unsigned char *codeDeltaNext, *codeLengthNext;
     unsigned char *srcDeltaNext, *srcLengthNext;
-    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
+    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
-    Tcl_Obj *bufferObj, *fileObj;
+    Tcl_Obj *bufferObj;
     char ptrBuf1[20], ptrBuf2[20];
 
     TclNewObj(bufferObj);
@@ -278,11 +220,6 @@ DisassembleByteCodeObj(
     Tcl_AppendToObj(bufferObj, "  Source ", -1);
     PrintSourceToObj(bufferObj, codePtr->source,
 	    TclMin(codePtr->numSrcBytes, 55));
-    GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
-    if (line > -1 && fileObj != NULL) {
-	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
-		Tcl_GetString(fileObj), line);
-    }
     Tcl_AppendPrintfToObj(bufferObj,
 	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
 	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
@@ -349,29 +286,24 @@ DisassembleByteCodeObj(
      */
 
     if (codePtr->numExceptRanges > 0) {
-	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
-		codePtr->numExceptRanges, codePtr->maxExceptDepth);
+	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d\n",
+		codePtr->numExceptRanges);
 	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
 	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
 
 	    Tcl_AppendPrintfToObj(bufferObj,
-		    "      %d: level %d, %s, pc %d-%d, ",
-		    i, rangePtr->nestingLevel,
-		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
+		    "      %d: %s, pc %d-%d, stkDepth %d, ",
+		    i,
+		    (IS_CATCH_RANGE(rangePtr) ? "catch" : "loop"),
 		    rangePtr->codeOffset,
-		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
-	    switch (rangePtr->type) {
-	    case LOOP_EXCEPTION_RANGE:
-		Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
-			rangePtr->continueOffset, rangePtr->breakOffset);
-		break;
-	    case CATCH_EXCEPTION_RANGE:
+		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1),
+		    rangePtr->stackDepth);
+	    if (IS_CATCH_RANGE(rangePtr)) {
 		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
-			rangePtr->catchOffset);
-		break;
-	    default:
-		Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
-			rangePtr->type);
+			rangePtr->mainOffset);
+	    } else {
+		Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
+			rangePtr->continueOffset, rangePtr->mainOffset);
 	    }
 	}
     }
@@ -565,10 +497,6 @@ FormatInstruction(
 	    break;
 	case OPERAND_UINT4:
 	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
-	    if (opCode == INST_START_CMD) {
-		sprintf(suffixBuffer+strlen(suffixBuffer),
-			", %u cmds start here", opnd);
-	    }
 	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
 	    break;
 	case OPERAND_OFFSET1:
@@ -578,11 +506,7 @@ FormatInstruction(
 	    break;
 	case OPERAND_OFFSET4:
 	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
-	    if (opCode == INST_START_CMD) {
-		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
-	    } else {
-		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
-	    }
+	    sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
 	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
 	    break;
 	case OPERAND_LIT1:
@@ -668,124 +592,6 @@ FormatInstruction(
     return numBytes;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * TclGetInnerContext --
- *
- *	If possible, returns a list capturing the inner context. Otherwise
- *	return NULL.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclGetInnerContext(
-    Tcl_Interp *interp,
-    const unsigned char *pc,
-    Tcl_Obj **tosPtr)
-{
-    int objc = 0, off = 0;
-    Tcl_Obj *result;
-    Interp *iPtr = (Interp *) interp;
-
-    switch (*pc) {
-    case INST_STR_LEN:
-    case INST_LNOT:
-    case INST_BITNOT:
-    case INST_UMINUS:
-    case INST_UPLUS:
-    case INST_TRY_CVT_TO_NUMERIC:
-    case INST_EXPAND_STKTOP:
-    case INST_EXPR_STK:
-        objc = 1;
-        break;
-
-    case INST_LIST_IN:
-    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
-    case INST_STR_EQ:
-    case INST_STR_NEQ:		/* String (in)equality check */
-    case INST_STR_CMP:		/* String compare. */
-    case INST_STR_INDEX:
-    case INST_STR_MATCH:
-    case INST_REGEXP:
-    case INST_EQ:
-    case INST_NEQ:
-    case INST_LT:
-    case INST_GT:
-    case INST_LE:
-    case INST_GE:
-    case INST_MOD:
-    case INST_LSHIFT:
-    case INST_RSHIFT:
-    case INST_BITOR:
-    case INST_BITXOR:
-    case INST_BITAND:
-    case INST_EXPON:
-    case INST_ADD:
-    case INST_SUB:
-    case INST_DIV:
-    case INST_MULT:
-        objc = 2;
-        break;
-
-    case INST_RETURN_STK:
-        /* early pop. TODO: dig out opt dict too :/ */
-        objc = 1;
-        break;
-
-    case INST_SYNTAX:
-    case INST_RETURN_IMM:
-        objc = 2;
-        break;
-
-    case INST_INVOKE_STK4:
-	objc = TclGetUInt4AtPtr(pc+1);
-        break;
-
-    case INST_INVOKE_STK1:
-	objc = TclGetUInt1AtPtr(pc+1);
-	break;
-    }
-
-    result = iPtr->innerContext;
-    if (Tcl_IsShared(result)) {
-        Tcl_DecrRefCount(result);
-        iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
-        Tcl_IncrRefCount(result);
-    } else {
-        int len;
-
-        /*
-         * Reset while keeping the list intrep as much as possible.
-         */
-
-	Tcl_ListObjLength(interp, result, &len);
-        Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
-    }
-    Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
-
-    for (; objc>0 ; objc--) {
-        Tcl_Obj *objPtr;
-
-        objPtr = tosPtr[1 - objc + off];
-        if (!objPtr) {
-            Tcl_Panic("InnerContext: bad tos -- appending null object");
-        }
-        if ((objPtr->refCount<=0)
-#ifdef TCL_MEM_DEBUG
-                || (objPtr->refCount==0x61616161)
-#endif
-        ) {
-            Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
-                    objPtr);
-        }
-        Tcl_ListObjAppendElement(NULL, result, objPtr);
-    }
-
-    return result;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -944,16 +750,14 @@ PrintSourceToObj(
 
 static Tcl_Obj *
 DisassembleByteCodeAsDicts(
-    Tcl_Interp *interp,		/* Used for looking up the CmdFrame for the
-				 * procedure, if one exists. */
     Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
 {
     ByteCode *codePtr = BYTECODE(objPtr);
     Tcl_Obj *description, *literals, *variables, *instructions, *inst;
-    Tcl_Obj *aux, *exn, *commands, *file;
+    Tcl_Obj *aux, *exn, *commands;
     unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
     int codeOffset, codeLength, sourceOffset, sourceLength;
-    int i, val, line;
+    int i, val;
 
     /*
      * Get the literals from the bytecode.
@@ -1148,21 +952,18 @@ DisassembleByteCodeAsDicts(
     for (i=0 ; i<codePtr->numExceptRanges ; i++) {
 	ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
 
-	switch (rangePtr->type) {
-	case LOOP_EXCEPTION_RANGE:
+	if (IS_CATCH_RANGE(rangePtr)) {
 	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
-		    "type %s level %d from %d to %d break %d continue %d",
-		    "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
+		    "type %s from %d to %d catch %d",
+		    "catch", rangePtr->codeOffset,
 		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
-		    rangePtr->breakOffset, rangePtr->continueOffset));
-	    break;
-	case CATCH_EXCEPTION_RANGE:
+		    rangePtr->mainOffset));
+	} else {
 	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
-		    "type %s level %d from %d to %d catch %d",
-		    "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
+		    "type %s from %d to %d break %d continue %d",
+		    "loop", rangePtr->codeOffset,
 		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
-		    rangePtr->catchOffset));
-	    break;
+		    rangePtr->mainOffset, rangePtr->continueOffset));
 	}
     }
 
@@ -1216,13 +1017,6 @@ DisassembleByteCodeAsDicts(
 
 #undef Decode
 
-    /*
-     * Get the source file and line number information from the CmdFrame
-     * system if it is available.
-     */
-
-    GetLocationInformation(interp, codePtr->procPtr, &file, &line);
-
     /*
      * Build the overall result.
      */
@@ -1244,17 +1038,6 @@ DisassembleByteCodeAsDicts(
 	    Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
     Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1),
 	    Tcl_NewIntObj(codePtr->maxStackDepth));
-    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1),
-	    Tcl_NewIntObj(codePtr->maxExceptDepth));
-    if (line > -1) {
-	Tcl_DictObjPut(NULL, description,
-		Tcl_NewStringObj("initiallinenumber", -1),
-		Tcl_NewIntObj(line));
-    }
-    if (file) {
-	Tcl_DictObjPut(NULL, description,
-		Tcl_NewStringObj("sourcefile", -1), file);
-    }
     return description;
 }
 
@@ -1484,11 +1267,9 @@ Tcl_DisassembleObjCmd(
 	return TCL_ERROR;
     }
     if (PTR2INT(clientData)) {
-	Tcl_SetObjResult(interp,
-		DisassembleByteCodeAsDicts(interp, codeObjPtr));
+	Tcl_SetObjResult(interp, DisassembleByteCodeAsDicts(codeObjPtr));
     } else {
-	Tcl_SetObjResult(interp,
-		DisassembleByteCodeObj(interp, codeObjPtr));
+	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
     }
     return TCL_OK;
 }

generic/tclEnsemble.c

@@ -1882,8 +1882,7 @@ NsEnsembleImplementationCmdNR(
 		    2 + ensemblePtr->numParameters;
 	    iPtr->ensembleRewrite.numInsertedObjs =
 		    prefixObjc + ensemblePtr->numParameters;
-	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
-		    NULL);
+	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL);
 	} else {
 	    register int ni = 2 + ensemblePtr->numParameters
 		    - iPtr->ensembleRewrite.numInsertedObjs;
@@ -1902,7 +1901,7 @@ NsEnsembleImplementationCmdNR(
 	 */
 
 	TclSkipTailcall(interp);
-	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
+	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE);
     }
 
   unknownOrAmbiguousSubcommand:
@@ -1971,7 +1970,7 @@ TclClearRootEnsemble(
     int result)
 {
     TclResetRewriteEnsemble(interp, 1);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -2749,7 +2748,6 @@ TclCompileEnsemble(
     int ourResult = TCL_ERROR;
     unsigned numBytes;
     const char *word;
-    DefineLineInformation;
 
     Tcl_IncrRefCount(replaced);
     if (parsePtr->numWords < depth + 1) {
@@ -3008,23 +3006,6 @@ TclCompileEnsemble(
 	goto cleanup;
     }
 
-    /*
-     * Throw out any line information generated by the failed compile attempt.
-     */
-
-    while (mapPtr->nuloc - 1 > eclIndex) {
-        mapPtr->nuloc--;
-        ckfree(mapPtr->loc[mapPtr->nuloc].line);
-        mapPtr->loc[mapPtr->nuloc].line = NULL;
-    }
-
-    /*
-     * Reset the index of next command.  Toss out any from failed nested
-     * partial compiles.
-     */
-
-    envPtr->numCommands = mapPtr->nuloc;
-
     /*
      * Failed to do a full compile for some reason. Try to do a direct invoke
      * instead of going through the ensemble lookup process again.
@@ -3082,7 +3063,6 @@ TclAttemptCompileProc(
     Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
     int savedStackDepth = envPtr->currStackDepth;
     unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
-    DefineLineInformation;
 
     if (cmdPtr->compileProc == NULL) {
 	return TCL_ERROR;
@@ -3100,27 +3080,12 @@ TclAttemptCompileProc(
     }
     parsePtr->numWords -= (depth - 1);
 
-    /*
-     * Shift the line information arrays to account for different word
-     * index values.
-     */
-
-    mapPtr->loc[eclIndex].line += (depth - 1);
-    mapPtr->loc[eclIndex].next += (depth - 1);
-
     /*
      * Hand off compilation to the subcommand compiler. At last!
      */
 
     result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);
 
-    /*
-     * Undo the shift.
-     */
-
-    mapPtr->loc[eclIndex].line -= (depth - 1);
-    mapPtr->loc[eclIndex].next -= (depth - 1);
-
     parsePtr->numWords += (depth - 1);
     parsePtr->tokenPtr = saveTokenPtr;
 
@@ -3172,7 +3137,6 @@ CompileToInvokedCommand(
     Tcl_Obj *objPtr, **words;
     char *bytes;
     int length, i, numWords, cmdLit;
-    DefineLineInformation;
 
     /*
      * Push the words of the command. Take care; the command words may be
@@ -3189,17 +3153,9 @@ CompileToInvokedCommand(
 	    continue;
 	}
 
-	SetLineInformation(i);
 	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	    int literal = TclRegisterNewLiteral(envPtr,
 		    tokPtr[1].start, tokPtr[1].size);
-
-	    if (envPtr->clNext) {
-		TclContinuationsEnterDerived(
-			TclFetchLiteral(envPtr, literal),
-			tokPtr[1].start - envPtr->source,
-			envPtr->clNext);
-	    }
 	    TclEmitPush(literal, envPtr);
 	} else {
 	    CompileTokens(envPtr, tokPtr, interp);

generic/tclEvent.c

@@ -1043,6 +1043,9 @@ TclInitSubsystems(void)
 #if USE_TCLALLOC
 	    TclInitAlloc();		/* Process wide mutex init */
 #endif
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+	    TclpInitThreadAlloc();
+#endif
 #ifdef TCL_MEM_DEBUG
 	    TclInitDbCkalloc();		/* Process wide mutex init */
 #endif

generic/tclIOUtil.c

@@ -1824,7 +1824,7 @@ Tcl_FSEvalFileEx(
      */
 
     iPtr->evalFlags |= TCL_EVAL_FILE;
-    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
+    result = Tcl_EvalEx(interp, string, length, 0);
 
     /*
      * Now we have to be careful; the script may have changed the
@@ -1960,9 +1960,8 @@ TclNREvalFile(
      */
 
     iPtr->evalFlags |= TCL_EVAL_FILE;
-    TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
-	    NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
+    TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr);
+    return TclNREvalObjEx(interp, objPtr, 0);
 }
 
 static int
@@ -2006,7 +2005,7 @@ EvalFileCallback(
     }
 
     Tcl_DecrRefCount(objPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*

generic/tclInt.decls

@@ -921,13 +921,12 @@ declare 231 {
 }
 
 # Bits and pieces of TIP#280's guts
-declare 232 {
-    int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
-	    const CmdFrame *invoker, int word)
-}
-declare 233 {
-    void TclGetSrcInfoForPc(CmdFrame *contextPtr)
-}
+#declare 232 {
+#    int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+#}
+#declare 233 {
+#    void TclGetSrcInfoForPc(CmdFrame *contextPtr)
+#}
 
 # Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
 declare 234 {
@@ -960,12 +959,10 @@ declare 239 {
 			    int skip, ProcErrorProc *errorProc)
 }
 declare 240 {
-    int TclNRRunCallbacks(Tcl_Interp *interp, int result,
-	      struct NRE_callback *rootPtr)
+    int TclNRRunCallbacks(Tcl_Interp *interp, int result)
 }
 declare 241 {
-    int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
-	    const CmdFrame *invoker, int word)
+    int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
 }
 declare 242 {
     int TclNREvalObjv(Tcl_Interp *interp, int objc,

generic/tclInt.h

@@ -1139,181 +1139,6 @@ typedef struct CallFrame {
 				 * been confirmed to refer to a class. Part of
 				 * TIP#257. */
 
-/*
- * TIP #280
- * The structure below defines a command frame. A command frame provides
- * location information for all commands executing a tcl script (source, eval,
- * uplevel, procedure bodies, ...). The runtime structure essentially contains
- * the stack trace as it would be if the currently executing command were to
- * throw an error.
- *
- * For commands where it makes sense it refers to the associated CallFrame as
- * well.
- *
- * The structures are chained in a single list, with the top of the stack
- * anchored in the Interp structure.
- *
- * Instances can be allocated on the C stack, or the heap, the former making
- * cleanup a bit simpler.
- */
-
-typedef struct CmdFrame {
-    /*
-     * General data. Always available.
-     */
-
-    int type;			/* Values see below. */
-    int level;			/* Number of frames in stack, prevent O(n)
-				 * scan of list. */
-    int *line;			/* Lines the words of the command start on. */
-    int nline;
-    CallFrame *framePtr;	/* Procedure activation record, may be
-				 * NULL. */
-    struct CmdFrame *nextPtr;	/* Link to calling frame. */
-    /*
-     * Data needed for Eval vs TEBC
-     *
-     * EXECUTION CONTEXTS and usage of CmdFrame
-     *
-     * Field	  TEBC		  EvalEx
-     * =======	  ====		  ======
-     * level	  yes		  yes
-     * type	  BC/PREBC	  SRC/EVAL
-     * line0	  yes		  yes
-     * framePtr	  yes		  yes
-     * =======	  ====		  ======
-     *
-     * =======	  ====		  ========= union data
-     * line1	  -		  yes
-     * line3	  -		  yes
-     * path	  -		  yes
-     * -------	  ----		  ------
-     * codePtr	  yes		  -
-     * pc	  yes		  -
-     * =======	  ====		  ======
-     *
-     * =======	  ====		  ========= union cmd
-     * str.cmd	  yes		  yes
-     * str.len	  yes		  yes
-     * -------	  ----		  ------
-     */
-
-    union {
-	struct {
-	    Tcl_Obj *path;	/* Path of the sourced file the command is
-				 * in. */
-	} eval;
-	struct {
-	    const void *codePtr;/* Byte code currently executed... */
-	    const char *pc;	/* ... and instruction pointer. */
-	} tebc;
-    } data;
-    Tcl_Obj *cmdObj;
-    const char *cmd;		/* The executed command, if possible... */
-    int len;			/* ... and its length. */
-    const struct CFWordBC *litarg;
-				/* Link to set of literal arguments which have
-				 * ben pushed on the lineLABCPtr stack by
-				 * TclArgumentBCEnter(). These will be removed
-				 * by TclArgumentBCRelease. */
-} CmdFrame;
-
-typedef struct CFWord {
-    CmdFrame *framePtr;		/* CmdFrame to access. */
-    int word;			/* Index of the word in the command. */
-    int refCount;		/* Number of times the word is on the
-				 * stack. */
-} CFWord;
-
-typedef struct CFWordBC {
-    CmdFrame *framePtr;		/* CmdFrame to access. */
-    int pc;			/* Instruction pointer of a command in
-				 * ExtCmdLoc.loc[.] */
-    int word;			/* Index of word in
-				 * ExtCmdLoc.loc[cmd]->line[.] */
-    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
-    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
-				 * CmdFrame litarg field for the list start. */
-    Tcl_Obj *obj;		/* Back reference to hashtable key */
-} CFWordBC;
-
-/*
- * Structure to record the locations of invisible continuation lines in
- * literal scripts, as character offset from the beginning of the script. Both
- * compiler and direct evaluator use this information to adjust their line
- * counters when tracking through the script, because when it is invoked the
- * continuation line marker as a whole has been removed already, meaning that
- * the \n which was part of it is gone as well, breaking regular line
- * tracking.
- *
- * These structures are allocated and filled by both the function
- * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
- * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in
- * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
- * TclCompileScript(), both found in the file "tclCompile.c". Their memory is
- * released by the function TclFreeObj(), in the file "tclObj.c", and also by
- * the function TclThreadFinalizeObjects(), in the same file.
- */
-
-#define CLL_END		(-1)
-
-typedef struct ContLineLoc {
-    int num;			/* Number of entries in loc, not counting the
-				 * final -1 marker entry. */
-    int loc[1];			/* Table of locations, as character offsets.
-				 * The table is allocated as part of the
-				 * structure, extending behind the nominal end
-				 * of the structure. An entry containing the
-				 * value -1 is put after the last location, as
-				 * end-marker/sentinel. */
-} ContLineLoc;
-
-/*
- * The following macros define the allowed values for the type field of the
- * CmdFrame structure above. Some of the values occur only in the extended
- * location data referenced via the 'baseLocPtr'.
- *
- * TCL_LOCATION_EVAL	  : Frame is for a script evaluated by EvalEx.
- * TCL_LOCATION_BC	  : Frame is for bytecode.
- * TCL_LOCATION_PREBC	  : Frame is for precompiled bytecode.
- * TCL_LOCATION_SOURCE	  : Frame is for a script evaluated by EvalEx, from a
- *			    sourced file.
- * TCL_LOCATION_PROC	  : Frame is for bytecode of a procedure.
- *
- * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC
- * types, per the context of the byte code in execution.
- */
-
-#define TCL_LOCATION_EVAL	(0) /* Location in a dynamic eval script. */
-#define TCL_LOCATION_BC		(2) /* Location in byte code. */
-#define TCL_LOCATION_PREBC	(3) /* Location in precompiled byte code, no
-				     * location. */
-#define TCL_LOCATION_SOURCE	(4) /* Location in a file. */
-#define TCL_LOCATION_PROC	(5) /* Location in a dynamic proc. */
-#define TCL_LOCATION_LAST	(6) /* Number of values in the enum. */
-
-/*
- * Structure passed to describe procedure-like "procedures" that are not
- * procedures (e.g. a lambda) so that their details can be reported correctly
- * by [info frame]. Contains a sub-structure for each extra field.
- */
-
-typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData);
-typedef struct {
-    const char *name;		/* Name of this field. */
-    GetFrameInfoValueProc *proc;	/* Function to generate a Tcl_Obj* from the
-				 * clientData, or just use the clientData
-				 * directly (after casting) if NULL. */
-    ClientData clientData;	/* Context for above function, or Tcl_Obj* if
-				 * proc field is NULL. */
-} ExtraFrameInfoField;
-typedef struct {
-    int length;			/* Length of array. */
-    ExtraFrameInfoField fields[2];
-				/* Really as long as necessary, but this is
-				 * long enough for nearly anything. */
-} ExtraFrameInfo;
-
 /*
  *----------------------------------------------------------------
  * Data structures and procedures related to TclHandles, which are a very
@@ -1423,8 +1248,6 @@ typedef struct ExecStack {
 typedef struct CorContext {
     struct CallFrame *framePtr;
     struct CallFrame *varFramePtr;
-    struct CmdFrame *cmdFramePtr;  /* See Interp.cmdFramePtr */
-    Tcl_HashTable *lineLABCPtr;    /* See Interp.lineLABCPtr */
 } CorContext;
 
 typedef struct CoroutineData {
@@ -1455,6 +1278,7 @@ typedef struct ExecEnv {
     struct Tcl_Interp *interp;
     struct NRE_callback *callbackPtr;
 				/* Top callback in NRE's stack. */
+    struct NRE_stack *NRStack;
     struct CoroutineData *corPtr;
     int rewind;
 } ExecEnv;
@@ -1778,10 +1602,10 @@ typedef struct Interp {
      * Tcl_GetStringResult. See the SetResult man page for details.
      */
 
-    char *result;		/* If the last command returned a string
+    char *unused1;		/* If the last command returned a string
 				 * result, this points to it. Should not be
 				 * accessed directly; see comment above. */
-    Tcl_FreeProc *freeProc;	/* Zero means a string result is statically
+    Tcl_FreeProc *unused2;	/* Zero means a string result is statically
 				 * allocated. TCL_DYNAMIC means string result
 				 * was allocated with ckalloc and should be
 				 * freed with ckfree. Other values give
@@ -1812,7 +1636,7 @@ typedef struct Interp {
 				 * per-interp basis. */
     union {
 	void (*optimizer)(void *envPtr);
-	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
+	Tcl_HashTable unused3;	/* No longer used (was mathFuncTable). The
 				 * unused space in interp was repurposed for
 				 * pluggable bytecode optimizers. The core
 				 * contains one optimizer, which can be
@@ -1847,19 +1671,6 @@ typedef struct Interp {
     Namespace *lookupNsPtr;	/* Namespace to use ONLY on the next
 				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
 
-    /*
-     * Information used by Tcl_AppendResult to keep track of partial results.
-     * See Tcl_AppendResult code for details.
-     */
-
-    char *appendResult;		/* Storage space for results generated by
-				 * Tcl_AppendResult. Ckalloc-ed. NULL means
-				 * not yet allocated. */
-    int appendAvl;		/* Total amount of space available at
-				 * partialResult. */
-    int appendUsed;		/* Number of non-null bytes currently stored
-				 * at partialResult. */
-
     /*
      * Information about packages. Used only in tclPkg.c.
      */
@@ -1876,13 +1687,10 @@ typedef struct Interp {
      * Miscellaneous information:
      */
 
-    int cmdCount;		/* Total number of times a command procedure
-				 * has been called for this interpreter. */
     int evalFlags;		/* Flags to control next call to Tcl_Eval.
 				 * Normally zero, but may be set before
 				 * calling Tcl_Eval. See below for valid
 				 * values. */
-    int unused1;		/* No longer used (was termOffset) */
     LiteralTable literalTable;	/* Contains LiteralEntry's describing all Tcl
 				 * objects holding literals of scripts
 				 * compiled by the interpreter. Indexed by the
@@ -1920,8 +1728,6 @@ typedef struct Interp {
 				 * string. Returned by Tcl_ObjSetVar2 when
 				 * variable traces change a variable in a
 				 * gross way. */
-    char resultSpace[TCL_RESULT_SIZE+1];
-				/* Static space holding small results. */
     Tcl_Obj *objResultPtr;	/* If the last command returned an object
 				 * result, this points to it. Should not be
 				 * accessed directly; see comment above. */
@@ -1964,14 +1770,6 @@ typedef struct Interp {
 				 * as flag values the same as the 'active'
 				 * field. */
 
-	int cmdCount;		/* Limit for how many commands to execute in
-				 * the interpreter. */
-	LimitHandler *cmdHandlers;
-				/* Handlers to execute when the limit is
-				 * reached. */
-	int cmdGranularity;	/* Mod factor used to determine how often to
-				 * evaluate the limit check. */
-
 	Tcl_Time time;		/* Time limit for execution within the
 				 * interpreter. */
 	LimitHandler *timeHandlers;
@@ -2016,54 +1814,6 @@ typedef struct Interp {
 				 * NULL), takes precedence over a POSIX error
 				 * code returned by a channel operation. */
 
-    /*
-     * Source code origin information (TIP #280).
-     */
-
-    CmdFrame *cmdFramePtr;	/* Points to the command frame containing the
-				 * location information for the current
-				 * command. */
-    const CmdFrame *invokeCmdFramePtr;
-				/* Points to the command frame which is the
-				 * invoking context of the bytecode compiler.
-				 * NULL when the byte code compiler is not
-				 * active. */
-    int invokeWord;		/* Index of the word in the command which
-				 * is getting compiled. */
-    Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically
-				 * defined procedure the location information
-				 * for its body. It is keyed by the address of
-				 * the Proc structure for a procedure. The
-				 * values are "struct CmdFrame*". */
-    Tcl_HashTable *lineBCPtr;	/* This table remembers for each ByteCode
-				 * object the location information for its
-				 * body. It is keyed by the address of the
-				 * Proc structure for a procedure. The values
-				 * are "struct ExtCmdLoc*". (See
-				 * tclCompile.h) */
-    Tcl_HashTable *lineLABCPtr;
-    Tcl_HashTable *lineLAPtr;	/* This table remembers for each argument of a
-				 * command on the execution stack the index of
-				 * the argument in the command, and the
-				 * location data of the command. It is keyed
-				 * by the address of the Tcl_Obj containing
-				 * the argument. The values are "struct
-				 * CFWord*" (See tclBasic.c). This allows
-				 * commands like uplevel, eval, etc. to find
-				 * location information for their arguments,
-				 * if they are a proper literal argument to an
-				 * invoking command. Alt view: An index to the
-				 * CmdFrame stack keyed by command argument
-				 * holders. */
-    ContLineLoc *scriptCLLocPtr;/* This table points to the location data for
-				 * invisible continuation lines in the script,
-				 * if any. This pointer is set by the function
-				 * TclEvalObjEx() in file "tclBasic.c", and
-				 * used by function ...() in the same file.
-				 * It does for the eval/direct path of script
-				 * execution what CompileEnv.clLoc does for
-				 * the bytecode compiler.
-				 */
     /*
      * TIP #268. The currently active selection mode, i.e. the package require
      * preferences.
@@ -2108,12 +1858,8 @@ typedef struct Interp {
 				 * and setup. */
 
     struct NRE_callback *deferredCallbacks;
-				/* Callbacks that are set previous to a call
-				 * to some Eval function but that actually
-				 * belong to the command that is about to be
-				 * called - i.e., they should be run *before*
-				 * any tailcall is invoked. */
-
+                                /* First callback deferred for the next
+				 * call to EvalObjv */
     /*
      * TIP #285, Script cancellation support.
      */
@@ -2126,17 +1872,6 @@ typedef struct Interp {
 				 * (asyncCancelMsg not NULL), takes precedence
 				 * over the default error messages returned by
 				 * a script cancellation operation. */
-
-	/*
-	 * TIP #348 IMPLEMENTATION  -  Substituted error stack
-	 */
-    Tcl_Obj *errorStack;	/* [info errorstack] value (as a Tcl_Obj). */
-    Tcl_Obj *upLiteral;		/* "UP" literal for [info errorstack] */
-    Tcl_Obj *callLiteral;	/* "CALL" literal for [info errorstack] */
-    Tcl_Obj *innerLiteral;	/* "INNER" literal for [info errorstack] */
-    Tcl_Obj *innerContext;	/* cached list for fast reallocation */
-    int resetErrorStack;        /* controls cleaning up of ::errorStack */
-
 #ifdef TCL_COMPILE_STATS
     /*
      * Statistical information about the bytecode compiler and interpreter's
@@ -2146,6 +1881,7 @@ typedef struct Interp {
     ByteCodeStats stats;	/* Holds compilation and execution statistics
 				 * for this interpreter. */
 #endif /* TCL_COMPILE_STATS */
+    Tcl_Obj *cmdSourcePtr;      /* Command source obj, used for command traces */
 } Interp;
 
 /*
@@ -2769,24 +2505,6 @@ MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);
 MODULE_SCOPE void  TclMarkTailcall(Tcl_Interp *interp);
 MODULE_SCOPE void  TclSkipTailcall(Tcl_Interp *interp);
 
-/*
- * This structure holds the data for the various iteration callbacks used to
- * NRE the 'for' and 'while' commands. We need a separate structure because we
- * have more than the 4 client data entries we can provide directly thorugh
- * the callback API. It is the 'word' information which puts us over the
- * limit. It is needed because the loop body is argument 4 of 'for' and
- * argument 2 of 'while'. Not providing the correct index confuses the #280
- * code. We TclSmallAlloc/Free this.
- */
-
-typedef struct ForIterData {
-    Tcl_Obj *cond;		/* Loop condition expression. */
-    Tcl_Obj *body;		/* Loop body. */
-    Tcl_Obj *next;		/* Loop step script, NULL for 'while'. */
-    const char *msg;		/* Error message part. */
-    int word;			/* Index of the body script in the command */
-} ForIterData;
-
 /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
  *            and Tcl_FindSymbol. This structure corresponds to an opaque
  *            typedef in tcl.h */
@@ -2842,21 +2560,6 @@ MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
 			    const unsigned char *bytes, int len);
 MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    int flags);
-MODULE_SCOPE void	TclAdvanceContinuations(int *line, int **next,
-			    int loc);
-MODULE_SCOPE void	TclAdvanceLines(int *line, const char *start,
-			    const char *end);
-MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
-			    Tcl_Obj *objv[], int objc, CmdFrame *cf);
-MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
-			    Tcl_Obj *objv[], int objc);
-MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
-			    Tcl_Obj *objv[], int objc,
-			    void *codePtr, CmdFrame *cfPtr, int cmd, int pc);
-MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
-			    CmdFrame *cfPtr);
-MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
-			    CmdFrame **cfPtrPtr, int *wordPtr);
 MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
 			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
 MODULE_SCOPE double	TclBignumToDouble(const mp_int *bignum);
@@ -2873,13 +2576,6 @@ MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
 MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
 MODULE_SCOPE int	TclClearRootEnsemble(ClientData data[],
 			    Tcl_Interp *interp, int result);
-MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
-			    int *loc);
-MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
-			    int start, int *clNext);
-MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
-MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
-			    Tcl_Obj *originObjPtr);
 MODULE_SCOPE int	TclConvertElement(const char *src, int length,
 			    char *dst, int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
@@ -2887,10 +2583,6 @@ MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 			    const char *dict, int dictLength,
 			    const char **elementPtr, const char **nextPtr,
 			    int *sizePtr, int *literalPtr);
-/* TIP #280 - Modified token based evulation, with line information. */
-MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
-			    int numBytes, int flags, int line,
-			    int *clNextOuter, const char *outerScript);
 MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
@@ -2950,8 +2642,6 @@ MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 			    const char *modeString, int *seekFlagPtr,
 			    int *binaryPtr);
 MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
-MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
-			    Tcl_Obj *const objv[]);
 MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
 			    unsigned int *sizePtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
@@ -2965,7 +2655,6 @@ MODULE_SCOPE int	TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 MODULE_SCOPE int	TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
 MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
@@ -2994,9 +2683,6 @@ MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
 			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
 MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    int indexCount, Tcl_Obj *const indexArray[]);
-/* TIP #280 */
-MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
-			    int *lines, Tcl_Obj *const *elems);
 MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
 MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
@@ -3010,7 +2696,6 @@ MODULE_SCOPE int	TclMaxListLength(const char *bytes, int numBytes,
 MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
 			    int *codePtr, int *levelPtr);
-MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
 MODULE_SCOPE int	TclNokia770Doubles(void);
 MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
 MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
@@ -3118,21 +2803,20 @@ MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
 			    Tcl_Obj *patternObj, int flags);
 MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
-			    int numBytes, int flags, int line,
-			    struct CompileEnv *envPtr);
+			    int numBytes, int flags, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
 			    Tcl_Obj *const opts[], int *flagPtr);
 MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
 			    int numBytes, int flags, Tcl_Parse *parsePtr,
 			    Tcl_InterpState *statePtr);
 MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
-			    int count, int *tokensLeftPtr, int line,
-			    int *clNextOuter, const char *outerScript);
+			    int count, int *tokensLeftPtr);
 MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
 			    const char *trim, int numTrim);
 MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
 			    const char *trim, int numTrim);
 MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
+MODULE_SCOPE int	TclUtfCount(Tcl_UniChar ch);
 MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
 MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
 MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -3146,6 +2830,9 @@ MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
 			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 #endif
 MODULE_SCOPE void	TclInitThreadStorage(void);
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+MODULE_SCOPE void	TclpInitThreadAlloc(void);
+#endif
 MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
 MODULE_SCOPE void	TclFinalizeThreadStorage(void);
 #ifdef TCL_WIDE_CLICKS
@@ -3158,8 +2845,6 @@ MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
 MODULE_SCOPE void	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
 MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
 
-MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
-
 /*
  *----------------------------------------------------------------
  * Command procedures in the generic core:
@@ -3180,9 +2865,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3229,15 +2911,6 @@ MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
 MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-
-/* Assemble command function */
-MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-
 MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3909,10 +3582,6 @@ MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
 
-MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, Command *cmdPtr,
-			    struct CompileEnv *envPtr);
-
 /*
  * Functions defined in generic/tclVar.c and currenttly exported only for use
  * by the bytecode compiler and engine. Some of these could later be placed in
@@ -4014,12 +3683,6 @@ typedef const char *TclDTraceStr;
 #  define TclIncrObjsFreed()
 #endif /* TCL_COMPILE_STATS */
 
-#  define TclAllocObjStorage(objPtr)		\
-	TclAllocObjStorageEx(NULL, (objPtr))
-
-#  define TclFreeObjStorage(objPtr)		\
-	TclFreeObjStorageEx(NULL, (objPtr))
-
 #ifndef TCL_MEM_DEBUG
 # define TclNewObj(objPtr) \
     TclIncrObjsAllocated(); \
@@ -4062,10 +3725,10 @@ typedef const char *TclDTraceStr;
  * track memory leaks.
  */
 
-#  define TclAllocObjStorageEx(interp, objPtr) \
+#  define TclAllocObjStorage(objPtr) \
 	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
 
-#  define TclFreeObjStorageEx(interp, objPtr) \
+#  define TclFreeObjStorage(objPtr) \
 	ckfree((char *) (objPtr))
 
 #undef USE_THREAD_ALLOC
@@ -4077,8 +3740,8 @@ typedef const char *TclDTraceStr;
  * per-thread caches.
  */
 
-MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
-MODULE_SCOPE void	TclThreadFreeObj(Tcl_Obj *);
+MODULE_SCOPE TCL_NOINLINE Tcl_Obj *	TclThreadAllocObj(void);
+MODULE_SCOPE TCL_NOINLINE void	TclThreadFreeObj(Tcl_Obj *);
 MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
 MODULE_SCOPE void	TclFreeAllocCache(void *);
 MODULE_SCOPE void *	TclpGetAllocCache(void);
@@ -4096,34 +3759,11 @@ MODULE_SCOPE void	TclpFreeAllocCache(void *);
 
 #  define ALLOC_NOBJHIGH 1200
 
-#  define TclAllocObjStorageEx(interp, objPtr)				\
-    do {								\
-	AllocCache *cachePtr;						\
-	if (((interp) == NULL) ||					\
-		((cachePtr = ((Interp *)(interp))->allocCache),		\
-			(cachePtr->numObjects == 0))) {			\
-	    (objPtr) = TclThreadAllocObj();				\
-	} else {							\
-	    (objPtr) = cachePtr->firstObjPtr;				\
-	    cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \
-	    --cachePtr->numObjects;					\
-	}								\
-    } while (0)
+#  define TclAllocObjStorage(objPtr)					\
+    (objPtr) = TclThreadAllocObj()
 
-#  define TclFreeObjStorageEx(interp, objPtr)				\
-    do {								\
-	AllocCache *cachePtr;						\
-	if (((interp) == NULL) ||					\
-		((cachePtr = ((Interp *)(interp))->allocCache),		\
-			((cachePtr->numObjects == 0) ||			\
-			(cachePtr->numObjects >= ALLOC_NOBJHIGH)))) {	\
-	    TclThreadFreeObj(objPtr);					\
-	} else {							\
-	    (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
-	    cachePtr->firstObjPtr = objPtr;				\
-	    ++cachePtr->numObjects;					\
-	}								\
-    } while (0)
+#  define TclFreeObjStorage(objPtr)					\
+    TclThreadFreeObj(objPtr)
 
 #else /* not PURIFY or USE_THREAD_ALLOC */
 
@@ -4139,7 +3779,7 @@ MODULE_SCOPE void	TclpFreeAllocCache(void *);
 MODULE_SCOPE Tcl_Mutex	tclObjMutex;
 #endif
 
-#  define TclAllocObjStorageEx(interp, objPtr) \
+#  define TclAllocObjStorage(objPtr)					\
     do {								\
 	Tcl_MutexLock(&tclObjMutex);					\
 	if (tclFreeObjList == NULL) {					\
@@ -4151,7 +3791,7 @@ MODULE_SCOPE Tcl_Mutex	tclObjMutex;
 	Tcl_MutexUnlock(&tclObjMutex);					\
     } while (0)
 
-#  define TclFreeObjStorageEx(interp, objPtr) \
+#  define TclFreeObjStorage(objPtr)				       \
     do {							       \
 	Tcl_MutexLock(&tclObjMutex);				       \
 	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \
@@ -4639,7 +4279,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
 #    ifdef NO_ISNAN
 #	 define TclIsNaN(d)	((d) != (d))
 #    else
-#	 define TclIsNaN(d)	(isnan(d))
+/*
+ * This is called a lot for double-using code and isnan() is a noticable
+ * slowdown, so we stay with the comparison operation here. It should only
+ * make a difference for signalling NaN and those should not happen anyway.
+ */
+#	 define TclIsNaN(d)	((d) != (d))
+/*#	 define TclIsNaN(d)	(isnan(d))*/
 #    endif
 #endif
 
@@ -4691,14 +4337,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
 #define TclLimitReady(limit)						\
     (((limit).active == 0) ? 0 :					\
     (++(limit).granularityTicker,					\
-    ((((limit).active & TCL_LIMIT_COMMANDS) &&				\
-	    (((limit).cmdGranularity == 1) ||				\
-	    ((limit).granularityTicker % (limit).cmdGranularity == 0)))	\
-	    ? 1 :							\
     (((limit).active & TCL_LIMIT_TIME) &&				\
 	    (((limit).timeGranularity == 1) ||				\
-	    ((limit).granularityTicker % (limit).timeGranularity == 0)))\
-	    ? 1 : 0)))
+		    ((limit).granularityTicker % (limit).timeGranularity == 0)))))
 
 /*
  * Compile-time assertions: these produce a compile time error if the
@@ -4725,47 +4366,21 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
  *----------------------------------------------------------------
  */
 
-#define TclSmallAlloc(nbytes, memPtr) \
-    TclSmallAllocEx(NULL, (nbytes), (memPtr))
-
-#define TclSmallFree(memPtr) \
-    TclSmallFreeEx(NULL, (memPtr))
-
-#ifndef TCL_MEM_DEBUG
-#define TclSmallAllocEx(interp, nbytes, memPtr) \
+#define TclSmallAlloc(nbytes, memPtr)					\
     do {								\
 	Tcl_Obj *objPtr;						\
 	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
 	TclIncrObjsAllocated();						\
-	TclAllocObjStorageEx((interp), (objPtr));			\
+	TclAllocObjStorage(objPtr);					\
 	memPtr = (ClientData) (objPtr);					\
     } while (0)
 
-#define TclSmallFreeEx(interp, memPtr) \
+#define TclSmallFree(memPtr)						\
     do {								\
-	TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));		\
+	TclFreeObjStorage((Tcl_Obj *) (memPtr));			\
 	TclIncrObjsFreed();						\
     } while (0)
 
-#else    /* TCL_MEM_DEBUG */
-#define TclSmallAllocEx(interp, nbytes, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr;						\
-	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
-	TclNewObj(objPtr);						\
-	memPtr = (ClientData) objPtr;					\
-    } while (0)
-
-#define TclSmallFreeEx(interp, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr = (Tcl_Obj *) memPtr;				\
-	objPtr->bytes = NULL;						\
-	objPtr->typePtr = NULL;						\
-	objPtr->refCount = 1;						\
-	TclDecrRefCount(objPtr);					\
-    } while (0)
-#endif   /* TCL_MEM_DEBUG */
-
 /*
  * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
  */
@@ -4789,58 +4404,20 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
  *----------------------------------------------------------------
  */
 
-#define NRE_USE_SMALL_ALLOC	1  /* Only turn off for debugging purposes. */
 #ifndef NRE_ENABLE_ASSERTS
 #define NRE_ENABLE_ASSERTS	0
 #endif
 
-/*
- * This is the main data struct for representing NR commands. It is designed
- * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator
- * available.
- */
-
-typedef struct NRE_callback {
-    Tcl_NRPostProc *procPtr;
-    ClientData data[4];
-    struct NRE_callback *nextPtr;
-} NRE_callback;
-
-#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
-
-/*
- * Inline version of Tcl_NRAddCallback.
- */
-
-#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
-    do {								\
-	NRE_callback *callbackPtr;					\
-	TCLNR_ALLOC((interp), (callbackPtr));				\
-	callbackPtr->procPtr = (postProcPtr);				\
-	callbackPtr->data[0] = (ClientData)(data0);			\
-	callbackPtr->data[1] = (ClientData)(data1);			\
-	callbackPtr->data[2] = (ClientData)(data2);			\
-	callbackPtr->data[3] = (ClientData)(data3);			\
-	callbackPtr->nextPtr = TOP_CB(interp);				\
-	TOP_CB(interp) = callbackPtr;					\
-    } while (0)
-
-#if NRE_USE_SMALL_ALLOC
-#define TCLNR_ALLOC(interp, ptr) \
-    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
-#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
-#else
-#define TCLNR_ALLOC(interp, ptr) \
-    (ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
-#define TCLNR_FREE(interp, ptr)  ckfree((char *) (ptr))
-#endif
-
 #if NRE_ENABLE_ASSERTS
+#include <assert.h>
 #define NRE_ASSERT(expr) assert((expr))
 #else
 #define NRE_ASSERT(expr)
 #endif
 
+void TclNRSetRoot(Tcl_Interp *interp);
+
+
 #include "tclIntDecls.h"
 #include "tclIntPlatDecls.h"
 #include "tclTomMathDecls.h"
@@ -4851,6 +4428,8 @@ typedef struct NRE_callback {
 #define Tcl_Free(ptr)                 TclpFree(ptr)
 #endif
 
+#include "tclNRE.h"
+
 #endif /* _TCLINT */
 
 /*

generic/tclIntDecls.h

@@ -558,11 +558,8 @@ EXTERN Var *		TclObjLookupVar(Tcl_Interp *interp,
 /* 231 */
 EXTERN int		TclGetNamespaceFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
-/* 232 */
-EXTERN int		TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags, const CmdFrame *invoker, int word);
-/* 233 */
-EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
+/* Slot 232 is reserved */
+/* Slot 233 is reserved */
 /* 234 */
 EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
 				const char *key, int *newPtr);
@@ -582,11 +579,10 @@ EXTERN int		TclNRInterpProcCore(Tcl_Interp *interp,
 				Tcl_Obj *procNameObj, int skip,
 				ProcErrorProc *errorProc);
 /* 240 */
-EXTERN int		TclNRRunCallbacks(Tcl_Interp *interp, int result,
-				struct NRE_callback *rootPtr);
+EXTERN int		TclNRRunCallbacks(Tcl_Interp *interp, int result);
 /* 241 */
 EXTERN int		TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags, const CmdFrame *invoker, int word);
+				int flags);
 /* 242 */
 EXTERN int		TclNREvalObjv(Tcl_Interp *interp, int objc,
 				Tcl_Obj *const objv[], int flags,
@@ -854,16 +850,16 @@ typedef struct TclIntStubs {
     int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
     Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
     int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
-    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
-    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
+    void (*reserved232)(void);
+    void (*reserved233)(void);
     Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
     void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
     void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
     int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
     int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
     int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
-    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
-    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
+    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result); /* 240 */
+    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 241 */
     int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
     void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
     Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
@@ -1265,10 +1261,8 @@ extern const TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclObjLookupVar) /* 230 */
 #define TclGetNamespaceFromObj \
 	(tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */
-#define TclEvalObjEx \
-	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
-#define TclGetSrcInfoForPc \
-	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
+/* Slot 232 is reserved */
+/* Slot 233 is reserved */
 #define TclVarHashCreateVar \
 	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
 #define TclInitVarHashTable \
@@ -1319,7 +1313,7 @@ extern const TclIntStubs *tclIntStubsPtr;
 #undef TclSetStartupScriptPath
 #undef TclBackgroundException
 
-#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+#if defined(USE_TCL_STUBS)
 #   undef Tcl_SetStartupScript
 #   define Tcl_SetStartupScript \
 	    (tclStubsPtr->tcl_SetStartupScript) /* 622 */

generic/tclInterp.c

@@ -263,9 +263,6 @@ static void		SlaveObjCmdDeleteProc(ClientData clientData);
 static int		SlaveRecursionLimit(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int objc,
 			    Tcl_Obj *const objv[]);
-static int		SlaveCommandLimitCmd(Tcl_Interp *interp,
-			    Tcl_Interp *slaveInterp, int consumedObjc,
-			    int objc, Tcl_Obj *const objv[]);
 static int		SlaveTimeLimitCmd(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int consumedObjc,
 			    int objc, Tcl_Obj *const objv[]);
@@ -986,8 +983,6 @@ NRInterpCmd(
 	    return TCL_ERROR;
 	}
 	switch ((enum LimitTypes) limitType) {
-	case LIMIT_TYPE_COMMANDS:
-	    return SlaveCommandLimitCmd(interp, slaveInterp, 4, objc,objv);
 	case LIMIT_TYPE_TIME:
 	    return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
 	}
@@ -1846,7 +1841,7 @@ AliasNRCmd(
      */
 
     if (isRootEnsemble) {
-	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL);
     }
     TclSkipTailcall(interp);
     return Tcl_NREvalObj(interp, listPtr, flags);
@@ -2644,8 +2639,6 @@ NRSlaveCmd(
 	    return TCL_ERROR;
 	}
 	switch ((enum LimitTypes) limitType) {
-	case LIMIT_TYPE_COMMANDS:
-	    return SlaveCommandLimitCmd(interp, slaveInterp, 3, objc,objv);
 	case LIMIT_TYPE_TIME:
 	    return SlaveTimeLimitCmd(interp, slaveInterp, 3, objc, objv);
 	}
@@ -2826,17 +2819,7 @@ SlaveEval(
     Tcl_AllowExceptions(slaveInterp);
 
     if (objc == 1) {
-	/*
-	 * TIP #280: Make actual argument location available to eval'd script.
-	 */
-
-	Interp *iPtr = (Interp *) interp;
-	CmdFrame *invoker = iPtr->cmdFramePtr;
-	int word = 0;
-
-	TclArgumentGet(interp, objv[0], &invoker, &word);
-
-	result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
+	result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
     } else {
 	Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
 	Tcl_IncrRefCount(objPtr);
@@ -3078,10 +3061,11 @@ SlaveInvokeHidden(
     Tcl_AllowExceptions(slaveInterp);
 
     if (namespaceName == NULL) {
-	NRE_callback *rootPtr = TOP_CB(slaveInterp);
-
+	if (interp != slaveInterp) {
+	    TclNRSetRoot(slaveInterp);
+	}
 	Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
-		rootPtr, NULL, NULL);
+		NULL, NULL);
 	return TclNRInvoke(NULL, slaveInterp, objc, objv);
     } else {
 	Namespace *nsPtr, *dummy1, *dummy2;
@@ -3109,14 +3093,13 @@ NRPostInvokeHidden(
     int result)
 {
     Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
-    NRE_callback *rootPtr = (NRE_callback *)data[1];
 
     if (interp != slaveInterp) {
-	result = TclNRRunCallbacks(slaveInterp, result, rootPtr);
+	result = TclNRRunCallbacks(slaveInterp, result);
 	Tcl_TransferResult(slaveInterp, result, interp);
     }
     Tcl_Release(slaveInterp);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -3345,11 +3328,6 @@ Tcl_LimitReady(
     if (iPtr->limit.active != 0) {
 	register int ticker = ++iPtr->limit.granularityTicker;
 
-	if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) &&
-		((iPtr->limit.cmdGranularity == 1) ||
-		    (ticker % iPtr->limit.cmdGranularity == 0))) {
-	    return 1;
-	}
 	if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
 		((iPtr->limit.timeGranularity == 1) ||
 		    (ticker % iPtr->limit.timeGranularity == 0))) {
@@ -3393,25 +3371,6 @@ Tcl_LimitCheck(
 	return TCL_OK;
     }
 
-    if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) &&
-	    ((iPtr->limit.cmdGranularity == 1) ||
-		    (ticker % iPtr->limit.cmdGranularity == 0)) &&
-	    (iPtr->limit.cmdCount < iPtr->cmdCount)) {
-	iPtr->limit.exceeded |= TCL_LIMIT_COMMANDS;
-	Tcl_Preserve(interp);
-	RunLimitHandlers(iPtr->limit.cmdHandlers, interp);
-	if (iPtr->limit.cmdCount >= iPtr->cmdCount) {
-	    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
-	} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "command count limit exceeded", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL);
-	    Tcl_Release(interp);
-	    return TCL_ERROR;
-	}
-	Tcl_Release(interp);
-    }
-
     if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
 	    ((iPtr->limit.timeGranularity == 1) ||
 		(ticker % iPtr->limit.timeGranularity == 0))) {
@@ -3566,14 +3525,6 @@ Tcl_LimitAddHandler(
      */
 
     switch (type) {
-    case TCL_LIMIT_COMMANDS:
-	handlerPtr->nextPtr = iPtr->limit.cmdHandlers;
-	if (handlerPtr->nextPtr != NULL) {
-	    handlerPtr->nextPtr->prevPtr = handlerPtr;
-	}
-	iPtr->limit.cmdHandlers = handlerPtr;
-	return;
-
     case TCL_LIMIT_TIME:
 	handlerPtr->nextPtr = iPtr->limit.timeHandlers;
 	if (handlerPtr->nextPtr != NULL) {
@@ -3616,9 +3567,6 @@ Tcl_LimitRemoveHandler(
     LimitHandler *handlerPtr;
 
     switch (type) {
-    case TCL_LIMIT_COMMANDS:
-	handlerPtr = iPtr->limit.cmdHandlers;
-	break;
     case TCL_LIMIT_TIME:
 	handlerPtr = iPtr->limit.timeHandlers;
 	break;
@@ -3649,9 +3597,6 @@ Tcl_LimitRemoveHandler(
 
 	if (handlerPtr->prevPtr == NULL) {
 	    switch (type) {
-	    case TCL_LIMIT_COMMANDS:
-		iPtr->limit.cmdHandlers = handlerPtr->nextPtr;
-		break;
 	    case TCL_LIMIT_TIME:
 		iPtr->limit.timeHandlers = handlerPtr->nextPtr;
 		break;
@@ -3704,39 +3649,6 @@ TclLimitRemoveAllHandlers(
     Interp *iPtr = (Interp *) interp;
     LimitHandler *handlerPtr, *nextHandlerPtr;
 
-    /*
-     * Delete all command-limit handlers.
-     */
-
-    for (handlerPtr=iPtr->limit.cmdHandlers, iPtr->limit.cmdHandlers=NULL;
-	    handlerPtr!=NULL; handlerPtr=nextHandlerPtr) {
-	nextHandlerPtr = handlerPtr->nextPtr;
-
-	/*
-	 * Do not delete here if it has already been marked for deletion.
-	 */
-
-	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
-	    continue;
-	}
-	handlerPtr->flags |= LIMIT_HANDLER_DELETED;
-	handlerPtr->prevPtr = NULL;
-	handlerPtr->nextPtr = NULL;
-
-	/*
-	 * If nothing is currently executing the handler, delete its client
-	 * data and the overall handler structure now. Otherwise it will all
-	 * go away when the handler returns.
-	 */
-
-	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
-	    if (handlerPtr->deleteProc != NULL) {
-		handlerPtr->deleteProc(handlerPtr->clientData);
-	    }
-	    ckfree(handlerPtr);
-	}
-    }
-
     /*
      * Delete all time-limit handlers.
      */
@@ -3892,61 +3804,6 @@ Tcl_LimitTypeReset(
     iPtr->limit.exceeded &= ~type;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LimitSetCommands --
- *
- *	Set the command limit for an interpreter.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Also resets whether the command limit was exceeded. This might permit
- *	a small amount of further execution in the interpreter even if the
- *	limit itself is theoretically exceeded.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_LimitSetCommands(
-    Tcl_Interp *interp,
-    int commandLimit)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    iPtr->limit.cmdCount = commandLimit;
-    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LimitGetCommands --
- *
- *	Get the number of commands that may be executed in the interpreter
- *	before the command-limit is reached.
- *
- * Results:
- *	An upper bound on the number of commands.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LimitGetCommands(
-    Tcl_Interp *interp)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    return iPtr->limit.cmdCount;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -4090,9 +3947,6 @@ Tcl_LimitSetGranularity(
     }
 
     switch (type) {
-    case TCL_LIMIT_COMMANDS:
-	iPtr->limit.cmdGranularity = granularity;
-	return;
     case TCL_LIMIT_TIME:
 	iPtr->limit.timeGranularity = granularity;
 	return;
@@ -4124,8 +3978,6 @@ Tcl_LimitGetGranularity(
     Interp *iPtr = (Interp *) interp;
 
     switch (type) {
-    case TCL_LIMIT_COMMANDS:
-	return iPtr->limit.cmdGranularity;
     case TCL_LIMIT_TIME:
 	return iPtr->limit.timeGranularity;
     }
@@ -4338,9 +4190,6 @@ TclInitLimitSupport(
     iPtr->limit.active = 0;
     iPtr->limit.granularityTicker = 0;
     iPtr->limit.exceeded = 0;
-    iPtr->limit.cmdCount = 0;
-    iPtr->limit.cmdHandlers = NULL;
-    iPtr->limit.cmdGranularity = 1;
     memset(&iPtr->limit.time, 0, sizeof(Tcl_Time));
     iPtr->limit.timeHandlers = NULL;
     iPtr->limit.timeEvent = NULL;
@@ -4377,11 +4226,6 @@ InheritLimitsFromMaster(
     Interp *slavePtr = (Interp *) slaveInterp;
     Interp *masterPtr = (Interp *) masterInterp;
 
-    if (masterPtr->limit.active & TCL_LIMIT_COMMANDS) {
-	slavePtr->limit.active |= TCL_LIMIT_COMMANDS;
-	slavePtr->limit.cmdCount = 0;
-	slavePtr->limit.cmdGranularity = masterPtr->limit.cmdGranularity;
-    }
     if (masterPtr->limit.active & TCL_LIMIT_TIME) {
 	slavePtr->limit.active |= TCL_LIMIT_TIME;
 	memcpy(&slavePtr->limit.time, &masterPtr->limit.time,
@@ -4390,195 +4234,6 @@ InheritLimitsFromMaster(
     }
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * SlaveCommandLimitCmd --
- *
- *	Implementation of the [interp limit $i commands] and [$i limit
- *	commands] subcommands. See the interp manual page for a full
- *	description.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Depends on the arguments.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SlaveCommandLimitCmd(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    Tcl_Interp *slaveInterp,	/* Interpreter being adjusted. */
-    int consumedObjc,		/* Number of args already parsed. */
-    int objc,			/* Total number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    static const char *const options[] = {
-	"-command", "-granularity", "-value", NULL
-    };
-    enum Options {
-	OPT_CMD, OPT_GRAN, OPT_VAL
-    };
-    Interp *iPtr = (Interp *) interp;
-    int index;
-    ScriptLimitCallbackKey key;
-    ScriptLimitCallback *limitCBPtr;
-    Tcl_HashEntry *hPtr;
-
-    /*
-     * First, ensure that we are not reading or writing the calling
-     * interpreter's limits; it may only manipulate its children. Note that
-     * the low level API enforces this with Tcl_Panic, which we want to
-     * avoid. [Bug 3398794]
-     */
-
-    if (interp == slaveInterp) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"limits on current interpreter inaccessible", -1));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
-	return TCL_ERROR;
-    }
-
-    if (objc == consumedObjc) {
-	Tcl_Obj *dictPtr;
-
-	TclNewObj(dictPtr);
-	key.interp = slaveInterp;
-	key.type = TCL_LIMIT_COMMANDS;
-	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
-	if (hPtr != NULL) {
-	    limitCBPtr = Tcl_GetHashValue(hPtr);
-	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
-		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
-			limitCBPtr->scriptObj);
-	    } else {
-		goto putEmptyCommandInDict;
-	    }
-	} else {
-	    Tcl_Obj *empty;
-
-	putEmptyCommandInDict:
-	    TclNewObj(empty);
-	    Tcl_DictObjPut(NULL, dictPtr,
-		    Tcl_NewStringObj(options[0], -1), empty);
-	}
-	Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
-		Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp,
-		TCL_LIMIT_COMMANDS)));
-
-	if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
-	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
-		    Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
-	} else {
-	    Tcl_Obj *empty;
-
-	    TclNewObj(empty);
-	    Tcl_DictObjPut(NULL, dictPtr,
-		    Tcl_NewStringObj(options[2], -1), empty);
-	}
-	Tcl_SetObjResult(interp, dictPtr);
-	return TCL_OK;
-    } else if (objc == consumedObjc+1) {
-	if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option",
-		0, &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch ((enum Options) index) {
-	case OPT_CMD:
-	    key.interp = slaveInterp;
-	    key.type = TCL_LIMIT_COMMANDS;
-	    hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
-	    if (hPtr != NULL) {
-		limitCBPtr = Tcl_GetHashValue(hPtr);
-		if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
-		    Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
-		}
-	    }
-	    break;
-	case OPT_GRAN:
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(
-		    Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_COMMANDS)));
-	    break;
-	case OPT_VAL:
-	    if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
-		Tcl_SetObjResult(interp,
-			Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
-	    }
-	    break;
-	}
-	return TCL_OK;
-    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
-	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
-	return TCL_ERROR;
-    } else {
-	int i, scriptLen = 0, limitLen = 0;
-	Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL;
-	int gran = 0, limit = 0;
-
-	for (i=consumedObjc ; i<objc ; i+=2) {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
-		    &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    switch ((enum Options) index) {
-	    case OPT_CMD:
-		scriptObj = objv[i+1];
-		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
-		break;
-	    case OPT_GRAN:
-		granObj = objv[i+1];
-		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (gran < 1) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "granularity must be at least 1", -1));
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADVALUE", NULL);
-		    return TCL_ERROR;
-		}
-		break;
-	    case OPT_VAL:
-		limitObj = objv[i+1];
-		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
-		if (limitLen == 0) {
-		    break;
-		}
-		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (limit < 0) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "command limit value must be at least 0", -1));
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADVALUE", NULL);
-		    return TCL_ERROR;
-		}
-		break;
-	    }
-	}
-	if (scriptObj != NULL) {
-	    SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, slaveInterp,
-		    (scriptLen > 0 ? scriptObj : NULL));
-	}
-	if (granObj != NULL) {
-	    Tcl_LimitSetGranularity(slaveInterp, TCL_LIMIT_COMMANDS, gran);
-	}
-	if (limitObj != NULL) {
-	    if (limitLen > 0) {
-		Tcl_LimitSetCommands(slaveInterp, limit);
-		Tcl_LimitTypeSet(slaveInterp, TCL_LIMIT_COMMANDS);
-	    } else {
-		Tcl_LimitTypeReset(slaveInterp, TCL_LIMIT_COMMANDS);
-	    }
-	}
-	return TCL_OK;
-    }
-}
-
 /*
  *----------------------------------------------------------------------
  *

generic/tclNRE.h

@@ -0,0 +1,108 @@
+/* **********************************************
+ * NRE internals   
+ * **********************************************
+ */
+
+#define NRE_STACK_SIZE        100
+
+/*
+ * This is the main data struct for representing NR commands. It was
+ * originally designed to fit in sizeof(Tcl_Obj) in order to exploit the
+ * fastest memory allocator available. The current version completely changed
+ * the memory management approach (stack vs linked list), and the struct was
+ * reduced in size to make it cache friendlier (two callbacks fit in one cache
+ * line).
+ */
+
+typedef struct NRE_callback {
+    Tcl_NRPostProc *procPtr;
+    ClientData data[3];
+} NRE_callback;
+
+/*
+ * - NOTES ON ALIGNMENT -
+ *
+ * . Cache lines are 64B long; callbacks are 32B on x86_64 and 16B on x32. In 
+ *   order to insure that no callback ever strides cache line boundaries, we
+ *   require the first callback to be aligned to 32b (on x32, 16B would be
+ *   enough).
+ * . we use a gcc'ism to insure alignment, portability not being the priority
+ *   right now.
+ */
+
+typedef struct NRE_stack {
+    struct NRE_callback items[NRE_STACK_SIZE];
+    struct NRE_stack *next;
+} NRE_stack  __attribute__ ((aligned (32)));
+
+#define NRE_newExtra(ptr)			\
+    TclSmallAlloc(5*sizeof(ClientData), ptr)
+#define NRE_freeExtra(ptr)  TclSmallFree(ptr)
+
+/*
+ * Inline versions of Tcl_NRAddCallback and friends
+ */
+
+#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
+
+#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2)	\
+    do {								\
+	NRE_callback *cbPtr;						\
+	ALLOC_CB(interp, cbPtr);					\
+	INIT_CB(cbPtr, postProcPtr,data0,data1,data2);		\
+    } while (0)
+
+#define INIT_CB(cbPtr, postProcPtr,data0,data1,data2)		\
+    do {								\
+	cbPtr->procPtr = (postProcPtr);					\
+	cbPtr->data[0] = (ClientData)(data0);				\
+	cbPtr->data[1] = (ClientData)(data1);				\
+	cbPtr->data[2] = (ClientData)(data2);				\
+    } while (0)
+
+#define POP_CB(interp, cbPtr)			\
+    (cbPtr) = TOP_CB(interp)++
+
+#define ALLOC_CB(interp, cbPtr)					\
+    do {							\
+	ExecEnv *eePtr = ((Interp *) interp)->execEnvPtr;	\
+	NRE_stack *this = eePtr->NRStack;			\
+								\
+	if (eePtr->callbackPtr &&					\
+		(eePtr->callbackPtr > &this->items[0])) { \
+	    (cbPtr) = --eePtr->callbackPtr;				\
+	} else {							\
+	    (cbPtr) = TclNewCallback(interp);				\
+	}								\
+    } while (0)
+
+#define NEXT_CB(ptr) TclNextCallback(ptr)
+
+#define NRE_TRAMPOLINE 0
+#if NRE_TRAMPOLINE
+#define NRE_JUMP(interp,postProcPtr,data0,data1,data2)		\
+    TclNRAddCallback((interp),(postProcPtr),(data0),(data1),(data2)); \
+    NRE_NEXT(TCL_OK)
+#define NRE_NEXT(result)			\
+    return (result)
+#else
+/* no trampoline, optimized sibcalls */
+#define NRE_JUMP(interp,postProcPtr,data0,data1,data2)			\
+    do {								\
+	NRE_callback *cbPtr;						\
+	ALLOC_CB(interp, cbPtr);					\
+	++TOP_CB(interp);						\
+	INIT_CB(cbPtr, postProcPtr,data0,data1,data2);			\
+	return (postProcPtr)(cbPtr->data, interp, (result));		\
+    } while (0)
+#define NRE_NEXT(result)					\
+    do { /* optimized indirect sibling calls?! */		\
+	NRE_callback *cbPtr;					\
+	POP_CB(interp, cbPtr);					\
+	return (cbPtr->procPtr)(cbPtr->data, interp, (result));	\
+    } while (0)
+#endif
+
+MODULE_SCOPE TCL_NOINLINE NRE_callback *TclNewCallback(Tcl_Interp *interp);
+MODULE_SCOPE TCL_NOINLINE NRE_callback *TclPopCallback(Tcl_Interp *interp);
+MODULE_SCOPE TCL_NOINLINE NRE_callback *TclNextCallback(NRE_callback *ptr);

generic/tclNamesp.c

@@ -3270,8 +3270,6 @@ NRNamespaceEvalCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    CmdFrame *invoker;
-    int word;
     Tcl_Namespace *namespacePtr;
     CallFrame *framePtr, **framePtrPtr;
     Tcl_Obj *objPtr;
@@ -3327,9 +3325,6 @@ NRNamespaceEvalCmd(
 	 */
 
 	objPtr = objv[2];
-	invoker = iPtr->cmdFramePtr;
-	word = 3;
-	TclArgumentGet(interp, objPtr, &invoker, &word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
@@ -3338,17 +3333,10 @@ NRNamespaceEvalCmd(
 	 */
 
 	objPtr = Tcl_ConcatObj(objc-2, objv+2);
-	invoker = NULL;
-	word = 0;
     }
 
-    /*
-     * TIP #280: Make invoking context available to eval'd script.
-     */
-
-    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
-	    NULL, NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
+    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL);
+    return TclNREvalObjEx(interp, objPtr, 0);
 }
 
 static int
@@ -3377,7 +3365,7 @@ NsEval_Callback(
      */
 
     TclPopStackFrame(interp);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -3788,9 +3776,8 @@ NRNamespaceInscopeCmd(
 	Tcl_DecrRefCount(listPtr);    /* We're done with the list object. */
     }
 
-    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
-	    NULL, NULL);
-    return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
+    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL);
+    return TclNREvalObjEx(interp, cmdObjPtr, 0);
 }
 
 /*
@@ -4821,20 +4808,11 @@ TclGetNamespaceChildTable(
  *
  * TclLogCommandInfo --
  *
- *	This function is invoked after an error occurs in an interpreter. It
- *	adds information to iPtr->errorInfo/errorStack fields to describe the
- *	command that was being executed when the error occurred. When pc and
- *	tosPtr are non-NULL, conveying a bytecode execution "inner context",
- *	and the offending instruction is suitable, that inner context is
- *	recorded in errorStack.
+ *	This function is invoked after an error occurs in an interpreter. 
  *
  * Results:
  *	None.
  *
- * Side effects:
- *	Information about the command is added to errorInfo/errorStack and the
- *	line number stored internally in the interpreter is set.
- *
  *----------------------------------------------------------------------
  */
 
@@ -4916,119 +4894,6 @@ TclLogCommandInfo(
 	    }
 	}
     }
-
-    /*
-     * TIP #348
-     */
-
-    if (Tcl_IsShared(iPtr->errorStack)) {
-	Tcl_Obj *newObj;
-
-	newObj = Tcl_DuplicateObj(iPtr->errorStack);
-	Tcl_DecrRefCount(iPtr->errorStack);
-	Tcl_IncrRefCount(newObj);
-	iPtr->errorStack = newObj;
-    }
-    if (iPtr->resetErrorStack) {
-	int len;
-
-	iPtr->resetErrorStack = 0;
-	Tcl_ListObjLength(interp, iPtr->errorStack, &len);
-
-	/*
-	 * Reset while keeping the list intrep as much as possible.
-	 */
-
-	Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
-	if (pc != NULL) {
-	    Tcl_Obj *innerContext;
-
-	    innerContext = TclGetInnerContext(interp, pc, tosPtr);
-	    if (innerContext != NULL) {
-		Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-			iPtr->innerLiteral);
-		Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext);
-	    }
-	} else if (command != NULL) {
-	    Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-		    iPtr->innerLiteral);
-	    Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-		    Tcl_NewStringObj(command, length));
-	}
-    }
-
-    if (!iPtr->framePtr->objc) {
-	/*
-	 * Special frame, nothing to report.
-	 */
-    } else if (iPtr->varFramePtr != iPtr->framePtr) {
-	/*
-	 * uplevel case, [lappend errorstack UP $relativelevel]
-	 */
-
-	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
-	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(
-		iPtr->framePtr->level - iPtr->varFramePtr->level));
-    } else if (iPtr->framePtr != iPtr->rootFramePtr) {
-	/*
-	 * normal case, [lappend errorstack CALL [info level 0]]
-	 */
-
-	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
-	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
-		iPtr->framePtr->objc, iPtr->framePtr->objv));
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclErrorStackResetIf --
- *
- *	The TIP 348 reset/no-bc part of TLCI, for specific use by
- *	TclCompileSyntaxError.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Reset errorstack if it needs be, and in that case remember the
- *	passed-in error message as inner context.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclErrorStackResetIf(
-    Tcl_Interp *interp,
-    const char *msg,
-    int length)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (Tcl_IsShared(iPtr->errorStack)) {
-	Tcl_Obj *newObj;
-
-	newObj = Tcl_DuplicateObj(iPtr->errorStack);
-	Tcl_DecrRefCount(iPtr->errorStack);
-	Tcl_IncrRefCount(newObj);
-	iPtr->errorStack = newObj;
-    }
-    if (iPtr->resetErrorStack) {
-	int len;
-
-	iPtr->resetErrorStack = 0;
-	Tcl_ListObjLength(interp, iPtr->errorStack, &len);
-
-	/*
-	 * Reset while keeping the list intrep as much as possible.
-	 */
-
-	Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
-	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
-	Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-		Tcl_NewStringObj(msg, length));
-    }
 }
 
 /*
@@ -5036,17 +4901,11 @@ TclErrorStackResetIf(
  *
  * Tcl_LogCommandInfo --
  *
- *	This function is invoked after an error occurs in an interpreter. It
- *	adds information to iPtr->errorInfo/errorStack fields to describe the
- *	command that was being executed when the error occurred.
+ *	This function is invoked after an error occurs in an interpreter.
  *
  * Results:
  *	None.
  *
- * Side effects:
- *	Information about the command is added to errorInfo/errorStack and the
- *	line number stored internally in the interpreter is set.
- *
  *----------------------------------------------------------------------
  */
 

generic/tclOO.c

@@ -1751,7 +1751,8 @@ TclNRNewObjectInstance(
     CallContext *contextPtr;
     Tcl_InterpState state;
     Object *oPtr;
-
+    ClientData *extra;
+    
     /*
      * Check if we're going to create an object over an existing command;
      * that's not allowed.
@@ -1825,8 +1826,10 @@ TclNRNewObjectInstance(
      */
 
     AddRef(oPtr);
-    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
-	    objectPtr);
+    NRE_newExtra(extra);
+    extra[0] = state;
+    extra[1] = objectPtr;
+    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, extra);
     TclPushTailcallPoint(interp);
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
 }
@@ -1839,8 +1842,11 @@ FinalizeAlloc(
 {
     CallContext *contextPtr = data[0];
     Object *oPtr = data[1];
-    Tcl_InterpState state = data[2];
-    Tcl_Object *objectPtr = data[3];
+    ClientData *extra = data[2];
+    Tcl_InterpState state = extra[0];
+    Tcl_Object *objectPtr = extra[1];
+
+    NRE_freeExtra(extra);
 
     /*
      * It's an error if the object was whacked in the constructor. Force this
@@ -1869,12 +1875,12 @@ FinalizeAlloc(
 	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
 	}
 	DelRef(oPtr);
-	return TCL_ERROR;
+	NRE_NEXT(TCL_ERROR);
     }
     Tcl_RestoreInterpState(interp, state);
     *objectPtr = (Tcl_Object) oPtr;
     DelRef(oPtr);
-    return TCL_OK;
+    NRE_NEXT(TCL_OK);
 }
 
 /*
@@ -2631,7 +2637,7 @@ TclOOObjectCmdCore(
      * for the duration.
      */
 
-    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
+    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL);
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
 }
 
@@ -2647,7 +2653,7 @@ FinalizeObjectCall(
      */
 
     TclOODeleteContext(data[0]);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -2785,7 +2791,7 @@ TclNRObjectContextInvokeNext(
      */
 
     TclNRAddCallback(interp, FinalizeNext, contextPtr,
-	    INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL);
+	    INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip));
     contextPtr->index++;
     contextPtr->skip = skip;
 
@@ -2811,7 +2817,7 @@ FinalizeNext(
 
     contextPtr->index = PTR2INT(data[1]);
     contextPtr->skip = PTR2INT(data[2]);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*

generic/tclOOBasic.c

@@ -13,6 +13,7 @@
 #ifdef HAVE_CONFIG_H
 #include "config.h"
 #endif
+
 #include "tclInt.h"
 #include "tclOOInt.h"
 
@@ -45,7 +46,7 @@ static inline Tcl_Object *
 AddConstructionFinalizer(
     Tcl_Interp *interp)
 {
-    TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
+    TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL);
     return (Tcl_Object *) &(TOP_CB(interp)->data[0]);
 }
 
@@ -58,10 +59,10 @@ FinalizeConstruction(
     Object *oPtr = data[0];
 
     if (result != TCL_OK) {
-	return result;
+	NRE_NEXT(result);
     }
     Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
-    return TCL_OK;
+    NRE_NEXT(TCL_OK);
 }
 
 /*
@@ -111,7 +112,7 @@ TclOO_Class_Constructor(
     Tcl_IncrRefCount(invoke[1]);
     Tcl_IncrRefCount(invoke[2]);
     TclNRAddCallback(interp, DecrRefsPostClassConstructor,
-	    invoke, NULL, NULL, NULL);
+	    invoke, NULL, NULL);
 
     /*
      * Tricky point: do not want the extra reported level in the Tcl stack
@@ -133,7 +134,7 @@ DecrRefsPostClassConstructor(
     TclDecrRefCount(invoke[1]);
     TclDecrRefCount(invoke[2]);
     ckfree(invoke);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -352,7 +353,7 @@ TclOO_Object_Destroy(
 	    contextPtr->callPtr->flags |= DESTRUCTOR;
 	    contextPtr->skip = 0;
 	    TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
-		    NULL, NULL, NULL);
+		    NULL, NULL);
 	    TclPushTailcallPoint(interp);
 	    return TclOOInvokeContext(contextPtr, interp, 0, NULL);
 	}
@@ -375,7 +376,7 @@ AfterNRDestructor(
 	Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
     }
     TclOODeleteContext(contextPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -402,7 +403,6 @@ TclOO_Object_Eval(
     register const int skip = Tcl_ObjectContextSkippedArgs(context);
     CallFrame *framePtr, **framePtrPtr = &framePtr;
     Tcl_Obj *scriptPtr;
-    CmdFrame *invoker;
 
     if (objc-1 < skip) {
 	Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
@@ -434,10 +434,8 @@ TclOO_Object_Eval(
 
     if (objc != skip+1) {
 	scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
-	invoker = NULL;
     } else {
 	scriptPtr = objv[skip];
-	invoker = ((Interp *) interp)->cmdFramePtr;
     }
 
     /*
@@ -445,8 +443,8 @@ TclOO_Object_Eval(
      * the script completes.
      */
 
-    TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
-    return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
+    TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL);
+    return TclNREvalObjEx(interp, scriptPtr, 0);
 }
 
 static int
@@ -475,7 +473,7 @@ FinalizeEval(
      */
 
     TclPopStackFrame(interp);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -799,7 +797,7 @@ TclOONextObjCmd(
      * that this is like [uplevel 1] and not [eval].
      */
 
-    TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
+    TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL);
     iPtr->varFramePtr = framePtr->callerVarPtr;
     return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
 }
@@ -870,7 +868,7 @@ TclOONextToObjCmd(
 	     */
 
 	    TclNRAddCallback(interp, NextRestoreFrame, framePtr,
-		    contextPtr, INT2PTR(contextPtr->index), NULL);
+		    contextPtr, INT2PTR(contextPtr->index));
 	    contextPtr->index = i-1;
 	    iPtr->varFramePtr = framePtr->callerVarPtr;
 	    return TclNRObjectContextInvokeNext(interp,
@@ -923,7 +921,7 @@ NextRestoreFrame(
     if (contextPtr != NULL) {
 	contextPtr->index = PTR2INT(data[2]);
     }
-    return result;
+    NRE_NEXT(result);
 }
 
 /*

generic/tclOOCall.c

@@ -283,8 +283,7 @@ TclOOInvokeContext(
 	 * this call is finished.
 	 */
 
-	TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
-		NULL);
+	TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL);
     }
 
     /*
@@ -292,9 +291,9 @@ TclOOInvokeContext(
      */
 
     if (contextPtr->oPtr->flags & FILTER_HANDLING) {
-	TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
+	TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL);
     } else {
-	TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
+	TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL);
     }
     if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
 	contextPtr->oPtr->flags |= FILTER_HANDLING;
@@ -319,7 +318,7 @@ SetFilterFlags(
     CallContext *contextPtr = data[0];
 
     contextPtr->oPtr->flags |= FILTER_HANDLING;
-    return result;
+    NRE_NEXT(result);
 }
 
 static int
@@ -331,7 +330,7 @@ ResetFilterFlags(
     CallContext *contextPtr = data[0];
 
     contextPtr->oPtr->flags &= ~FILTER_HANDLING;
-    return result;
+    NRE_NEXT(result);
 }
 
 static int
@@ -346,7 +345,7 @@ FinalizeMethodRefs(
     for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
 	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
     }
-    return result;
+    NRE_NEXT(result);
 }
 
 /*
@@ -726,6 +725,14 @@ AddSimpleChainToCallContext(
  * ----------------------------------------------------------------------
  */
 
+static TCL_NOINLINE void
+AddMethodToCallChainCore(
+    Method *const mPtr,
+    struct ChainBuilder *const cbPtr,
+    Tcl_HashTable *const doneFilters,
+    Class *const filterDecl,
+    int flags);
+
 static inline void
 AddMethodToCallChain(
     Method *const mPtr,		/* Actual method implementation to add to call
@@ -748,20 +755,43 @@ AddMethodToCallChain(
 				 * looking to add things from a mixin and have
 				 * not passed a mixin. */
 {
-    register CallChain *callPtr = cbPtr->callChainPtr;
-    int i;
-
     /*
-     * Return if this is just an entry used to record whether this is a public
+     * Check if this is just an entry used to record whether this is a public
      * method. If so, there's nothing real to call and so nothing to add to
      * the call chain.
      *
      * This is also where we enforce mixin-consistency.
      */
 
-    if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
-	return;
+    if (mPtr && mPtr->typePtr && MIXIN_CONSISTENT(flags)) {
+	AddMethodToCallChainCore(mPtr, cbPtr, doneFilters, filterDecl, flags);
     }
+}
+
+static TCL_NOINLINE void
+AddMethodToCallChainCore(
+    Method *const mPtr,		/* Actual method implementation to add to call
+				 * chain (or NULL, a no-op). */
+    struct ChainBuilder *const cbPtr,
+				/* The call chain to add the method
+				 * implementation to. */
+    Tcl_HashTable *const doneFilters,
+				/* Where to record what filters have been
+				 * processed. If NULL, not processing filters.
+				 * Note that this function does not update
+				 * this hashtable. */
+    Class *const filterDecl,	/* The class that declared the filter. If
+				 * NULL, either the filter was declared by the
+				 * object or this isn't a filter. */
+    int flags)			/* Used to check if we're mixin-consistent
+				 * only. Mixin-consistent means that either
+				 * we're looking to add things from a mixin
+				 * and we have passed a mixin, or we're not
+				 * looking to add things from a mixin and have
+				 * not passed a mixin. */
+{
+    register CallChain *callPtr = cbPtr->callChainPtr;
+    int i;
 
     /*
      * Enforce real private method handling here. We will skip adding this

generic/tclOODefineCmds.c

@@ -839,8 +839,7 @@ TclOODefineObjCmd(
 	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
 
 	Tcl_IncrRefCount(objNameObj);
-	result = TclEvalObjEx(interp, objv[2], 0,
-		((Interp *)interp)->cmdFramePtr, 2);
+	result = Tcl_EvalObjEx(interp, objv[2], 0);
 	if (result == TCL_ERROR) {
 	    GenerateErrorInfo(interp, oPtr, objNameObj, "class");
 	}
@@ -954,8 +953,7 @@ TclOOObjDefObjCmd(
 	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
 
 	Tcl_IncrRefCount(objNameObj);
-	result = TclEvalObjEx(interp, objv[2], 0,
-		((Interp *)interp)->cmdFramePtr, 2);
+	result = Tcl_EvalObjEx(interp, objv[2], 0);
 	if (result == TCL_ERROR) {
 	    GenerateErrorInfo(interp, oPtr, objNameObj, "object");
 	}
@@ -1069,8 +1067,7 @@ TclOODefineSelfObjCmd(
 	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
 
 	Tcl_IncrRefCount(objNameObj);
-	result = TclEvalObjEx(interp, objv[1], 0,
-		((Interp *)interp)->cmdFramePtr, 2);
+	result = Tcl_EvalObjEx(interp, objv[1], 0);
 	if (result == TCL_ERROR) {
 	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
 	}

generic/tclOOInt.h

@@ -94,9 +94,6 @@ typedef struct ProcedureMethod {
     TclOO_PostCallProc *postCallProc;
 				/* Callback to allow for additional cleanup
 				 * after the method executes. */
-    GetFrameInfoValueProc *gfivProc;
-				/* Callback to allow for fine tuning of how
-				 * the method reports itself. */
 } ProcedureMethod;
 
 #define TCLOO_PROCEDURE_METHOD_VERSION 0

generic/tclOOMethod.c

@@ -38,7 +38,6 @@ typedef struct {
     ProcErrorProc *errProc;	/* The error handler for the body. */
     Tcl_Obj *nameObj;		/* The "name" of the command. */
     Command cmd;		/* The command structure. Mostly bogus. */
-    ExtraFrameInfo efi;		/* Extra information used for [info frame]. */
     Command *oldCmdPtr;		/* Saved cmdPtr so that we can be safe after a
 				 * recursive call returns. */
     struct PNI pni;		/* Specialist information used in the efi
@@ -88,7 +87,6 @@ static void		ConstructorErrorHandler(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj);
 static void		DestructorErrorHandler(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj);
-static Tcl_Obj *	RenderDeclarerName(ClientData clientData);
 static int		InvokeForwardMethod(ClientData clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
@@ -458,7 +456,6 @@ TclOOMakeProcInstanceMethod(
 				 * inside the structure indicated by the
 				 * pointer in clientData. */
 {
-    Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
 
     if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
@@ -468,69 +465,6 @@ TclOOMakeProcInstanceMethod(
     procPtr = *procPtrPtr;
     procPtr->cmdPtr = NULL;
 
-    if (iPtr->cmdFramePtr) {
-	CmdFrame context = *iPtr->cmdFramePtr;
-
-	if (context.type == TCL_LOCATION_BC) {
-	    /*
-	     * Retrieve source information from the bytecode, if possible. If
-	     * the information is retrieved successfully, context.type will be
-	     * TCL_LOCATION_SOURCE and the reference held by
-	     * context.data.eval.path will be counted.
-	     */
-
-	    TclGetSrcInfoForPc(&context);
-	} else if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * The copy into 'context' up above has created another reference
-	     * to 'context.data.eval.path'; account for it.
-	     */
-
-	    Tcl_IncrRefCount(context.data.eval.path);
-	}
-
-	if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * We can account for source location within a proc only if the
-	     * proc body was not created by substitution.
-	     * (FIXME: check that this is sane and correct!)
-	     */
-
-	    if (context.line
-		    && (context.nline >= 4) && (context.line[3] >= 0)) {
-		int isNew;
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-		Tcl_HashEntry *hPtr;
-
-		cfPtr->level = -1;
-		cfPtr->type = context.type;
-		cfPtr->line = ckalloc(sizeof(int));
-		cfPtr->line[0] = context.line[3];
-		cfPtr->nline = 1;
-		cfPtr->framePtr = NULL;
-		cfPtr->nextPtr = NULL;
-
-		cfPtr->data.eval.path = context.data.eval.path;
-		Tcl_IncrRefCount(cfPtr->data.eval.path);
-
-		cfPtr->cmd = NULL;
-		cfPtr->len = 0;
-
-		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			(char *) procPtr, &isNew);
-		Tcl_SetHashValue(hPtr, cfPtr);
-	    }
-
-	    /*
-	     * 'context' is going out of scope; account for the reference that
-	     * it's holding to the path name.
-	     */
-
-	    Tcl_DecrRefCount(context.data.eval.path);
-	    context.data.eval.path = NULL;
-	}
-    }
-
     return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
 	    typePtr, clientData);
 }
@@ -571,7 +505,6 @@ TclOOMakeProcMethod(
 				 * inside the structure indicated by the
 				 * pointer in clientData. */
 {
-    Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
 
     if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
@@ -581,69 +514,6 @@ TclOOMakeProcMethod(
     procPtr = *procPtrPtr;
     procPtr->cmdPtr = NULL;
 
-    if (iPtr->cmdFramePtr) {
-	CmdFrame context = *iPtr->cmdFramePtr;
-
-	if (context.type == TCL_LOCATION_BC) {
-	    /*
-	     * Retrieve source information from the bytecode, if possible. If
-	     * the information is retrieved successfully, context.type will be
-	     * TCL_LOCATION_SOURCE and the reference held by
-	     * context.data.eval.path will be counted.
-	     */
-
-	    TclGetSrcInfoForPc(&context);
-	} else if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * The copy into 'context' up above has created another reference
-	     * to 'context.data.eval.path'; account for it.
-	     */
-
-	    Tcl_IncrRefCount(context.data.eval.path);
-	}
-
-	if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * We can account for source location within a proc only if the
-	     * proc body was not created by substitution.
-	     * (FIXME: check that this is sane and correct!)
-	     */
-
-	    if (context.line
-		    && (context.nline >= 4) && (context.line[3] >= 0)) {
-		int isNew;
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-		Tcl_HashEntry *hPtr;
-
-		cfPtr->level = -1;
-		cfPtr->type = context.type;
-		cfPtr->line = ckalloc(sizeof(int));
-		cfPtr->line[0] = context.line[3];
-		cfPtr->nline = 1;
-		cfPtr->framePtr = NULL;
-		cfPtr->nextPtr = NULL;
-
-		cfPtr->data.eval.path = context.data.eval.path;
-		Tcl_IncrRefCount(cfPtr->data.eval.path);
-
-		cfPtr->cmd = NULL;
-		cfPtr->len = 0;
-
-		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			(char *) procPtr, &isNew);
-		Tcl_SetHashValue(hPtr, cfPtr);
-	    }
-
-	    /*
-	     * 'context' is going out of scope; account for the reference that
-	     * it's holding to the path name.
-	     */
-
-	    Tcl_DecrRefCount(context.data.eval.path);
-	    context.data.eval.path = NULL;
-	}
-    }
-
     return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
 	    clientData);
 }
@@ -732,7 +602,7 @@ InvokeProcedureMethod(
      * Now invoke the body of the method.
      */
 
-    TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
+    TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr);
     return TclNRInterpProcCore(interp, fdPtr->nameObj,
 	    Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
 }
@@ -775,7 +645,7 @@ FinalizePMCall(
 	DeleteProcedureMethodRecord(pmPtr);
     }
     TclStackFree(interp, fdPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 static int
@@ -845,10 +715,8 @@ PushMethodCallFrame(
      * Compile the body. This operation may fail.
      */
 
-    fdPtr->efi.length = 2;
     memset(&fdPtr->cmd, 0, sizeof(Command));
     fdPtr->cmd.nsPtr = nsPtr;
-    fdPtr->cmd.clientData = &fdPtr->efi;
     pmPtr->procPtr->cmdPtr = &fdPtr->cmd;
 
     /*
@@ -883,32 +751,6 @@ PushMethodCallFrame(
     fdPtr->framePtr->objv = objv;
     fdPtr->framePtr->procPtr = pmPtr->procPtr;
 
-    /*
-     * Finish filling out the extra frame info so that [info frame] works.
-     */
-
-    fdPtr->efi.fields[0].name = "method";
-    fdPtr->efi.fields[0].proc = NULL;
-    fdPtr->efi.fields[0].clientData = fdPtr->nameObj;
-    if (pmPtr->gfivProc != NULL) {
-	fdPtr->efi.fields[1].name = "";
-	fdPtr->efi.fields[1].proc = pmPtr->gfivProc;
-	fdPtr->efi.fields[1].clientData = pmPtr;
-    } else {
-	register Tcl_Method method =
-		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr);
-
-	if (Tcl_MethodDeclarerObject(method) != NULL) {
-	    fdPtr->efi.fields[1].name = "object";
-	} else {
-	    fdPtr->efi.fields[1].name = "class";
-	}
-	fdPtr->efi.fields[1].proc = RenderDeclarerName;
-	fdPtr->efi.fields[1].clientData = &fdPtr->pni;
-	fdPtr->pni.interp = interp;
-	fdPtr->pni.method = method;
-    }
-
     return TCL_OK;
 
     /*
@@ -1114,32 +956,6 @@ ProcedureMethodCompiledVarResolver(
     return TCL_OK;
 }
 
-/*
- * ----------------------------------------------------------------------
- *
- * RenderDeclarerName --
- *
- *	Returns the name of the entity (object or class) which declared a
- *	method. Used for producing information for [info frame] in such a way
- *	that the expensive part of this (generating the object or class name
- *	itself) isn't done until it is needed.
- *
- * ----------------------------------------------------------------------
- */
-
-static Tcl_Obj *
-RenderDeclarerName(
-    ClientData clientData)
-{
-    struct PNI *pni = clientData;
-    Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);
-
-    if (object == NULL) {
-	object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
-    }
-    return TclOOObjectName(pni->interp, (Object *) object);
-}
-
 /*
  * ----------------------------------------------------------------------
  *
@@ -1457,7 +1273,7 @@ InvokeForwardMethod(
     Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
     argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
 	    numPrefixes, prefixObjs, &len);
-    Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL);
     ((Interp *)interp)->lookupNsPtr
 	    = (Namespace *) contextPtr->oPtr->namespacePtr;
     return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
@@ -1472,7 +1288,7 @@ FinalizeForwardCall(
     Tcl_Obj **argObjs = data[0];
 
     TclStackFree(interp, argObjs);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*

generic/tclObj.c

@@ -51,21 +51,6 @@ Tcl_Mutex tclObjMutex;
 char tclEmptyString = '\0';
 char *tclEmptyStringRep = &tclEmptyString;
 
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
-/*
- * Structure for tracking the source file and line number where a given
- * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
- * for sanity checking purposes.
- */
-
-typedef struct ObjData {
-    Tcl_Obj *objPtr;		/* The pointer to the allocated Tcl_Obj. */
-    const char *file;		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line;			/* Line number in the source file; used for
-				 * debugging. */
-} ObjData;
-#endif /* TCL_MEM_DEBUG && TCL_THREADS */
 
 /*
  * All static variables used in this file are collected into a single instance
@@ -77,17 +62,6 @@ typedef struct ObjData {
  */
 
 typedef struct ThreadSpecificData {
-    Tcl_HashTable *lineCLPtr;   /* This table remembers for each Tcl_Obj
-                                 * generated by a call to the function
-                                 * TclSubstTokens() from a literal text
-                                 * where bs+nl sequences occured in it, if
-                                 * any. I.e. this table keeps track of
-                                 * invisible and stripped continuation lines.
-                                 * Its keys are Tcl_Obj pointers, the values
-                                 * are ContLineLoc pointers. See the file
-                                 * tclCompile.h for the definition of this
-                                 * structure, and for references to all
-                                 * related places in the core. */
 #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
     Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
                                  * that a Tcl_Obj was not allocated by some
@@ -95,11 +69,6 @@ typedef struct ThreadSpecificData {
 #endif /* TCL_MEM_DEBUG && TCL_THREADS */
 } ThreadSpecificData;
 
-static Tcl_ThreadDataKey dataKey;
-
-static void             TclThreadFinalizeContLines(ClientData clientData);
-static ThreadSpecificData *TclGetContLineTable(void);
-
 /*
  * Nested Tcl_Obj deletion management support
  *
@@ -508,310 +477,6 @@ TclFinalizeObjects(void)
     Tcl_MutexUnlock(&tclObjMutex);
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * TclGetContLineTable --
- *
- *	This procedure is a helper which returns the thread-specific
- *	hash-table used to track continuation line information associated with
- *	Tcl_Obj*, and the objThreadMap, etc.
- *
- * Results:
- *	A reference to the thread-data.
- *
- * Side effects:
- *	May allocate memory for the thread-data.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-static ThreadSpecificData *
-TclGetContLineTable(void)
-{
-    /*
-     * Initialize the hashtable tracking invisible continuation lines.  For
-     * the release we use a thread exit handler to ensure that this is done
-     * before TSD blocks are made invalid. The TclFinalizeObjects() which
-     * would be the natural place for this is invoked afterwards, meaning that
-     * we try to operate on a data structure already gone.
-     */
-
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (!tsdPtr->lineCLPtr) {
-	tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
-	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
-    }
-    return tsdPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclContinuationsEnter --
- *
- *	This procedure is a helper which saves the continuation line
- *	information associated with a Tcl_Obj*.
- *
- * Results:
- *	A reference to the newly created continuation line location table.
- *
- * Side effects:
- *	Allocates memory for the table of continuation line locations.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-ContLineLoc *
-TclContinuationsEnter(
-    Tcl_Obj *objPtr,
-    int num,
-    int *loc)
-{
-    int newEntry;
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
-    ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
-
-    if (!newEntry) {
-	/*
-	 * We're entering ContLineLoc data for the same value more than one
-	 * time. Taking care not to leak the old entry.
-	 *
-	 * This can happen when literals in a proc body are shared. See for
-	 * example test info-30.19 where the action (code) for all branches of
-	 * the switch command is identical, mapping them all to the same
-	 * literal. An interesting result of this is that the number and
-	 * locations (offset) of invisible continuation lines in the literal
-	 * are the same for all occurences.
-	 *
-	 * Note that while reusing the existing entry is possible it requires
-	 * the same actions as for a new entry because we have to copy the
-	 * incoming num/loc data even so. Because we are called from
-	 * TclContinuationsEnterDerived for this case, which modified the
-	 * stored locations (Rebased to the proper relative offset). Just
-	 * returning the stored entry would rebase them a second time, or
-	 * more, hosing the data. It is easier to simply replace, as we are
-	 * doing.
-	 */
-
-	ckfree(Tcl_GetHashValue(hPtr));
-    }
-
-    clLocPtr->num = num;
-    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
-    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
-    Tcl_SetHashValue(hPtr, clLocPtr);
-
-    return clLocPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclContinuationsEnterDerived --
- *
- *	This procedure is a helper which computes the continuation line
- *	information associated with a Tcl_Obj* cut from the middle of a
- *	script.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocates memory for the table of continuation line locations.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-void
-TclContinuationsEnterDerived(
-    Tcl_Obj *objPtr,
-    int start,
-    int *clNext)
-{
-    int length, end, num;
-    int *wordCLLast = clNext;
-
-    /*
-     * We have to handle invisible continuations lines here as well, despite
-     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
-     * our script is the sole argument to an 'eval' command, for example, the
-     * scriptCLLocPtr we are using was generated by a previous call to TST,
-     * and while the words we have here may contain continuation lines they
-     * are invisible already, and the inner call to TST had no bs+nl sequences
-     * to trigger its code.
-     *
-     * Luckily for us, the table we have to create here for the current word
-     * has to be a slice of the table currently in use, with the locations
-     * suitably modified to be relative to the start of the word instead of
-     * relative to the script.
-     *
-     * That is what we are doing now. Determine the slice we need, and if not
-     * empty, wrap it into a new table, and save the result into our
-     * thread-global hashtable, as usual.
-     */
-
-    /*
-     * First compute the range of the word within the script. (Is there a
-     * better way which doesn't shimmer?)
-     */
-
-    Tcl_GetStringFromObj(objPtr, &length);
-    end = start + length;       /* First char after the word */
-
-    /*
-     * Then compute the table slice covering the range of the word.
-     */
-
-    while (*wordCLLast >= 0 && *wordCLLast < end) {
-	wordCLLast++;
-    }
-
-    /*
-     * And generate the table from the slice, if it was not empty.
-     */
-
-    num = wordCLLast - clNext;
-    if (num) {
-	int i;
-	ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
-
-	/*
-	 * Re-base the locations.
-	 */
-
-	for (i=0 ; i<num ; i++) {
-	    clLocPtr->loc[i] -= start;
-
-	    /*
-	     * Continuation lines coming before the string and affecting us
-	     * should not happen, due to the proper maintenance of clNext
-	     * during compilation.
-	     */
-
-	    if (clLocPtr->loc[i] < 0) {
-		Tcl_Panic("Derived ICL data for object using offsets from before the script");
-	    }
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclContinuationsCopy --
- *
- *	This procedure is a helper which copies the continuation line
- *	information associated with a Tcl_Obj* to another Tcl_Obj*. It is
- *	assumed that both contain the same string/script. Use this when a
- *	script is duplicated because it was shared.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocates memory for the table of continuation line locations.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-void
-TclContinuationsCopy(
-    Tcl_Obj *objPtr,
-    Tcl_Obj *originObjPtr)
-{
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-            Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
-
-    if (hPtr) {
-	ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
-
-	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclContinuationsGet --
- *
- *	This procedure is a helper which retrieves the continuation line
- *	information associated with a Tcl_Obj*, if it has any.
- *
- * Results:
- *	A reference to the continuation line location table, or NULL if the
- *	Tcl_Obj* has no such information associated with it.
- *
- * Side effects:
- *	None.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-ContLineLoc *
-TclContinuationsGet(
-    Tcl_Obj *objPtr)
-{
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-            Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
-
-    if (!hPtr) {
-        return NULL;
-    }
-    return Tcl_GetHashValue(hPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclThreadFinalizeContLines --
- *
- *	This procedure is a helper which releases all continuation line
- *	information currently known. It is run as a thread exit handler.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Releases memory.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-static void
-TclThreadFinalizeContLines(
-    ClientData clientData)
-{
-    /*
-     * Release the hashtable tracking invisible continuation lines.
-     */
-
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch hSearch;
-
-    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
-	ckfree(Tcl_GetHashValue(hPtr));
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
-    ckfree(tsdPtr->lineCLPtr);
-    tsdPtr->lineCLPtr = NULL;
-}
-
 /*
  *--------------------------------------------------------------
  *
@@ -1388,29 +1053,6 @@ TclFreeObj(
 	}
 	ObjDeletionUnlock(context);
     }
-
-    /*
-     * We cannot use TclGetContinuationTable() here, because that may
-     * re-initialize the thread-data for calls coming after the finalization.
-     * We have to access it using the low-level call and then check for
-     * validity. This function can be called after TclFinalizeThreadData() has
-     * already killed the thread-global data structures. Performing
-     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
-     * which we crash (if we where to access the uninitialized hashtable).
-     */
-
-    {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-        Tcl_HashEntry *hPtr;
-
-	if (tsdPtr->lineCLPtr) {
-            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
-	    if (hPtr) {
-		ckfree(Tcl_GetHashValue(hPtr));
-		Tcl_DeleteHashEntry(hPtr);
-	    }
-	}
-    }
 }
 #else /* TCL_MEM_DEBUG */
 
@@ -1479,29 +1121,6 @@ TclFreeObj(
 	    ObjDeletionUnlock(context);
 	}
     }
-
-    /*
-     * We cannot use TclGetContinuationTable() here, because that may
-     * re-initialize the thread-data for calls coming after the finalization.
-     * We have to access it using the low-level call and then check for
-     * validity. This function can be called after TclFinalizeThreadData() has
-     * already killed the thread-global data structures. Performing
-     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
-     * which we crash (if we where to access the uninitialized hashtable).
-     */
-
-    {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-        Tcl_HashEntry *hPtr;
-
-	if (tsdPtr->lineCLPtr) {
-            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
-	    if (hPtr) {
-		ckfree(Tcl_GetHashValue(hPtr));
-		Tcl_DeleteHashEntry(hPtr);
-	    }
-	}
-    }
 }
 #endif /* TCL_MEM_DEBUG */
 

generic/tclParse.c

@@ -1596,7 +1596,7 @@ Tcl_ParseVar(
     }
 
     code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
-	    NULL, 1, NULL, NULL);
+	    NULL);
     Tcl_FreeParse(parsePtr);
     TclStackFree(interp, parsePtr);
     if (code != TCL_OK) {
@@ -2138,33 +2138,13 @@ TclSubstTokens(
 				 * evaluate and concatenate. */
     int count,			/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
-    int *tokensLeftPtr,		/* If not NULL, points to memory where an
+    int *tokensLeftPtr)		/* If not NULL, points to memory where an
 				 * integer representing the number of tokens
 				 * left to be substituted will be written */
-    int line,			/* The line the script starts on. */
-    int *clNextOuter,		/* Information about an outer context for */
-    const char *outerScript)	/* continuation line data. This is set by
-				 * EvalEx() to properly handle [...]-nested
-				 * commands. The 'outerScript' refers to the
-				 * most-outer script containing the embedded
-				 * command, which is refered to by 'script'.
-				 * The 'clNextOuter' refers to the current
-				 * entry in the table of continuation lines in
-				 * this "master script", and the character
-				 * offsets are relative to the 'outerScript'
-				 * as well.
-				 *
-				 * If outerScript == script, then this call is
-				 * for words in the outer-most script or
-				 * command. See Tcl_EvalEx and TclEvalObjEx
-				 * for the places generating arguments for
-				 * which this is true. */
 {
     Tcl_Obj *result;
     int code = TCL_OK;
 #define NUM_STATIC_POS 20
-    int isLiteral, maxNumCL, numCL, i, adjust;
-    int *clPosition = NULL;
     Interp *iPtr = (Interp *) interp;
     int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
 
@@ -2178,31 +2158,6 @@ TclSubstTokens(
      * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
      */
 
-    /*
-     * For the handling of continuation lines in literals we first check if
-     * this is actually a literal. For if not we can forego the additional
-     * processing. Otherwise we pre-allocate a small table to store the
-     * locations of all continuation lines we find in this literal, if any.
-     * The table is extended if needed.
-     */
-
-    numCL = 0;
-    maxNumCL = 0;
-    isLiteral = 1;
-    for (i=0 ; i < count; i++) {
-	if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
-		&& (tokenPtr[i].type != TCL_TOKEN_BS)) {
-	    isLiteral = 0;
-	    break;
-	}
-    }
-
-    if (isLiteral) {
-	maxNumCL = NUM_STATIC_POS;
-	clPosition = ckalloc(maxNumCL * sizeof(int));
-    }
-
-    adjust = 0;
     result = NULL;
     for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
 	Tcl_Obj *appendObj = NULL;
@@ -2220,64 +2175,13 @@ TclSubstTokens(
 	    appendByteLength = TclParseBackslash(tokenPtr->start,
 		    tokenPtr->size, NULL, utfCharBytes);
 	    append = utfCharBytes;
-
-	    /*
-	     * If the backslash sequence we found is in a literal, and
-	     * represented a continuation line, we compute and store its
-	     * location (as char offset to the beginning of the _result_
-	     * script). We may have to extend the table of locations.
-	     *
-	     * Note that the continuation line information is relevant even if
-	     * the word we are processing is not a literal, as it can affect
-	     * nested commands. See the branch for TCL_TOKEN_COMMAND below,
-	     * where the adjustment we are tracking here is taken into
-	     * account. The good thing is that we do not need a table of
-	     * everything, just the number of lines we have to add as
-	     * correction.
-	     */
-
-	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
-		    && (tokenPtr->start[1] == '\n')) {
-		if (isLiteral) {
-		    int clPos;
-
-		    if (result == 0) {
-			clPos = 0;
-		    } else {
-			Tcl_GetStringFromObj(result, &clPos);
-		    }
-
-		    if (numCL >= maxNumCL) {
-			maxNumCL *= 2;
-			clPosition = ckrealloc(clPosition,
-				maxNumCL * sizeof(int));
-		    }
-		    clPosition[numCL] = clPos;
-		    numCL++;
-		}
-		adjust++;
-	    }
 	    break;
 
 	case TCL_TOKEN_COMMAND: {
-	    /* TIP #280: Transfer line information to nested command */
 	    iPtr->numLevels++;
 	    code = TclInterpReady(interp);
 	    if (code == TCL_OK) {
-		/*
-		 * Test cases: info-30.{6,8,9}
-		 */
-
-		int theline;
-
-		TclAdvanceContinuations(&line, &clNextOuter,
-			tokenPtr->start - outerScript);
-		theline = line + adjust;
-		code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
-			0, theline, clNextOuter, outerScript);
-
-		TclAdvanceLines(&line, tokenPtr->start+1,
-			tokenPtr->start + tokenPtr->size - 1);
+		code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, 0);
 
 		/*
 		 * Restore flag reset by nested eval for future bracketed
@@ -2304,7 +2208,7 @@ TclSubstTokens(
 		 */
 
 		code = TclSubstTokens(interp, tokenPtr+2,
-			tokenPtr->numComponents - 1, NULL, line, NULL, NULL);
+			tokenPtr->numComponents - 1, NULL);
 		arrayIndex = Tcl_GetObjResult(interp);
 		Tcl_IncrRefCount(arrayIndex);
 	    }
@@ -2388,27 +2292,6 @@ TclSubstTokens(
     if (code != TCL_ERROR) {		/* Keep error message in result! */
 	if (result != NULL) {
 	    Tcl_SetObjResult(interp, result);
-
-	    /*
-	     * If the code found continuation lines (which implies that this
-	     * word is a literal), then we store the accumulated table of
-	     * locations in the thread-global data structure for the bytecode
-	     * compiler to find later, assuming that the literal is a script
-	     * which will be compiled.
-	     */
-
-	    if (numCL) {
-		TclContinuationsEnter(result, numCL, clPosition);
-	    }
-
-	    /*
-	     * Release the temp table we used to collect the locations of
-	     * continuation lines, if any.
-	     */
-
-	    if (maxNumCL) {
-		ckfree(clPosition);
-	    }
 	} else {
 	    Tcl_ResetResult(interp);
 	}

generic/tclProc.c

@@ -24,7 +24,6 @@
 typedef struct {
     int isRootEnsemble;
     Command cmd;
-    ExtraFrameInfo efi;
 } ApplyExtraData;
 
 /*
@@ -209,101 +208,6 @@ Tcl_ProcObjCmd(
 
     procPtr->cmdPtr = (Command *) cmd;
 
-    /*
-     * TIP #280: Remember the line the procedure body is starting on. In a
-     * bytecode context we ask the engine to provide us with the necessary
-     * information. This is for the initialization of the byte code compiler
-     * when the body is used for the first time.
-     *
-     * This code is nearly identical to the #280 code in SetLambdaFromAny, see
-     * this file. The differences are the different index of the body in the
-     * line array of the context, and the lambda code requires some special
-     * processing. Find a way to factor the common elements into a single
-     * function.
-     */
-
-    if (iPtr->cmdFramePtr) {
-	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-
-	*contextPtr = *iPtr->cmdFramePtr;
-	if (contextPtr->type == TCL_LOCATION_BC) {
-	    /*
-	     * Retrieve source information from the bytecode, if possible. If
-	     * the information is retrieved successfully, context.type will be
-	     * TCL_LOCATION_SOURCE and the reference held by
-	     * context.data.eval.path will be counted.
-	     */
-
-	    TclGetSrcInfoForPc(contextPtr);
-	} else if (contextPtr->type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * The copy into 'context' up above has created another reference
-	     * to 'context.data.eval.path'; account for it.
-	     */
-
-	    Tcl_IncrRefCount(contextPtr->data.eval.path);
-	}
-
-	if (contextPtr->type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * We can account for source location within a proc only if the
-	     * proc body was not created by substitution.
-	     */
-
-	    if (contextPtr->line
-		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
-		int isNew;
-		Tcl_HashEntry *hePtr;
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-
-		cfPtr->level = -1;
-		cfPtr->type = contextPtr->type;
-		cfPtr->line = ckalloc(sizeof(int));
-		cfPtr->line[0] = contextPtr->line[3];
-		cfPtr->nline = 1;
-		cfPtr->framePtr = NULL;
-		cfPtr->nextPtr = NULL;
-
-		cfPtr->data.eval.path = contextPtr->data.eval.path;
-		Tcl_IncrRefCount(cfPtr->data.eval.path);
-
-		cfPtr->cmd = NULL;
-		cfPtr->len = 0;
-
-		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			procPtr, &isNew);
-		if (!isNew) {
-		    /*
-		     * Get the old command frame and release it. See also
-		     * TclProcCleanupProc in this file. Currently it seems as
-		     * if only the procbodytest::proc command of the testsuite
-		     * is able to trigger this situation.
-		     */
-
-		    CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);
-
-		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
-			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
-			cfOldPtr->data.eval.path = NULL;
-		    }
-		    ckfree(cfOldPtr->line);
-		    cfOldPtr->line = NULL;
-		    ckfree(cfOldPtr);
-		}
-		Tcl_SetHashValue(hePtr, cfPtr);
-	    }
-
-	    /*
-	     * 'contextPtr' is going out of scope; account for the reference
-	     * that it's holding to the path name.
-	     */
-
-	    Tcl_DecrRefCount(contextPtr->data.eval.path);
-	    contextPtr->data.eval.path = NULL;
-	}
-	TclStackFree(interp, contextPtr);
-    }
-
     /*
      * Optimize for no-op procs: if the body is not precompiled (like a TclPro
      * procbody), and the argument list is just "args" and the body is empty,
@@ -438,18 +342,8 @@ TclCreateProc(
 	 */
 
 	if (Tcl_IsShared(bodyPtr)) {
-	    Tcl_Obj *sharedBodyPtr = bodyPtr;
-
 	    bytes = TclGetStringFromObj(bodyPtr, &length);
 	    bodyPtr = Tcl_NewStringObj(bytes, length);
-
-	    /*
-	     * TIP #280.
-	     * Ensure that the continuation line data for the original body is
-	     * not lost and applies to the new body as well.
-	     */
-
-	    TclContinuationsCopy(bodyPtr, sharedBodyPtr);
 	}
 
 	/*
@@ -936,7 +830,7 @@ Uplevel_Callback(
      */
 
     ((Interp *)interp)->varFramePtr = savedVarFramePtr;
-    return result;
+    NRE_NEXT(result);
 }
 
 	/* ARGSUSED */
@@ -959,8 +853,6 @@ TclNRUplevelObjCmd(
 {
 
     register Interp *iPtr = (Interp *) interp;
-    CmdFrame *invoker = NULL;
-    int word = 0;
     int result;
     CallFrame *savedVarFramePtr, *framePtr;
     Tcl_Obj *objPtr;
@@ -997,11 +889,6 @@ TclNRUplevelObjCmd(
      */
 
     if (objc == 1) {
-	/*
-	 * TIP #280. Make actual argument location available to eval'd script
-	 */
-
-	TclArgumentGet(interp, objv[0], &invoker, &word);
 	objPtr = objv[0];
 
     } else {
@@ -1014,9 +901,8 @@ TclNRUplevelObjCmd(
 	objPtr = Tcl_ConcatObj(objc, objv);
     }
 
-    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
-	    NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
+    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL);
+    return TclNREvalObjEx(interp, objPtr, 0);
 }
 
 /*
@@ -1783,14 +1669,6 @@ TclNRInterpProcCore(
 	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
 		a[8], a[9]);
     }
-    if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
-	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
-	const char *a[6]; int i[2];
-
-	TclDTraceInfo(info, a, i);
-	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
-	TclDecrRefCount(info);
-    }
     if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
 	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
 
@@ -1816,8 +1694,7 @@ TclNRInterpProcCore(
     procPtr->refCount++;
     codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
 
-    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
-	    NULL, NULL);
+    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, NULL);
     return TclNRExecuteByteCode(interp, codePtr);
 }
 
@@ -1870,7 +1747,7 @@ InterpProcNR2(
     TclStackFree(interp, freePtr->compiledLocals);
 					/* Free compiledLocals. */
     TclStackFree(interp, freePtr);	/* Free CallFrame. */
-    return result;
+    NRE_NEXT(result);
 
     /*
      * Process any non-TCL_OK result code.
@@ -1988,8 +1865,6 @@ TclProcCompileProc(
     }
 
     if (bodyPtr->typePtr != &tclByteCodeType) {
-	Tcl_HashEntry *hePtr;
-
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile >= 1) {
 	    /*
@@ -2055,21 +1930,7 @@ TclProcCompileProc(
 	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
 		/* isProcCallFrame */ 0);
 
-	/*
-	 * TIP #280: We get the invoking context from the cmdFrame which
-	 * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
-	 */
-
-	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
-
-	/*
-	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
-	 */
-
-	iPtr->invokeWord = 0;
-	iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
 	TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
-	iPtr->invokeCmdFramePtr = NULL;
 	TclPopStackFrame(interp);
     } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
 	/*
@@ -2174,9 +2035,6 @@ TclProcCleanupProc(
     Tcl_Obj *bodyPtr = procPtr->bodyPtr;
     Tcl_Obj *defPtr;
     Tcl_ResolvedVarInfo *resVarInfo;
-    Tcl_HashEntry *hePtr = NULL;
-    CmdFrame *cfPtr = NULL;
-    Interp *iPtr = procPtr->iPtr;
 
     if (bodyPtr != NULL) {
 	Tcl_DecrRefCount(bodyPtr);
@@ -2201,34 +2059,6 @@ TclProcCleanupProc(
 	localPtr = nextPtr;
     }
     ckfree(procPtr);
-
-    /*
-     * TIP #280: Release the location data associated with this Proc
-     * structure, if any. The interpreter may not exist (For example for
-     * procbody structures created by tbcload.
-     */
-
-    if (iPtr == NULL) {
-	return;
-    }
-
-    hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
-    if (!hePtr) {
-	return;
-    }
-
-    cfPtr = Tcl_GetHashValue(hePtr);
-
-    if (cfPtr) {
-	if (cfPtr->type == TCL_LOCATION_SOURCE) {
-	    Tcl_DecrRefCount(cfPtr->data.eval.path);
-	    cfPtr->data.eval.path = NULL;
-	}
-	ckfree(cfPtr->line);
-	cfPtr->line = NULL;
-	ckfree(cfPtr);
-    }
-    Tcl_DeleteHashEntry(hePtr);
 }
 
 /*
@@ -2454,11 +2284,9 @@ SetLambdaFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
     register Tcl_Obj *objPtr)	/* The object to convert. */
 {
-    Interp *iPtr = (Interp *) interp;
     const char *name;
     Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
-    int isNew, objc, result;
-    CmdFrame *cfPtr = NULL;
+    int objc, result;
     Proc *procPtr;
 
     if (interp == NULL) {
@@ -2503,93 +2331,6 @@ SetLambdaFromAny(
 
     procPtr->cmdPtr = NULL;
 
-    /*
-     * TIP #280: Remember the line the apply body is starting on. In a Byte
-     * code context we ask the engine to provide us with the necessary
-     * information. This is for the initialization of the byte code compiler
-     * when the body is used for the first time.
-     *
-     * NOTE: The body is the second word in the 'objPtr'. Its location,
-     * accessible through 'context.line[1]' (see below) is therefore only the
-     * first approximation of the actual line the body is on. We have to use
-     * the string rep of the 'objPtr' to determine the exact line. This is
-     * available already through 'name'. Use 'TclListLines', see 'switch'
-     * (tclCmdMZ.c).
-     *
-     * This code is nearly identical to the #280 code in Tcl_ProcObjCmd, see
-     * this file. The differences are the different index of the body in the
-     * line array of the context, and the special processing mentioned in the
-     * previous paragraph to track into the list. Find a way to factor the
-     * common elements into a single function.
-     */
-
-    if (iPtr->cmdFramePtr) {
-	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-
-	*contextPtr = *iPtr->cmdFramePtr;
-	if (contextPtr->type == TCL_LOCATION_BC) {
-	    /*
-	     * Retrieve the source context from the bytecode. This call
-	     * accounts for the reference to the source file, if any, held in
-	     * 'context.data.eval.path'.
-	     */
-
-	    TclGetSrcInfoForPc(contextPtr);
-	} else if (contextPtr->type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * We created a new reference to the source file path name when we
-	     * created 'context' above. Account for the reference.
-	     */
-
-	    Tcl_IncrRefCount(contextPtr->data.eval.path);
-
-	}
-
-	if (contextPtr->type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * We can record source location within a lambda only if the body
-	     * was not created by substitution.
-	     */
-
-	    if (contextPtr->line
-		    && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
-		int buf[2];
-
-		/*
-		 * Move from approximation (line of list cmd word) to actual
-		 * location (line of 2nd list element).
-		 */
-
-		cfPtr = ckalloc(sizeof(CmdFrame));
-		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
-
-		cfPtr->level = -1;
-		cfPtr->type = contextPtr->type;
-		cfPtr->line = ckalloc(sizeof(int));
-		cfPtr->line[0] = buf[1];
-		cfPtr->nline = 1;
-		cfPtr->framePtr = NULL;
-		cfPtr->nextPtr = NULL;
-
-		cfPtr->data.eval.path = contextPtr->data.eval.path;
-		Tcl_IncrRefCount(cfPtr->data.eval.path);
-
-		cfPtr->cmd = NULL;
-		cfPtr->len = 0;
-	    }
-
-	    /*
-	     * 'contextPtr' is going out of scope. Release the reference that
-	     * it's holding to the source file path
-	     */
-
-	    Tcl_DecrRefCount(contextPtr->data.eval.path);
-	}
-	TclStackFree(interp, contextPtr);
-    }
-    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr,
-	    &isNew), cfPtr);
-
     /*
      * Set the namespace for this lambda: given by objv[2] understood as a
      * global reference, or else global per default.
@@ -2728,22 +2469,6 @@ TclNRApplyObjCmd(
     procPtr->cmdPtr = &extraPtr->cmd;
     extraPtr->cmd.nsPtr = (Namespace *) nsPtr;
 
-    /*
-     * TIP#280 (semi-)HACK!
-     *
-     * Using cmd.clientData to tell [info frame] how to render the lambdaPtr.
-     * The InfoFrameCmd will detect this case by testing cmd.hPtr for NULL.
-     * This condition holds here because of the memset() above, and nowhere
-     * else (in the core). Regular commands always have a valid hPtr, and
-     * lambda's never.
-     */
-
-    extraPtr->efi.length = 1;
-    extraPtr->efi.fields[0].name = "lambda";
-    extraPtr->efi.fields[0].proc = NULL;
-    extraPtr->efi.fields[0].clientData = lambdaPtr;
-    extraPtr->cmd.clientData = &extraPtr->efi;
-
     isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
     if (isRootEnsemble) {
 	iPtr->ensembleRewrite.sourceObjs = objv;
@@ -2756,7 +2481,7 @@ TclNRApplyObjCmd(
 
     result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
     if (result == TCL_OK) {
-	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
+	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL);
 	result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
     }
     return result;
@@ -2775,7 +2500,7 @@ ApplyNR2(
     }
 
     TclStackFree(interp, extraPtr);
-    return result;
+    NRE_NEXT(result);
 }
 
 /*

generic/tclResult.c

@@ -17,7 +17,7 @@
 
 enum returnKeys {
     KEY_CODE,	KEY_ERRORCODE,	KEY_ERRORINFO,	KEY_ERRORLINE,
-    KEY_LEVEL,	KEY_OPTIONS,	KEY_ERRORSTACK,	KEY_LAST
+    KEY_LEVEL,	KEY_OPTIONS,	KEY_LAST
 };
 
 /*
@@ -27,7 +27,6 @@ enum returnKeys {
 static Tcl_Obj **	GetKeys(void);
 static void		ReleaseKeys(ClientData clientData);
 static void		ResetObjResult(Interp *iPtr);
-static void		SetupAppendBuffer(Interp *iPtr, int newSpace);
 
 /*
  * This structure is used to take a snapshot of the interpreter state in
@@ -44,8 +43,6 @@ typedef struct InterpState {
     Tcl_Obj *errorCode;
     Tcl_Obj *returnOpts;
     Tcl_Obj *objResult;
-    Tcl_Obj *errorStack;
-    int resetErrorStack;
 } InterpState;
 
 /*
@@ -82,8 +79,6 @@ Tcl_SaveInterpState(
     statePtr->returnLevel = iPtr->returnLevel;
     statePtr->returnCode = iPtr->returnCode;
     statePtr->errorInfo = iPtr->errorInfo;
-    statePtr->errorStack = iPtr->errorStack;
-    statePtr->resetErrorStack = iPtr->resetErrorStack;
     if (statePtr->errorInfo) {
 	Tcl_IncrRefCount(statePtr->errorInfo);
     }
@@ -95,9 +90,6 @@ Tcl_SaveInterpState(
     if (statePtr->returnOpts) {
 	Tcl_IncrRefCount(statePtr->returnOpts);
     }
-    if (statePtr->errorStack) {
-	Tcl_IncrRefCount(statePtr->errorStack);
-    }
     statePtr->objResult = Tcl_GetObjResult(interp);
     Tcl_IncrRefCount(statePtr->objResult);
     return (Tcl_InterpState) statePtr;
@@ -135,7 +127,6 @@ Tcl_RestoreInterpState(
 
     iPtr->returnLevel = statePtr->returnLevel;
     iPtr->returnCode = statePtr->returnCode;
-    iPtr->resetErrorStack = statePtr->resetErrorStack;
     if (iPtr->errorInfo) {
 	Tcl_DecrRefCount(iPtr->errorInfo);
     }
@@ -150,13 +141,6 @@ Tcl_RestoreInterpState(
     if (iPtr->errorCode) {
 	Tcl_IncrRefCount(iPtr->errorCode);
     }
-    if (iPtr->errorStack) {
-	Tcl_DecrRefCount(iPtr->errorStack);
-    }
-    iPtr->errorStack = statePtr->errorStack;
-    if (iPtr->errorStack) {
-	Tcl_IncrRefCount(iPtr->errorStack);
-    }
     if (iPtr->returnOpts) {
 	Tcl_DecrRefCount(iPtr->returnOpts);
     }
@@ -201,9 +185,6 @@ Tcl_DiscardInterpState(
     if (statePtr->returnOpts) {
 	Tcl_DecrRefCount(statePtr->returnOpts);
     }
-    if (statePtr->errorStack) {
-	Tcl_DecrRefCount(statePtr->errorStack);
-    }
     Tcl_DecrRefCount(statePtr->objResult);
     ckfree(statePtr);
 }
@@ -247,44 +228,6 @@ Tcl_SaveResult(
     statePtr->objResultPtr = iPtr->objResultPtr;
     iPtr->objResultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(iPtr->objResultPtr);
-
-    /*
-     * Save the string result.
-     */
-
-    statePtr->freeProc = iPtr->freeProc;
-    if (iPtr->result == iPtr->resultSpace) {
-	/*
-	 * Copy the static string data out of the interp buffer.
-	 */
-
-	statePtr->result = statePtr->resultSpace;
-	strcpy(statePtr->result, iPtr->result);
-	statePtr->appendResult = NULL;
-    } else if (iPtr->result == iPtr->appendResult) {
-	/*
-	 * Move the append buffer out of the interp.
-	 */
-
-	statePtr->appendResult = iPtr->appendResult;
-	statePtr->appendAvl = iPtr->appendAvl;
-	statePtr->appendUsed = iPtr->appendUsed;
-	statePtr->result = statePtr->appendResult;
-	iPtr->appendResult = NULL;
-	iPtr->appendAvl = 0;
-	iPtr->appendUsed = 0;
-    } else {
-	/*
-	 * Move the dynamic or static string out of the interpreter.
-	 */
-
-	statePtr->result = iPtr->result;
-	statePtr->appendResult = NULL;
-    }
-
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
-    iPtr->freeProc = 0;
 }
 
 /*
@@ -315,39 +258,6 @@ Tcl_RestoreResult(
 
     Tcl_ResetResult(interp);
 
-    /*
-     * Restore the string result.
-     */
-
-    iPtr->freeProc = statePtr->freeProc;
-    if (statePtr->result == statePtr->resultSpace) {
-	/*
-	 * Copy the static string data into the interp buffer.
-	 */
-
-	iPtr->result = iPtr->resultSpace;
-	strcpy(iPtr->result, statePtr->result);
-    } else if (statePtr->result == statePtr->appendResult) {
-	/*
-	 * Move the append buffer back into the interp.
-	 */
-
-	if (iPtr->appendResult != NULL) {
-	    ckfree(iPtr->appendResult);
-	}
-
-	iPtr->appendResult = statePtr->appendResult;
-	iPtr->appendAvl = statePtr->appendAvl;
-	iPtr->appendUsed = statePtr->appendUsed;
-	iPtr->result = iPtr->appendResult;
-    } else {
-	/*
-	 * Move the dynamic or static string back into the interpreter.
-	 */
-
-	iPtr->result = statePtr->result;
-    }
-
     /*
      * Restore the object result.
      */
@@ -380,14 +290,6 @@ Tcl_DiscardResult(
     Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
 {
     TclDecrRefCount(statePtr->objResultPtr);
-
-    if (statePtr->result == statePtr->appendResult) {
-	ckfree(statePtr->appendResult);
-    } else if (statePtr->freeProc == TCL_DYNAMIC) {
-        ckfree(statePtr->result);
-    } else if (statePtr->freeProc) {
-        statePtr->freeProc(statePtr->result);
-    }
 }
 
 /*
@@ -400,10 +302,6 @@ Tcl_DiscardResult(
  * Results:
  *	None.
  *
- * Side effects:
- *	interp->result is left pointing either to "result" or to a copy of it.
- *	Also, the object result is reset.
- *
  *----------------------------------------------------------------------
  */
 
@@ -417,49 +315,16 @@ Tcl_SetResult(
 				 * TCL_STATIC, TCL_VOLATILE, or the address of
 				 * a Tcl_FreeProc such as free. */
 {
-    Interp *iPtr = (Interp *) interp;
-    register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
-    char *oldResult = iPtr->result;
 
-    if (result == NULL) {
-	iPtr->resultSpace[0] = 0;
-	iPtr->result = iPtr->resultSpace;
-	iPtr->freeProc = 0;
-    } else if (freeProc == TCL_VOLATILE) {
-	int length = strlen(result);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
 
-	if (length > TCL_RESULT_SIZE) {
-	    iPtr->result = ckalloc(length + 1);
-	    iPtr->freeProc = TCL_DYNAMIC;
-	} else {
-	    iPtr->result = iPtr->resultSpace;
-	    iPtr->freeProc = 0;
-	}
-	memcpy(iPtr->result, result, (unsigned) length+1);
-    } else {
-	iPtr->result = (char *) result;
-	iPtr->freeProc = freeProc;
-    }
-
-    /*
-     * If the old result was dynamically-allocated, free it up. Do it here,
-     * rather than at the beginning, in case the new result value was part of
-     * the old result value.
-     */
-
-    if (oldFreeProc != 0) {
-	if (oldFreeProc == TCL_DYNAMIC) {
-	    ckfree(oldResult);
-	} else {
-	    oldFreeProc(oldResult);
+    if (freeProc) {
+	if (freeProc == TCL_DYNAMIC) {
+	    ckfree(result);
+	} else if ((freeProc != TCL_STATIC) && (freeProc != TCL_VOLATILE)) {
+	    freeProc(result);
 	}
     }
-
-    /*
-     * Reset the object result since we just set the string result.
-     */
-
-    ResetObjResult(iPtr);
 }
 
 /*
@@ -483,18 +348,7 @@ const char *
 Tcl_GetStringResult(
     register Tcl_Interp *interp)/* Interpreter whose result to return. */
 {
-    /*
-     * If the string result is empty, move the object result to the string
-     * result, then reset the object result.
-     */
-
-    Interp *iPtr = (Interp *) interp;
-
-    if (*(iPtr->result) == 0) {
-	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-		TCL_VOLATILE);
-    }
-    return iPtr->result;
+    return TclGetString(Tcl_GetObjResult(interp));
 }
 
 /*
@@ -535,21 +389,6 @@ Tcl_SetObjResult(
      */
 
     TclDecrRefCount(oldObjResult);
-
-    /*
-     * Reset the string result since we just set the result object.
-     */
-
-    if (iPtr->freeProc != NULL) {
-	if (iPtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(iPtr->result);
-	} else {
-	    iPtr->freeProc(iPtr->result);
-	}
-	iPtr->freeProc = 0;
-    }
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
 }
 
 /*
@@ -564,12 +403,6 @@ Tcl_SetObjResult(
  * Results:
  *	The interpreter's result as an object.
  *
- * Side effects:
- *	If the interpreter has a non-empty string result, the result object is
- *	either empty or stale because some function set interp->result
- *	directly. If so, the string result is moved to the result object then
- *	the string result is reset.
- *
  *----------------------------------------------------------------------
  */
 
@@ -578,32 +411,7 @@ Tcl_GetObjResult(
     Tcl_Interp *interp)		/* Interpreter whose result to return. */
 {
     register Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *objResultPtr;
-    int length;
 
-    /*
-     * If the string result is non-empty, move the string result to the object
-     * result, then reset the string result.
-     */
-
-    if (iPtr->result[0] != 0) {
-	ResetObjResult(iPtr);
-
-	objResultPtr = iPtr->objResultPtr;
-	length = strlen(iPtr->result);
-	TclInitStringRep(objResultPtr, iPtr->result, length);
-
-	if (iPtr->freeProc != NULL) {
-	    if (iPtr->freeProc == TCL_DYNAMIC) {
-		ckfree(iPtr->result);
-	    } else {
-		iPtr->freeProc(iPtr->result);
-	    }
-	    iPtr->freeProc = 0;
-	}
-	iPtr->result = iPtr->resultSpace;
-	iPtr->result[0] = 0;
-    }
     return iPtr->objResultPtr;
 }
 
@@ -691,202 +499,6 @@ Tcl_AppendResult(
     va_end(argList);
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AppendElement --
- *
- *	Convert a string to a valid Tcl list element and append it to the
- *	result (which is ostensibly a list).
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The result in the interpreter given by the first argument is extended
- *	with a list element converted from string. A separator space is added
- *	before the converted list element unless the current result is empty,
- *	contains the single character "{", or ends in " {".
- *
- *	If the string result is empty, the object result is moved to the
- *	string result, then the object result is reset.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_AppendElement(
-    Tcl_Interp *interp,		/* Interpreter whose result is to be
-				 * extended. */
-    const char *element)	/* String to convert to list element and add
-				 * to result. */
-{
-    Interp *iPtr = (Interp *) interp;
-    char *dst;
-    int size;
-    int flags;
-
-    /*
-     * If the string result is empty, move the object result to the string
-     * result, then reset the object result.
-     */
-
-    (void) Tcl_GetStringResult(interp);
-
-    /*
-     * See how much space is needed, and grow the append buffer if needed to
-     * accommodate the list element.
-     */
-
-    size = Tcl_ScanElement(element, &flags) + 1;
-    if ((iPtr->result != iPtr->appendResult)
-	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
-	    || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
-	SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
-    }
-
-    /*
-     * Convert the string into a list element and copy it to the buffer that's
-     * forming, with a space separator if needed.
-     */
-
-    dst = iPtr->appendResult + iPtr->appendUsed;
-    if (TclNeedSpace(iPtr->appendResult, dst)) {
-	iPtr->appendUsed++;
-	*dst = ' ';
-	dst++;
-
-	/*
-	 * If we need a space to separate this element from preceding stuff,
-	 * then this element will not lead a list, and need not have it's
-	 * leading '#' quoted.
-	 */
-
-	flags |= TCL_DONT_QUOTE_HASH;
-    }
-    iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetupAppendBuffer --
- *
- *	This function makes sure that there is an append buffer properly
- *	initialized, if necessary, from the interpreter's result, and that it
- *	has at least enough room to accommodate newSpace new bytes of
- *	information.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SetupAppendBuffer(
-    Interp *iPtr,		/* Interpreter whose result is being set up. */
-    int newSpace)		/* Make sure that at least this many bytes of
-				 * new information may be added. */
-{
-    int totalSpace;
-
-    /*
-     * Make the append buffer larger, if that's necessary, then copy the
-     * result into the append buffer and make the append buffer the official
-     * Tcl result.
-     */
-
-    if (iPtr->result != iPtr->appendResult) {
-	/*
-	 * If an oversized buffer was used recently, then free it up so we go
-	 * back to a smaller buffer. This avoids tying up memory forever after
-	 * a large operation.
-	 */
-
-	if (iPtr->appendAvl > 500) {
-	    ckfree(iPtr->appendResult);
-	    iPtr->appendResult = NULL;
-	    iPtr->appendAvl = 0;
-	}
-	iPtr->appendUsed = strlen(iPtr->result);
-    } else if (iPtr->result[iPtr->appendUsed] != 0) {
-	/*
-	 * Most likely someone has modified a result created by
-	 * Tcl_AppendResult et al. so that it has a different size. Just
-	 * recompute the size.
-	 */
-
-	iPtr->appendUsed = strlen(iPtr->result);
-    }
-
-    totalSpace = newSpace + iPtr->appendUsed;
-    if (totalSpace >= iPtr->appendAvl) {
-	char *new;
-
-	if (totalSpace < 100) {
-	    totalSpace = 200;
-	} else {
-	    totalSpace *= 2;
-	}
-	new = ckalloc(totalSpace);
-	strcpy(new, iPtr->result);
-	if (iPtr->appendResult != NULL) {
-	    ckfree(iPtr->appendResult);
-	}
-	iPtr->appendResult = new;
-	iPtr->appendAvl = totalSpace;
-    } else if (iPtr->result != iPtr->appendResult) {
-	strcpy(iPtr->appendResult, iPtr->result);
-    }
-
-    Tcl_FreeResult((Tcl_Interp *) iPtr);
-    iPtr->result = iPtr->appendResult;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FreeResult --
- *
- *	This function frees up the memory associated with an interpreter's
- *	string result. It also resets the interpreter's result object.
- *	Tcl_FreeResult is most commonly used when a function is about to
- *	replace one result value with another.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Frees the memory associated with interp's string result and sets
- *	interp->freeProc to zero, but does not change interp->result or clear
- *	error state. Resets interp's result object to an unshared empty
- *	object.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_FreeResult(
-    register Tcl_Interp *interp)/* Interpreter for which to free result. */
-{
-    register Interp *iPtr = (Interp *) interp;
-
-    if (iPtr->freeProc != NULL) {
-	if (iPtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(iPtr->result);
-	} else {
-	    iPtr->freeProc(iPtr->result);
-	}
-	iPtr->freeProc = 0;
-    }
-
-    ResetObjResult(iPtr);
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -913,16 +525,6 @@ Tcl_ResetResult(
     register Interp *iPtr = (Interp *) interp;
 
     ResetObjResult(iPtr);
-    if (iPtr->freeProc != NULL) {
-	if (iPtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(iPtr->result);
-	} else {
-	    iPtr->freeProc(iPtr->result);
-	}
-	iPtr->freeProc = 0;
-    }
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
     if (iPtr->errorCode) {
 	/* Legacy support */
 	if (iPtr->flags & ERR_LEGACY_COPY) {
@@ -941,7 +543,6 @@ Tcl_ResetResult(
 	Tcl_DecrRefCount(iPtr->errorInfo);
 	iPtr->errorInfo = NULL;
     }
-    iPtr->resetErrorStack = 1;
     iPtr->returnLevel = 1;
     iPtr->returnCode = TCL_OK;
     if (iPtr->returnOpts) {
@@ -1178,7 +779,6 @@ GetKeys(void)
 	TclNewLiteralStringObj(keys[KEY_ERRORCODE], "-errorcode");
 	TclNewLiteralStringObj(keys[KEY_ERRORINFO], "-errorinfo");
 	TclNewLiteralStringObj(keys[KEY_ERRORLINE], "-errorline");
-	TclNewLiteralStringObj(keys[KEY_ERRORSTACK],"-errorstack");
 	TclNewLiteralStringObj(keys[KEY_LEVEL],	    "-level");
 	TclNewLiteralStringObj(keys[KEY_OPTIONS],   "-options");
 
@@ -1285,40 +885,6 @@ TclProcessReturn(
 		iPtr->flags |= ERR_ALREADY_LOGGED;
 	    }
 	}
-	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
-                &valuePtr);
-	if (valuePtr != NULL) {
-            int len, valueObjc;
-            Tcl_Obj **valueObjv;
-
-            if (Tcl_IsShared(iPtr->errorStack)) {
-                Tcl_Obj *newObj;
-
-                newObj = Tcl_DuplicateObj(iPtr->errorStack);
-                Tcl_DecrRefCount(iPtr->errorStack);
-                Tcl_IncrRefCount(newObj);
-                iPtr->errorStack = newObj;
-            }
-
-            /*
-             * List extraction done after duplication to avoid moving the rug
-             * if someone does [return -errorstack [info errorstack]]
-             */
-
-            if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc,
-                    &valueObjv) == TCL_ERROR) {
-                return TCL_ERROR;
-            }
-            iPtr->resetErrorStack = 0;
-            Tcl_ListObjLength(interp, iPtr->errorStack, &len);
-
-            /*
-             * Reset while keeping the list intrep as much as possible.
-             */
-
-            Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
-                    valueObjv);
- 	}
 	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE],
                 &valuePtr);
 	if (valuePtr != NULL) {
@@ -1482,40 +1048,6 @@ TclMergeReturnOptions(
 	}
     }
 
-    /*
-     * Check for bogus -errorstack value.
-     */
-
-    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
-    if (valuePtr != NULL) {
-	int length;
-
-	if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
-	    /*
-	     * Value is not a list, which is illegal for -errorstack.
-	     */
-
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "bad -errorstack value: expected a list but got \"%s\"",
-                    TclGetString(valuePtr)));
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
-                    NULL);
-	    goto error;
-	}
-        if (length % 2) {
-            /*
-             * Errorstack must always be an even-sized list
-             */
-
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "forbidden odd-sized list for -errorstack: \"%s\"",
-		    TclGetString(valuePtr)));
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT",
-                    "ODDSIZEDLIST_ERRORSTACK", NULL);
-	    goto error;
-        }
-    }
-
     /*
      * Convert [return -code return -level X] to [return -code ok -level X+1]
      */
@@ -1593,7 +1125,6 @@ Tcl_GetReturnOptions(
 
     if (result == TCL_ERROR) {
 	Tcl_AddErrorInfo(interp, "");
-        Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
     }
     if (iPtr->errorCode) {
 	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
@@ -1606,31 +1137,6 @@ Tcl_GetReturnOptions(
     return options;
 }
 
-/*
- *-------------------------------------------------------------------------
- *
- * TclNoErrorStack --
- *
- *	Removes the -errorstack entry from an options dict to avoid reference
- *	cycles.
- *
- * Results:
- *	The (unshared) argument options dict, modified in -place.
- *
- *-------------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclNoErrorStack(
-    Tcl_Interp *interp,
-    Tcl_Obj *options)
-{
-    Tcl_Obj **keys = GetKeys();
-
-    Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]);
-    return options;
-}
-
 /*
  *-------------------------------------------------------------------------
  *

generic/tclStringObj.c

@@ -3097,7 +3097,7 @@ ExtendStringRepWithUnicode(
      */
 
     int i, origLength, size = 0;
-    char *dst, buf[TCL_UTF_MAX];
+    char *dst;
     String *stringPtr = GET_STRING(objPtr);
 
     if (numChars < 0) {
@@ -3123,7 +3123,7 @@ ExtendStringRepWithUnicode(
     }
 
     for (i = 0; i < numChars && size >= 0; i++) {
-	size += Tcl_UniCharToUtf((int) unicode[i], buf);
+	size += TclUtfCount(unicode[i]);
     }
     if (size < 0) {
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);

generic/tclStubInit.c

@@ -540,8 +540,8 @@ static const TclIntStubs tclIntStubs = {
     TclPtrMakeUpvar, /* 229 */
     TclObjLookupVar, /* 230 */
     TclGetNamespaceFromObj, /* 231 */
-    TclEvalObjEx, /* 232 */
-    TclGetSrcInfoForPc, /* 233 */
+    0, /* 232 */
+    0, /* 233 */
     TclVarHashCreateVar, /* 234 */
     TclInitVarHashTable, /* 235 */
     TclBackgroundException, /* 236 */
@@ -845,7 +845,7 @@ const TclStubs tclStubs = {
     Tcl_AddErrorInfo, /* 66 */
     Tcl_AddObjErrorInfo, /* 67 */
     Tcl_AllowExceptions, /* 68 */
-    Tcl_AppendElement, /* 69 */
+    0, /* 69 */
     Tcl_AppendResult, /* 70 */
     Tcl_AsyncCreate, /* 71 */
     Tcl_AsyncDelete, /* 72 */
@@ -923,7 +923,7 @@ const TclStubs tclStubs = {
     Tcl_FindExecutable, /* 144 */
     Tcl_FirstHashEntry, /* 145 */
     Tcl_Flush, /* 146 */
-    Tcl_FreeResult, /* 147 */
+    0, /* 147 */
     Tcl_GetAlias, /* 148 */
     Tcl_GetAliasObj, /* 149 */
     Tcl_GetAssocData, /* 150 */
@@ -1309,14 +1309,14 @@ const TclStubs tclStubs = {
     Tcl_LimitReady, /* 522 */
     Tcl_LimitCheck, /* 523 */
     Tcl_LimitExceeded, /* 524 */
-    Tcl_LimitSetCommands, /* 525 */
+    0, /* 525 */
     Tcl_LimitSetTime, /* 526 */
     Tcl_LimitSetGranularity, /* 527 */
     Tcl_LimitTypeEnabled, /* 528 */
     Tcl_LimitTypeExceeded, /* 529 */
     Tcl_LimitTypeSet, /* 530 */
     Tcl_LimitTypeReset, /* 531 */
-    Tcl_LimitGetCommands, /* 532 */
+    0, /* 532 */
     Tcl_LimitGetTime, /* 533 */
     Tcl_LimitGetGranularity, /* 534 */
     Tcl_SaveInterpState, /* 535 */

generic/tclStubLib.c

@@ -68,8 +68,8 @@ Tcl_InitStubs(
      */
 
     if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
-	iPtr->result = "interpreter uses an incompatible stubs mechanism";
-	iPtr->freeProc = TCL_STATIC;
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("interpreter uses an incompatible stubs mechanism", -1));
 	return NULL;
     }
 

generic/tclTest.c

@@ -115,13 +115,6 @@ typedef struct TclEncoding {
     char *fromUtfCmd;
 } TclEncoding;
 
-/*
- * The counter below is used to determine if the TestsaveresultFree routine
- * was called for a result.
- */
-
-static int freeCount;
-
 /*
  * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands.
  */
@@ -298,12 +291,6 @@ static int		TestlinkCmd(ClientData dummy,
 static int		TestlocaleCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-static int		TestMathFunc(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr);
-static int		TestMathFunc2(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr);
 static int		TestmainthreadCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestsetmainloopCmd(ClientData dummy,
@@ -331,12 +318,6 @@ static int		TestreturnObjCmd(ClientData dummy,
 			    Tcl_Obj *const objv[]);
 static void		TestregexpXflags(const char *string,
 			    int length, int *cflagsPtr, int *eflagsPtr);
-#ifndef TCL_NO_DEPRECATED
-static int		TestsaveresultCmd(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static void		TestsaveresultFree(char *blockPtr);
-#endif /* TCL_NO_DEPRECATED */
 static int		TestsetassocdataCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestsetCmd(ClientData dummy,
@@ -413,6 +394,7 @@ static int		TestHashSystemHashCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 
+static TCL_NOINLINE void *NRE_depth(void);
 static int              NREUnwind_callback(ClientData data[], Tcl_Interp *interp,
                             int result);
 static int		TestNREUnwind(ClientData clientData,
@@ -511,7 +493,22 @@ static const Tcl_Filesystem simpleFilesystem = {
     NULL
 };
 
+static void
+Tcl_AppendElement (
+    Tcl_Interp *interp,
+    const char *element)
+{
+    Tcl_Obj *resPtr = Tcl_GetObjResult(interp);
+
+    if (Tcl_IsShared(resPtr)) {
+        resPtr = Tcl_DuplicateObj(resPtr);
+    }
+    
+    (void) Tcl_ListObjAppendElement(interp, resPtr, Tcl_NewStringObj(element, -1));
+    Tcl_SetObjResult(interp, resPtr); 
+}
 
+
 /*
  *----------------------------------------------------------------------
  *
@@ -535,10 +532,6 @@ int
 Tcltest_Init(
     Tcl_Interp *interp)		/* Interpreter for application. */
 {
-#ifndef TCL_NO_DEPRECATED
-    Tcl_ValueType t3ArgTypes[2];
-#endif /* TCL_NO_DEPRECATED */
-
     Tcl_Obj *listPtr;
     Tcl_Obj **objv;
     int objc, index;
@@ -657,10 +650,6 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
 	    NULL, NULL);
-#ifndef TCL_NO_DEPRECATED
-    Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
-	    NULL, NULL);
-#endif /* TCL_NO_DEPRECATED */
     Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
@@ -682,10 +671,6 @@ Tcltest_Init(
     Tcl_CreateCommand(interp, "testtranslatefilename",
 	    TesttranslatefilenameCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
-#ifndef TCL_NO_DEPRECATED
-    Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
-    Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
-#endif /* TCL_NO_DEPRECATED */
     Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
 	    NULL);
     Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
@@ -696,13 +681,6 @@ Tcltest_Init(
     Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
 	    (ClientData) 0, NULL);
 #endif
-#ifndef TCL_NO_DEPRECATED
-    t3ArgTypes[0] = TCL_EITHER;
-    t3ArgTypes[1] = TCL_EITHER;
-    Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
-	    NULL);
-#endif /* TCL_NO_DEPRECATED */
-
     Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
@@ -3322,144 +3300,6 @@ TestlocaleCmd(
     return TCL_OK;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * TestMathFunc --
- *
- *	This is a user-defined math procedure to test out math procedures
- *	with no arguments.
- *
- * Results:
- *	A normal Tcl completion code.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static int
-TestMathFunc(
-    ClientData clientData,	/* Integer value to return. */
-    Tcl_Interp *interp,		/* Not used. */
-    Tcl_Value *args,		/* Not used. */
-    Tcl_Value *resultPtr)	/* Where to store result. */
-{
-    resultPtr->type = TCL_INT;
-    resultPtr->intValue = PTR2INT(clientData);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestMathFunc2 --
- *
- *	This is a user-defined math procedure to test out math procedures
- *	that do have arguments, in this case 2.
- *
- * Results:
- *	A normal Tcl completion code.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static int
-TestMathFunc2(
-    ClientData clientData,	/* Integer value to return. */
-    Tcl_Interp *interp,		/* Used to report errors. */
-    Tcl_Value *args,		/* Points to an array of two Tcl_Value structs
-				 * for the two arguments. */
-    Tcl_Value *resultPtr)	/* Where to store the result. */
-{
-    int result = TCL_OK;
-
-    /*
-     * Return the maximum of the two arguments with the correct type.
-     */
-
-    if (args[0].type == TCL_INT) {
-	int i0 = args[0].intValue;
-
-	if (args[1].type == TCL_INT) {
-	    int i1 = args[1].intValue;
-
-	    resultPtr->type = TCL_INT;
-	    resultPtr->intValue = ((i0 > i1)? i0 : i1);
-	} else if (args[1].type == TCL_DOUBLE) {
-	    double d0 = i0;
-	    double d1 = args[1].doubleValue;
-
-	    resultPtr->type = TCL_DOUBLE;
-	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
-	} else if (args[1].type == TCL_WIDE_INT) {
-	    Tcl_WideInt w0 = Tcl_LongAsWide(i0);
-	    Tcl_WideInt w1 = args[1].wideValue;
-
-	    resultPtr->type = TCL_WIDE_INT;
-	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
-	} else {
-	    Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
-	    result = TCL_ERROR;
-	}
-    } else if (args[0].type == TCL_DOUBLE) {
-	double d0 = args[0].doubleValue;
-
-	if (args[1].type == TCL_INT) {
-	    double d1 = args[1].intValue;
-
-	    resultPtr->type = TCL_DOUBLE;
-	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
-	} else if (args[1].type == TCL_DOUBLE) {
-	    double d1 = args[1].doubleValue;
-
-	    resultPtr->type = TCL_DOUBLE;
-	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
-	} else if (args[1].type == TCL_WIDE_INT) {
-	    double d1 = Tcl_WideAsDouble(args[1].wideValue);
-
-	    resultPtr->type = TCL_DOUBLE;
-	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
-	} else {
-	    Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
-	    result = TCL_ERROR;
-	}
-    } else if (args[0].type == TCL_WIDE_INT) {
-	Tcl_WideInt w0 = args[0].wideValue;
-
-	if (args[1].type == TCL_INT) {
-	    Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);
-
-	    resultPtr->type = TCL_WIDE_INT;
-	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
-	} else if (args[1].type == TCL_DOUBLE) {
-	    double d0 = Tcl_WideAsDouble(w0);
-	    double d1 = args[1].doubleValue;
-
-	    resultPtr->type = TCL_DOUBLE;
-	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
-	} else if (args[1].type == TCL_WIDE_INT) {
-	    Tcl_WideInt w1 = args[1].wideValue;
-
-	    resultPtr->type = TCL_WIDE_INT;
-	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
-	} else {
-	    Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
-	    result = TCL_ERROR;
-	}
-    } else {
-	Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC);
-	result = TCL_ERROR;
-    }
-    return result;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -5076,141 +4916,6 @@ Testset2Cmd(
     }
 }
 
-#ifndef TCL_NO_DEPRECATED
-/*
- *----------------------------------------------------------------------
- *
- * TestsaveresultCmd --
- *
- *	Implements the "testsaveresult" cmd that is used when testing the
- *	Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static int
-TestsaveresultCmd(
-    ClientData dummy,		/* Not used. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
-{
-    Interp* iPtr = (Interp*) interp;
-    int discard, result, index;
-    Tcl_SavedResult state;
-    Tcl_Obj *objPtr;
-    static const char *const optionStrings[] = {
-	"append", "dynamic", "free", "object", "small", NULL
-    };
-    enum options {
-	RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL
-    };
-
-    /*
-     * Parse arguments
-     */
-
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
-	    &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    objPtr = NULL;		/* Lint. */
-    switch ((enum options) index) {
-    case RESULT_SMALL:
-	Tcl_SetResult(interp, "small result", TCL_VOLATILE);
-	break;
-    case RESULT_APPEND:
-	Tcl_AppendResult(interp, "append result", NULL);
-	break;
-    case RESULT_FREE: {
-	char *buf = ckalloc(200);
-
-	strcpy(buf, "free result");
-	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
-	break;
-    }
-    case RESULT_DYNAMIC:
-	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
-	break;
-    case RESULT_OBJECT:
-	objPtr = Tcl_NewStringObj("object result", -1);
-	Tcl_SetObjResult(interp, objPtr);
-	break;
-    }
-
-    freeCount = 0;
-    Tcl_SaveResult(interp, &state);
-
-    if (((enum options) index) == RESULT_OBJECT) {
-	result = Tcl_EvalObjEx(interp, objv[2], 0);
-    } else {
-	result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
-    }
-
-    if (discard) {
-	Tcl_DiscardResult(&state);
-    } else {
-	Tcl_RestoreResult(interp, &state);
-	result = TCL_OK;
-    }
-
-    switch ((enum options) index) {
-    case RESULT_DYNAMIC: {
-	int present = iPtr->freeProc == TestsaveresultFree;
-	int called = freeCount;
-
-	Tcl_AppendElement(interp, called ? "called" : "notCalled");
-	Tcl_AppendElement(interp, present ? "present" : "missing");
-	break;
-    }
-    case RESULT_OBJECT:
-	Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
-		? "same" : "different");
-	break;
-    default:
-	break;
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestsaveresultFree --
- *
- *	Special purpose freeProc used by TestsaveresultCmd.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Increments the freeCount.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TestsaveresultFree(
-    char *blockPtr)
-{
-    freeCount++;
-}
-#endif /* TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
@@ -6853,31 +6558,38 @@ TestgetintCmd(
     }
 }
 
+
+static TCL_NOINLINE void *
+NRE_depth(
+    void)
+{
+    int none;
+    return &none;
+}
+
 static int
 NREUnwind_callback(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
 {
-    int none;
-
     if (data[0] == INT2PTR(-1)) {
-        Tcl_NRAddCallback(interp, NREUnwind_callback, &none, INT2PTR(-1),
-                INT2PTR(-1), NULL);
+        TclNRAddCallback(interp, NREUnwind_callback, NRE_depth(), INT2PTR(-1),
+                INT2PTR(-1));
     } else if (data[1] == INT2PTR(-1)) {
-        Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], &none,
-                INT2PTR(-1), NULL);
+        TclNRAddCallback(interp, NREUnwind_callback, data[0], NRE_depth(),
+                INT2PTR(-1));
     } else if (data[2] == INT2PTR(-1)) {
         Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1],
-                &none, NULL);
+                NRE_depth());
     } else {
         Tcl_Obj *idata[3];
-        idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0]));
-        idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0]));
-        idata[2] = Tcl_NewIntObj((int) ((char *) &none   - (char *) data[0]));
+        idata[0] = Tcl_NewIntObj((int) (data[1] - data[0]));
+        idata[1] = Tcl_NewIntObj((int) (data[2] - data[0]));
+        idata[2] = Tcl_NewIntObj((int) ((void *) NRE_depth()   - data[0]));
         Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
     }
-    return TCL_OK;
+    NRE_NEXT(TCL_OK);
 }
 
 static int
@@ -6893,7 +6605,7 @@ TestNREUnwind(
      */
     
     Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1),
-            INT2PTR(-1), NULL);
+            INT2PTR(-1));
     return TCL_OK;
 }
 
@@ -6908,7 +6620,7 @@ TestNRELevels(
     Interp *iPtr = (Interp *) interp;
     static ptrdiff_t *refDepth = NULL;
     ptrdiff_t depth;
-    Tcl_Obj *levels[6];
+    Tcl_Obj *levels[5];
     int i = 0;
     NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
 
@@ -6920,18 +6632,17 @@ TestNRELevels(
 
     levels[0] = Tcl_NewIntObj(depth);
     levels[1] = Tcl_NewIntObj(iPtr->numLevels);
-    levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level);
-    levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level);
-    levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
+    levels[2] = Tcl_NewIntObj(iPtr->varFramePtr->level);
+    levels[3] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
 	    - iPtr->execEnvPtr->execStackPtr->stackWords);
 
     while (cbPtr) {
 	i++;
-	cbPtr = cbPtr->nextPtr;
+	cbPtr = NEXT_CB(cbPtr);
     }
-    levels[5] = Tcl_NewIntObj(i);
+    levels[4] = Tcl_NewIntObj(i);
 
-    Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
+    Tcl_SetObjResult(interp, Tcl_NewListObj(5, levels));
     return TCL_OK;
 }
 

generic/tclThreadAlloc.c

@@ -538,12 +538,12 @@ TclpRealloc(
  *
  * Note:
  *	If this code is updated, the changes need to be reflected in the macro
- *	TclAllocObjStorageEx() defined in tclInt.h
+ *	TclAllocObjStorage() defined in tclInt.h
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
+TCL_NOINLINE Tcl_Obj *
 TclThreadAllocObj(void)
 {
     register Cache *cachePtr;
@@ -611,12 +611,12 @@ TclThreadAllocObj(void)
  *
  * Note:
  *	If this code is updated, the changes need to be reflected in the macro
- *	TclAllocObjStorageEx() defined in tclInt.h
+ *	TclAllocObjStorage() defined in tclInt.h
  *
  *----------------------------------------------------------------------
  */
 
-void
+TCL_NOINLINE void
 TclThreadFreeObj(
     Tcl_Obj *objPtr)
 {

generic/tclUtf.c

@@ -89,12 +89,11 @@ static const unsigned char totalBytes[256] = {
  * Functions used only in this module.
  */
 
-static int		UtfCount(int ch);
 
 /*
  *---------------------------------------------------------------------------
  *
- * UtfCount --
+ * TclUtfCount --
  *
  *	Find the number of bytes in the Utf character "ch".
  *
@@ -107,9 +106,9 @@ static int		UtfCount(int ch);
  *---------------------------------------------------------------------------
  */
 
-INLINE static int
-UtfCount(
-    int ch)			/* The Tcl_UniChar whose size is returned. */
+INLINE int
+TclUtfCount(
+    Tcl_UniChar ch)		/* The Tcl_UniChar whose size is returned. */
 {
     if ((ch > 0) && (ch < UNICODE_SELF)) {
 	return 1;
@@ -829,7 +828,7 @@ Tcl_UtfToUpper(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < UtfCount(upChar)) {
+	if (bytes < TclUtfCount(upChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -882,7 +881,7 @@ Tcl_UtfToLower(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < UtfCount(lowChar)) {
+	if (bytes < TclUtfCount(lowChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -932,7 +931,7 @@ Tcl_UtfToTitle(
 	bytes = TclUtfToUniChar(src, &ch);
 	titleChar = Tcl_UniCharToTitle(ch);
 
-	if (bytes < UtfCount(titleChar)) {
+	if (bytes < TclUtfCount(titleChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -944,7 +943,7 @@ Tcl_UtfToTitle(
 	bytes = TclUtfToUniChar(src, &ch);
 	lowChar = Tcl_UniCharToLower(ch);
 
-	if (bytes < UtfCount(lowChar)) {
+	if (bytes < TclUtfCount(lowChar)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {

generic/tclUtil.c

@@ -2884,13 +2884,6 @@ Tcl_DStringResult(
  * Results:
  *	None.
  *
- * Side effects:
- *	The interpreter's string result is cleared, and the previous contents
- *	of dsPtr are freed.
- *
- *	If the string result is empty, the object result is moved to the
- *	string result, then the object result is reset.
- *
  *----------------------------------------------------------------------
  */
 
@@ -2908,7 +2901,7 @@ Tcl_DStringGetResult(
 
     /*
      * Do more efficient transfer when we know the result is a Tcl_Obj. When
-     * there's no st`ring result, we only have to deal with two cases:
+     * there's no string result, we only have to deal with two cases:
      *
      *  1. When the string rep is the empty string, when we don't copy but
      *     instead use the staticSpace in the DString to hold an empty string.
@@ -2921,56 +2914,28 @@ Tcl_DStringGetResult(
      *     string.
      */
 
-    if (!iPtr->result[0] && iPtr->objResultPtr
-	    && !Tcl_IsShared(iPtr->objResultPtr)) {
-	if (iPtr->objResultPtr->bytes == tclEmptyStringRep) {
-	    dsPtr->string = dsPtr->staticSpace;
-	    dsPtr->string[0] = 0;
-	    dsPtr->length = 0;
-	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
-	} else {
-	    dsPtr->string = Tcl_GetString(iPtr->objResultPtr);
-	    dsPtr->length = iPtr->objResultPtr->length;
-	    dsPtr->spaceAvl = dsPtr->length + 1;
-	    TclFreeIntRep(iPtr->objResultPtr);
-	    iPtr->objResultPtr->bytes = tclEmptyStringRep;
-	    iPtr->objResultPtr->length = 0;
-	}
-	return;
-    }
-
-    /*
-     * If the string result is empty, move the object result to the string
-     * result, then reset the object result.
-     */
-
-    (void) Tcl_GetStringResult(interp);
-
-    dsPtr->length = strlen(iPtr->result);
-    if (iPtr->freeProc != NULL) {
-	if (iPtr->freeProc == TCL_DYNAMIC) {
-	    dsPtr->string = iPtr->result;
-	    dsPtr->spaceAvl = dsPtr->length+1;
-	} else {
-	    dsPtr->string = ckalloc(dsPtr->length+1);
-	    memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
-	    iPtr->freeProc(iPtr->result);
-	}
-	dsPtr->spaceAvl = dsPtr->length+1;
-	iPtr->freeProc = NULL;
+    if (iPtr->objResultPtr->bytes == tclEmptyStringRep) {
+	dsPtr->string = dsPtr->staticSpace;
+	dsPtr->string[0] = 0;
+	dsPtr->length = 0;
+	dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
     } else {
-	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
-	    dsPtr->string = dsPtr->staticSpace;
-	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
-	} else {
-	    dsPtr->string = ckalloc(dsPtr->length+1);
-	    dsPtr->spaceAvl = dsPtr->length + 1;
+	int new = 0;
+	Tcl_Obj *resPtr = iPtr->objResultPtr;
+	if (Tcl_IsShared(resPtr)) {
+	    resPtr = Tcl_DuplicateObj(resPtr);
+	    new = 1;
+	}
+	dsPtr->string = Tcl_GetString(resPtr);
+	dsPtr->length = resPtr->length;
+	dsPtr->spaceAvl = dsPtr->length + 1;
+	TclFreeIntRep(resPtr);
+	resPtr->bytes = tclEmptyStringRep;
+	resPtr->length = 0;
+	if (new) {
+	    Tcl_DecrRefCount(resPtr);
 	}
-	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
     }
-
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
 }
 
 /*

generic/tclVar.c

@@ -1839,9 +1839,6 @@ TclPtrSetVar(
 	    } else {
 		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
 		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-
-		    TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
-
 		    TclDecrRefCount(oldValuePtr);
 		    oldValuePtr = varPtr->value.objPtr;
 		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */

library/clock.tcl

@@ -647,7 +647,7 @@ proc ::tcl::clock::Initialize {} {
 					# that renders the given format
 }
 ::tcl::clock::Initialize
-
+
 #----------------------------------------------------------------------
 #
 # clock format --
@@ -696,7 +696,7 @@ proc ::tcl::clock::format { args } {
     return [$procName $clockval $timezone]
 
 }
-
+
 #----------------------------------------------------------------------
 #
 # ParseClockFormatFormat --
@@ -735,7 +735,7 @@ proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
 proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
     set didLocaleEra 0
     set didLocaleNumerals 0
-    set preFormatCode \
+    set prefixCode \
 	[string map [list @GREGORIAN_CHANGE_DATE@ \
 				       [mc GREGORIAN_CHANGE_DATE]] \
 	     {
@@ -744,9 +744,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 			       $TZData($timezone) \
 			       @GREGORIAN_CHANGE_DATE@]
 	     }]
+    set preFormatCode {}
     set formatString {}
     set substituents {}
     set state {}
+    set fields {}
 
     set format [LocalizeFormat $locale $format]
 
@@ -772,8 +774,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 				 [list @DAYS_OF_WEEK_ABBREV@ \
 				      [list [mc DAYS_OF_WEEK_ABBREV]]] \
 				 { [lindex @DAYS_OF_WEEK_ABBREV@ \
-					[expr {[dict get $date dayOfWeek] \
-						   % 7}]]}]
+					[expr {$dayOfWeek % 7}]]}]
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
+			}
 		    }
 		    A {			# Day of week, spelt out.
 			append formatString %s
@@ -782,8 +786,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 				 [list @DAYS_OF_WEEK_FULL@ \
 				      [list [mc DAYS_OF_WEEK_FULL]]] \
 				 { [lindex @DAYS_OF_WEEK_FULL@ \
-					[expr {[dict get $date dayOfWeek] \
-						   % 7}]]}]
+					[expr {$dayOfWeek % 7}]]}]
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
+			}
 		    }
 		    b - h {		# Name of month, abbreviated.
 			append formatString %s
@@ -792,7 +798,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 				 [list @MONTHS_ABBREV@ \
 				      [list [mc MONTHS_ABBREV]]] \
 				 { [lindex @MONTHS_ABBREV@ \
-					[expr {[dict get $date month]-1}]]}]
+					[expr {$month-1}]]}]
+			dict set fields month {
+			    set month [dict get $date month]
+			}
 		    }
 		    B {			# Name of month, spelt out
 			append formatString %s
@@ -801,20 +810,31 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 				 [list @MONTHS_FULL@ \
 				      [list [mc MONTHS_FULL]]] \
 				 { [lindex @MONTHS_FULL@ \
-					[expr {[dict get $date month]-1}]]}]
+					[expr {$month-1}]]}]
+			dict set fields month {
+			    set month [dict get $date month]
+			}
 		    }
 		    C {			# Century number
 			append formatString %02d
-			append substituents \
-			    { [expr {[dict get $date year] / 100}]}
+			append substituents { [expr {$year / 100}]}
+			dict set fields year {
+			    set year [dict get $date year]
+			}
 		    }
 		    d {			# Day of month, with leading zero
 			append formatString %02d
-			append substituents { [dict get $date dayOfMonth]}
+			append substituents { $dayOfMonth}
+			dict set fields dayOfMonth {
+			    set dayOfMonth [dict get $date dayOfMonth]
+			}
 		    }
 		    e {			# Day of month, without leading zero
 			append formatString %2d
-			append substituents { [dict get $date dayOfMonth]}
+			append substituents { $dayOfMonth}
+			dict set fields dayOfMonth {
+			    set dayOfMonth [dict get $date dayOfMonth]
+			}
 		    }
 		    E {			# Format group in a locale-dependent
 					# alternative era
@@ -840,33 +860,45 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 		    g {			# Two-digit year relative to ISO8601
 					# week number
 			append formatString %02d
-			append substituents \
-			    { [expr { [dict get $date iso8601Year] % 100 }]}
+			append substituents { [expr { $iso8601Year % 100 }]}
+			dict set fields iso8601Year {
+			    set iso8601Year [dict get $date iso8601Year]
+			}
 		    }
 		    G {			# Four-digit year relative to ISO8601
 					# week number
 			append formatString %02d
-			append substituents { [dict get $date iso8601Year]}
+			append substituents { $iso8601Year}
+			dict set fields iso8601Year {
+			    set iso8601Year [dict get $date iso8601Year]
+			}
 		    }
 		    H {			# Hour in the 24-hour day, leading zero
 			append formatString %02d
 			append substituents \
-			    { [expr { [dict get $date localSeconds] \
-					  / 3600 % 24}]}
+			    { [expr { $localSeconds / 3600 % 24}]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    I {			# Hour AM/PM, with leading zero
 			append formatString %02d
 			append substituents \
-			    { [expr { ( ( ( [dict get $date localSeconds] \
-					    % 86400 ) \
+			    { [expr { ( ( ($localSeconds % 86400) \
 					  + 86400 \
 					  - 3600 ) \
 					/ 3600 ) \
 				      % 12 + 1 }] }
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    j {			# Day of year (001-366)
 			append formatString %03d
-			append substituents { [dict get $date dayOfYear]}
+			append substituents { $dayOfYear}
+			dict set fields dayOfYear {
+			    set dayOfYear [dict get $date dayOfYear]
+			}
 		    }
 		    J {			# Julian Day Number
 			append formatString %07ld
@@ -875,37 +907,47 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 		    k {			# Hour (0-23), no leading zero
 			append formatString %2d
 			append substituents \
-			    { [expr { [dict get $date localSeconds]
-				      / 3600
-				      % 24 }]}
+			    { [expr { $localSeconds / 3600 % 24 }]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    l {			# Hour (12-11), no leading zero
 			append formatString %2d
 			append substituents \
-			    { [expr { ( ( ( [dict get $date localSeconds]
-					   % 86400 )
+			    { [expr { ( ( ( $localSeconds % 86400 )
 					 + 86400
 					 - 3600 )
 				       / 3600 )
 				     % 12 + 1 }]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    m {			# Month number, leading zero
 			append formatString %02d
-			append substituents { [dict get $date month]}
+			append substituents { $month}
+			dict set fields month {
+			    set month [dict get $date month]
+			}
 		    }
 		    M {			# Minute of the hour, leading zero
 			append formatString %02d
 			append substituents \
-			    { [expr { [dict get $date localSeconds]
-				      / 60
-				      % 60 }]}
+			    { [expr { $localSeconds / 60 % 60 }]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    n {			# A literal newline
 			append formatString \n
 		    }
 		    N {			# Month number, no leading zero
 			append formatString %2d
-			append substituents { [dict get $date month]}
+			append substituents { $month}
+			dict set fields month {
+			    set month [dict get $date month]
+			}
 		    }
 		    O {			# A format group in the locale's
 					# alternative numerals
@@ -924,9 +966,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 			    [list set AM [string toupper [mc AM]]] \n \
 			    [list set PM [string toupper [mc PM]]] \n
 			append substituents \
-			    { [expr {(([dict get $date localSeconds]
-				       % 86400) < 43200) ?
+			    { [expr {(($localSeconds % 86400) < 43200) ?
 				     $AM : $PM}]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    P {			# Localized 'AM' or 'PM' indicator
 			append formatString %s
@@ -934,10 +978,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 			    [list set am [mc AM]] \n \
 			    [list set pm [mc PM]] \n
 			append substituents \
-			    { [expr {(([dict get $date localSeconds]
-				       % 86400) < 43200) ?
+			    { [expr {(($localSeconds % 86400) < 43200) ?
 				     $am : $pm}]}
-
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    Q {			# Hi, Jeff!
 			append formatString %s
@@ -945,70 +990,95 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 		    }
 		    s {			# Seconds from the Posix Epoch
 			append formatString %s
-			append substituents { [dict get $date seconds]}
+			append substituents { $seconds}
+			dict set fields seconds {
+			    set seconds [dict get $date seconds]
+			}
 		    }
 		    S {			# Second of the minute, with
 			# leading zero
 			append formatString %02d
-			append substituents \
-			    { [expr { [dict get $date localSeconds]
-				      % 60 }]}
+			append substituents { [expr { $localSeconds % 60 }]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    t {			# A literal tab character
 			append formatString \t
 		    }
 		    u {			# Day of the week (1-Monday, 7-Sunday)
 			append formatString %1d
-			append substituents { [dict get $date dayOfWeek]}
+			append substituents { $dayOfWeek }
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
+			}
 		    }
 		    U {			# Week of the year (00-53). The
 					# first Sunday of the year is the
 					# first day of week 01
 			append formatString %02d
 			append preFormatCode {
-			    set dow [dict get $date dayOfWeek]
+			    set dow $dayOfWeek
 			    if { $dow == 7 } {
 				set dow 0
 			    }
 			    incr dow
 			    set UweekNumber \
-				[expr { ( [dict get $date dayOfYear]
-					  - $dow + 7 )
-					/ 7 }]
+				[expr { ( $dayOfYear - $dow + 7 ) / 7 }]
 			}
 			append substituents { $UweekNumber}
+			dict set fields dayOfYear {
+			    set dayOfYear [dict get $date dayOfYear]
+			}
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
+			}
 		    }
 		    V {			# The ISO8601 week number
 			append formatString %02d
-			append substituents { [dict get $date iso8601Week]}
+			append substituents { $iso8601Week}
+			dict set fields iso8601Week {
+			    set iso8601Week [dict get $date iso8601Week]
+			}
 		    }
 		    w {			# Day of the week (0-Sunday,
 					# 6-Saturday)
 			append formatString %1d
 			append substituents \
-			    { [expr { [dict get $date dayOfWeek] % 7 }]}
+			    { [expr { $dayOfWeek % 7 }]}
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
+			}
 		    }
 		    W {			# Week of the year (00-53). The first
 					# Monday of the year is the first day
 					# of week 01.
 			append preFormatCode {
 			    set WweekNumber \
-				[expr { ( [dict get $date dayOfYear]
-					  - [dict get $date dayOfWeek]
-					  + 7 )
-					/ 7 }]
+				[expr { ($dayOfYear - $dayOfWeek + 7) / 7 }]
 			}
 			append formatString %02d
 			append substituents { $WweekNumber}
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
+			}
+			dict set fields dayOfMonth {
+			    set dayOfMonth [dict get $date dayOfMonth]
+			}
 		    }
 		    y {			# The two-digit year of the century
 			append formatString %02d
-			append substituents \
-			    { [expr { [dict get $date year] % 100 }]}
+			append substituents { [expr { $year % 100 }]}
+			dict set fields year {
+			    set year [dict get $date year]
+			}
 		    }
 		    Y {			# The four-digit year
 			append formatString %04d
-			append substituents { [dict get $date year]}
+			append substituents { $year}
+			dict set fields year {
+			    set year [dict get $date year]
+			}
 		    }
 		    z {			# The time zone as hours and minutes
 					# east (+) or west (-) of Greenwich
@@ -1018,7 +1088,10 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 		    }
 		    Z {			# The name of the time zone
 			append formatString %s
-			append substituents { [dict get $date tzName]}
+			append substituents { $tzName}
+			dict set fields tzName {
+			    set tzName [dict get $date tzName]
+			}
 		    }
 		    % {			# A literal percent character
 			append formatString %%
@@ -1068,72 +1141,91 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 			# numerals
 			append formatString %s
 			append substituents \
-			    { [lindex $localeNumerals \
-				   [dict get $date dayOfMonth]]}
+			    { [lindex $localeNumerals $dayOfMonth]}
+			dict set fields dayOfMonth {
+			    set dayOfMonth [dict get $date dayOfMonth]
+			}
 		    }
 		    H - k {		# Hour of the day in alternative
 					# numerals
 			append formatString %s
 			append substituents \
 			    { [lindex $localeNumerals \
-				   [expr { [dict get $date localSeconds]
-					   / 3600
-					   % 24 }]]}
+				   [expr { $localSeconds / 3600 % 24 }]]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    I - l {		# Hour (12-11) AM/PM in alternative
 					# numerals
 			append formatString %s
 			append substituents \
 			    { [lindex $localeNumerals \
-				   [expr { ( ( ( [dict get $date localSeconds]
-						 % 86400 )
+				   [expr { ( ( ( $localSeconds % 86400 )
 					       + 86400
 					       - 3600 )
 					     / 3600 )
 					   % 12 + 1 }]]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    m {			# Month number in alternative numerals
 			append formatString %s
 			append substituents \
-			    { [lindex $localeNumerals [dict get $date month]]}
+			    { [lindex $localeNumerals $month]}
+			dict set fields month {
+			    set month [dict get $date month]
+			}
 		    }
 		    M {			# Minute of the hour in alternative
 					# numerals
 			append formatString %s
 			append substituents \
 			    { [lindex $localeNumerals \
-				   [expr { [dict get $date localSeconds]
-					   / 60
-					   % 60 }]]}
+				   [expr { $localSeconds / 60 % 60 }]]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    S {			# Second of the minute in alternative
 					# numerals
 			append formatString %s
 			append substituents \
 			    { [lindex $localeNumerals \
-				   [expr { [dict get $date localSeconds]
-					   % 60 }]]}
+				   [expr { $localSeconds % 60 }]]}
+			dict set fields localSeconds {
+			    set localSeconds [dict get $date localSeconds]
+			}
 		    }
 		    u {			# Day of the week (Monday=1,Sunday=7)
 					# in alternative numerals
 			append formatString %s
 			append substituents \
-			    { [lindex $localeNumerals \
-				   [dict get $date dayOfWeek]]}
+			    { [lindex $localeNumerals $dayOfWeek]}
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
 			}
+		    }
 		    w {			# Day of the week (Sunday=0,Saturday=6)
 					# in alternative numerals
 			append formatString %s
 			append substituents \
 			    { [lindex $localeNumerals \
-				   [expr { [dict get $date dayOfWeek] % 7 }]]}
+				   [expr { $dayOfWeek % 7 }]]}
+			dict set fields dayOfWeek {
+			    set dayOfWeek [dict get $date dayOfWeek]
+			}
 		    }
 		    y {			# Year of the century in alternative
 					# numerals
 			append formatString %s
 			append substituents \
 			    { [lindex $localeNumerals \
-				   [expr { [dict get $date year] % 100 }]]}
+				   [expr { $year % 100 }]]}
+			dict set fields year {
+			    set year [dict get $date year]
+			}
 		    }
 		    default {	# Unknown format group
 			append formatString %%O $char
@@ -1157,7 +1249,11 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 	}
     }
 
+    set extractCode [join [dict values $fields] ";"]
+
     proc $procName {clockval timezone} "
+	$prefixCode
+	$extractCode
         $preFormatCode
         return \[::format [list $formatString] $substituents\]
     "
@@ -1166,7 +1262,7 @@ proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
 
     return $procName
 }
-
+
 #----------------------------------------------------------------------
 #
 # clock scan --
@@ -1931,7 +2027,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
     # Build the procedure
 
     set procBody {}
-    append procBody "variable ::tcl::clock::TZData" \n
+    append procBody "variable TZData" \n
     append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->"
     for { set i 1 } { $i <= $captureCount } { incr i } {
 	append procBody " " field $i
@@ -1958,7 +2054,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
 	    }
 	}
 	append procBody {
-	    ::tcl::clock::SetupTimeZone $timeZone
+	    SetupTimeZone $timeZone
 	}
     }
 
@@ -1991,7 +2087,7 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
 	# Finally, convert the date to local time
 
 	append procBody {
-	    set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
+	    set date [ConvertLocalToUTC $date[set date {}] \
 			  $TZData($timeZone) $changeover]
 	}
     }

tests/assemble1.bench

@@ -1,85 +0,0 @@
-proc ulam1 {n} {
-    set max $n
-    while {$n != 1} {
-	if {$n > $max} {
-	    set max $n
-	}
-	if {$n % 2} {
-	    set n [expr {3 * $n + 1}]
-	} else {
-	    set n [expr {$n / 2}]
-	}
-    }
-    return $max
-}
-
-set tcl_traceCompile 2; ulam1 1; set tcl_traceCompile 0
-
-proc ulam2 {n} {
-    tcl::unsupported::assemble {
-	load n;		# max
-	dup;		# max n
-	jump start;     # max n
-	
-	label loop;	# max n
-	over 1;         # max n max
-	over 1;		# max in max n
-	ge;             # man n max>=n
-	jumpTrue skip;  # max n
-
-	reverse 2;      # n max
-	pop;            # n
-	dup;            # n n
-	
-	label skip;	# max n
-	dup;            # max n n
-	push 2;         # max n n 2
-	mod;            # max n n%2
-	jumpTrue odd;   # max n
-	
-	push 2;         # max n 2
-	div;            # max n/2 -> max n
-	jump start;     # max n
-	
-	label odd;	# max n
-	push 3;         # max n 3
-	mult;           # max 3*n
-	push 1;         # max 3*n 1
-	add;            # max 3*n+1
-	
-	label start;	# max n
-	dup;		# max n n
-	push 1;		# max n n 1
-	neq;		# max n n>1
-	jumpTrue loop;	# max n
-	
-	pop;		# max
-    }
-}
-set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0
-
-proc test1 {n} {
-    for {set i 1} {$i <= $n} {incr i} {
-	ulam1 $i  
-    }
-}
-proc test2 {n} {
-    for {set i 1} {$i <= $n} {incr i} {
-	ulam2 $i  
-    }
-}
-
-for {set j 0} {$j < 10} {incr j} {
-    test1 1
-    set before [clock microseconds]
-    test1 30000
-    set after [clock microseconds]
-    puts "compiled: [expr {1e-6 * ($after - $before)}]"
-    
-    test2 1
-    set before [clock microseconds]
-    test2 30000
-    set after [clock microseconds]
-    puts "assembled: [expr {1e-6 * ($after - $before)}]"
-}
-    

tests/case.test

@@ -1,89 +0,0 @@
-# Commands covered:  case
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
-#
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
-
-test case-1.1 {simple pattern} {
-    case a in a {format 1} b {format 2} c {format 3} default {format 4}
-} 1
-test case-1.2 {simple pattern} {
-    case b a {format 1} b {format 2} c {format 3} default {format 4}
-} 2
-test case-1.3 {simple pattern} {
-    case x in a {format 1} b {format 2} c {format 3} default {format 4}
-} 4
-test case-1.4 {simple pattern} {
-    case x a {format 1} b {format 2} c {format 3}
-} {}
-test case-1.5 {simple pattern matches many times} {
-    case b a {format 1} b {format 2} b {format 3} b {format 4}
-} 2
-test case-1.6 {fancier pattern} {
-    case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
-} 3
-test case-1.7 {list of patterns} {
-    case abc in {a b c} {format 1} {def abc ghi} {format 2}
-} 2
-
-test case-2.1 {error in executed command} {
-    list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
-	    $msg $::errorInfo
-} {1 {Just a test} {Just a test
-    while executing
-"error "Just a test""
-    ("a" arm line 1)
-    invoked from within
-"case a in a {error "Just a test"} default {format 1}"}}
-test case-2.2 {error: not enough args} {
-    list [catch {case} msg] $msg
-} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}}
-test case-2.3 {error: pattern with no body} {
-    list [catch {case a b} msg] $msg
-} {1 {extra case pattern with no body}}
-test case-2.4 {error: pattern with no body} {
-    list [catch {case a in b {format 1} c} msg] $msg
-} {1 {extra case pattern with no body}}
-test case-2.5 {error in default command} {
-    list [catch {case foo in a {error case1} default {error case2} \
-	    b {error case 3}} msg] $msg $::errorInfo
-} {1 case2 {case2
-    while executing
-"error case2"
-    ("default" arm line 1)
-    invoked from within
-"case foo in a {error case1} default {error case2}  b {error case 3}"}}
-
-test case-3.1 {single-argument form for pattern/command pairs} {
-    case b in {
-	a {format 1}
-	b {format 2}
-	default {format 6}
-    }
-} {2}
-test case-3.2 {single-argument form for pattern/command pairs} {
-    case b {
-	a {format 1}
-	b {format 2}
-	default {format 6}
-    }
-} {2}
-test case-3.3 {single-argument form for pattern/command pairs} {
-    list [catch {case z in {a 2 b}} msg] $msg
-} {1 {extra case pattern with no body}}
-
-# cleanup
-::tcltest::cleanupTests
-return

tests/cmdMZ.test

@@ -151,7 +151,7 @@ test cmdMZ-return-2.10 {return option handling} -body {
     list [catch {return -level 0 -code error} -> foo] [dictSort $foo]
 } -match glob -result {1 {-code 1 -errorcode NONE -errorinfo {
     while executing
-"return -level 0 -code error"} -errorline 1 -errorstack * -level 0}}
+"return -level 0 -code error"} -errorline 1 -level 0}}
 test cmdMZ-return-2.11 {return option handling} {
     list [catch {return -level 0 -code break} -> foo] [dictSort $foo]
 } {3 {-code 3 -level 0}}
@@ -187,9 +187,9 @@ test cmdMZ-return-2.17 {return opton handling} {
 } {1 c {a b}}
 test cmdMZ-return-2.18 {return option handling} {
     list [catch {
-	return -code error -errorstack [list CALL a CALL b] yo
-    } -> foo] [dictSort $foo] [info errorstack]
-} {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}}
+	return -code error yo
+    } -> foo] [dictSort $foo] 
+} {2 {-code 1 -errorcode NONE -level 1}}
 
 # Check that the result of a [return -options $opts $result] is
 # indistinguishable from that of the originally caught script, no matter what
@@ -208,7 +208,7 @@ foreach {testid script} {
     cmdMZ-return-3.10 {return -code error -errorinfo foo}
     cmdMZ-return-3.11 {return -code error -errorinfo foo -errorcode bar}
     cmdMZ-return-3.12 {return -code error -errorinfo foo -errorcode bar -errorline 10}
-    cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10 -errorstack baz}
+    cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10}
     cmdMZ-return-3.13 {return -options {x y z 2}}
     cmdMZ-return-3.14 {return -level 3 -code break sdf}
 } {

tests/compile.test

@@ -750,7 +750,7 @@ test compile-18.19 {disassembler - basics} -setup {
 } -match glob -result *
 # There never was a compile-18.20.
 # The keys of the dictionary produced by [getbytecode] are defined.
-set bytecodekeys {literals variables exception instructions auxiliary commands script namespace stackdepth exceptdepth}
+set bytecodekeys {literals variables exception instructions auxiliary commands script namespace stackdepth}
 test compile-18.21 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode
 } -match glob -result {wrong # args: should be "*"}
@@ -765,7 +765,7 @@ test compile-18.24 {disassembler - basics} -returnCodes error -body {
 } -result "can't interpret \"\{\" as a lambda expression"
 test compile-18.25 {disassembler - basics} -body {
     dict keys [tcl::unsupported::getbytecode lambda {{} {}}]
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $bytecodekeys
 test compile-18.26 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode proc
 } -match glob -result {wrong # args: should be "* proc procName"}
@@ -778,7 +778,7 @@ test compile-18.28 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode proc chewonthis]
 } -cleanup {
     rename chewonthis {}
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $bytecodekeys
 test compile-18.28.1 {disassembler - tricky bit} -setup {
     eval [list proc chewonthis {} {}]
 } -body {
@@ -792,7 +792,7 @@ test compile-18.28.2 {disassembler - tricky bit} -setup {
     dict keys [tcl::unsupported::getbytecode proc chewonthis]
 } -cleanup {
     rename chewonthis {}
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $bytecodekeys
 test compile-18.28.3 {disassembler - tricky bit} -setup {
     proc Proc {n a b} {
 	proc $n $a $b
@@ -814,7 +814,7 @@ test compile-18.28.4 {disassembler - tricky bit} -setup {
 } -cleanup {
     rename Proc {}
     rename chewonthis {}
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $bytecodekeys
 test compile-18.29 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode script
 } -match glob -result {wrong # args: should be "* script script"}
@@ -843,7 +843,7 @@ test compile-18.35 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode method foo bar]
 } -cleanup {
     foo destroy
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $bytecodekeys
 test compile-18.36 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode objmethod
 } -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
@@ -860,7 +860,7 @@ test compile-18.39 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode objmethod foo bar]
 } -cleanup {
     foo destroy
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $bytecodekeys
 
 test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
     # This will panic in a --enable-symbols=compile build, unless bug is fixed.

tests/coroutine.test

@@ -285,18 +285,18 @@ test coroutine-3.1 {info level computation} -setup {
     rename a {}
     rename b {}
 } -result {1 1 1}
-test coroutine-3.2 {info frame computation} -setup {
-    proc a {} {while 1 {yield [info frame]}}
-    proc b {} foo
-} -body {
-    set l0 [coroutine foo a]
-    set l1 [foo]
-    set l2 [b]
-    expr {$l2 - $l1}
-} -cleanup {
-    rename a {}
-    rename b {}
-} -result 1
+#test coroutine-3.2 {info frame computation} -setup {
+#    proc a {} {while 1 {yield [info frame]}}
+#    proc b {} foo
+#} -body {
+#    set l0 [coroutine foo a]
+#    set l1 [foo]
+#    set l2 [b]
+#    expr {$l2 - $l1}
+#} -cleanup {
+#    rename a {}
+#    rename b {}
+#} -result 1
 test coroutine-3.3 {info coroutine} -setup {
     proc a {} {info coroutine}
     proc b {} a
@@ -324,27 +324,27 @@ test coroutine-3.5 {info coroutine} -setup {
     rename a {}
     rename b {}
 } -result {}
-test coroutine-3.6 {info frame, bug #2910094} -setup {
-    proc stack {} {
-	set res [list "LEVEL:[set lev [info frame]]"]
-	for {set i 1} {$i < $lev} {incr i} {
-	    lappend res [info frame $i]
-	}
-	set res
-	# the precise command depends on line numbers and such, is likely not
-	# to be stable: just check that the test completes!
-	return
-    }
-    proc a {} stack
-} -body {
-    coroutine aa a
-} -cleanup {
-    rename stack {}
-    rename a {}
-} -result {}
-test coroutine-3.7 {bug 0b874c344d} {
-    dict get [coroutine X coroutine Y info frame 0] cmd
-} {coroutine X coroutine Y info frame 0}
+#test coroutine-3.6 {info frame, bug #2910094} -setup {
+#    proc stack {} {
+#	set res [list "LEVEL:[set lev [info frame]]"]
+#	for {set i 1} {$i < $lev} {incr i} {
+#	    lappend res [info frame $i]
+#	}
+#	set res
+#	# the precise command depends on line numbers and such, is likely not
+#	# to be stable: just check that the test completes!
+#	return
+#    }
+#    proc a {} stack
+#} -body {
+#    coroutine aa a
+#} -cleanup {
+#    rename stack {}
+#    rename a {}
+#} -result {}
+#test coroutine-3.7 {bug 0b874c344d} {
+#    dict get [coroutine X coroutine Y info frame 0] cmd
+#} {coroutine X coroutine Y info frame 0}
 
 test coroutine-4.1 {bug #2093188} -setup {
     proc foo {} {

tests/dict.test

@@ -1665,56 +1665,56 @@ test dict-22.23 {dict with: compiled} {
     }}
 } 1,2
 
-proc linenumber {} {
-    dict get [info frame -1] line
-}
-test dict-23.1 {dict compilation crash: Bug 3487626} {
-    apply {{} {apply {n {
-	set e {}
-	set k {}
-	dict for {a b} {c {d {e {f g}}}} {
-	    ::tcl::dict::for {h i} $b {
-		dict update i e j {
-		    ::tcl::dict::update j f k {
-			return [expr {$n - [linenumber]}]
-		    }
-		}
-	    }
-	}
-    }} [linenumber]}}
-} 5
-test dict-23.2 {dict compilation crash: Bug 3487626} {
-    # Something isn't quite right in line number and continuation line
-    # tracking; at time of writing, this test produces 7, not 5, which
-    # indicates that the extra newlines in the non-script argument are
-    # confusing things.
-    apply {{} {apply {n {
-	set e {}
-	set k {}
-	dict for {a {
-b
-}} {c {d {e {f g}}}} {
-	    ::tcl::dict::for {h {
-i
-}} ${
-b
-} {
-		dict update {
-i
-} e {
-j
-} {
-		    ::tcl::dict::update {
-j
-} f k {
-			return [expr {$n - [linenumber]}]
-		    }
-		}
-	    }
-	}
-    }} [linenumber]}}
-} 5
-rename linenumber {}
+#proc linenumber {} {
+#    dict get [info frame -1] line
+#}
+#test dict-23.1 {dict compilation crash: Bug 3487626} {
+#    apply {{} {apply {n {
+#	set e {}
+#	set k {}
+#	dict for {a b} {c {d {e {f g}}}} {
+#	    ::tcl::dict::for {h i} $b {
+#		dict update i e j {
+#		    ::tcl::dict::update j f k {
+#			return [expr {$n - [linenumber]}]
+#		    }
+#		}
+#	    }
+#	}
+#   }} [linenumber]}}
+#} 5
+#test dict-23.2 {dict compilation crash: Bug 3487626} {
+#    # Something isn't quite right in line number and continuation line
+#    # tracking; at time of writing, this test produces 7, not 5, which
+#    # indicates that the extra newlines in the non-script argument are
+#    # confusing things.
+#    apply {{} {apply {n {
+#	set e {}
+#	set k {}
+#	dict for {a {
+#b
+#}} {c {d {e {f g}}}} {
+#	    ::tcl::dict::for {h {
+#i
+#}} ${
+#b
+#} {
+#		dict update {
+#i
+#} e {
+#j
+#} {
+#		    ::tcl::dict::update {
+#j
+#} f k {
+#			return [expr {$n - [linenumber]}]
+#		    }
+#		}
+#	    }
+#	}
+#    }} [linenumber]}}
+#} 5
+#rename linenumber {}
 
 test dict-24.1 {dict map command: syntax} -returnCodes error -body {
     dict map
@@ -1899,123 +1899,123 @@ test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} {
 	concat "c=$y,$args"
     }} {} 1 2 3
 } {c=1,2 3}
-proc linenumber {} {
-    dict get [info frame -1] line
-}
-test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
-    apply {{} {apply {n {
-	set e {}
-	set k {}
-	dict map {a b} {c {d {e {f g}}}} {
-	    ::tcl::dict::map {h i} $b {
-		dict update i e j {
-		    ::tcl::dict::update j f k {
-			return [expr {$n - [linenumber]}]
-		    }
-		}
-	    }
-	}
-    }} [linenumber]}}
-} 5
-test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} {
-    apply {{} {apply {n {
-	set e {}
-	set k {}
-	dict map {a {
-b
-}} {c {d {e {f g}}}} {
-	    ::tcl::dict::map {h {
-i
-}} ${
-b
-} {
-		dict update {
-i
-} e {
-j
-} {
-		    ::tcl::dict::update {
-j
-} f k {
-			return [expr {$n - [linenumber]}]
-		    }
-		}
-	    }
-	}
-    }} [linenumber]}}
-} 5
+#proc linenumber {} {
+#    dict get [info frame -1] line
+#}
+#test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
+#    apply {{} {apply {n {
+#	set e {}
+#	set k {}
+#	dict map {a b} {c {d {e {f g}}}} {
+#	    ::tcl::dict::map {h i} $b {
+#		dict update i e j {
+#		    ::tcl::dict::update j f k {
+#			return [expr {$n - [linenumber]}]
+#		    }
+#		}
+#	    }
+#	}
+#    }} [linenumber]}}
+#} 5
+#test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} {
+#    apply {{} {apply {n {
+#	set e {}
+#	set k {}
+#	dict map {a {
+#b
+#}} {c {d {e {f g}}}} {
+#	    ::tcl::dict::map {h {
+#i
+#}} ${
+#b
+#} {
+#		dict update {
+#i
+#} e {
+#j
+#} {
+#		    ::tcl::dict::update {
+#j
+#} f k {
+#			return [expr {$n - [linenumber]}]
+#		    }
+#		}
+#	    }
+#	}
+#    }} [linenumber]}}
+#} 5
 test dict-23.3 {CompileWord OBOE} {
     # segfault when buggy
     apply {{} {tcl::dict::lappend foo bar \
 	[format baz]}}
 } {bar baz}
-test dict-23.4 {CompileWord OBOE} {
-    apply {n {
-	dict set foo {*}{
-	} [return [incr n -[linenumber]]] val
-    }} [linenumber]
-} 1
+#test dict-23.4 {CompileWord OBOE} {
+#    apply {n {
+#	dict set foo {*}{
+#	} [return [incr n -[linenumber]]] val
+#    }} [linenumber]
+#} 1
 test dict-23.5 {CompileWord OBOE} {
     # segfault when buggy
     apply {{} {tcl::dict::incr foo \
 	[format bar]}}
 } {bar 1}
-test dict-23.6 {CompileWord OBOE} {
-    apply {n {
-	dict get {a b} {*}{
-	} [return [incr n -[linenumber]]]
-    }} [linenumber]
-} 1
-test dict-23.7 {CompileWord OBOE} {
-    apply {n {
-	dict for {a b} [return [incr n -[linenumber]]] {*}{
-	} {}
-    }} [linenumber]
-} 2
-test dict-23.8 {CompileWord OBOE} {
-    apply {n {
-	dict update foo {*}{
-	} [return [incr n -[linenumber]]] x {}
-    }} [linenumber]
-} 1
-test dict-23.9 {CompileWord OBOE} {
-    apply {n {
-	dict exists {} {*}{
-	} [return [incr n -[linenumber]]]
-    }} [linenumber]
-} 1
-test dict-23.10 {CompileWord OBOE} {
-    apply {n {
-	dict with foo {*}{
-	} [return [incr n -[linenumber]]] {}
-    }} [linenumber]
-} 1
-test dict-23.11 {CompileWord OBOE} {
-    apply {n {
-	dict with ::foo {*}{
-	} [return [incr n -[linenumber]]] {}
-    }} [linenumber]
-} 1
-test dict-23.12 {CompileWord OBOE} {
-    apply {n {
-	dict with {*}{
-	} [return [incr n -[linenumber]]] {}
-    }} [linenumber]
-} 1
-test dict-23.13 {CompileWord OBOE} {
-    apply {n {
-	dict with {*}{
-	} [return [incr n -[linenumber]]] {bar}
-    }} [linenumber]
-} 1
-test dict-23.14 {CompileWord OBOE} {
-    apply {n {
-	dict with foo {*}{
-	} [return [incr n -[linenumber]]] {bar}
-    }} [linenumber]
-} 1
+#test dict-23.6 {CompileWord OBOE} {
+#    apply {n {
+#	dict get {a b} {*}{
+#	} [return [incr n -[linenumber]]]
+#    }} [linenumber]
+#} 1
+#test dict-23.7 {CompileWord OBOE} {
+#    apply {n {
+#	dict for {a b} [return [incr n -[linenumber]]] {*}{
+#	} {}
+#    }} [linenumber]
+#} 2
+#test dict-23.8 {CompileWord OBOE} {
+#    apply {n {
+#	dict update foo {*}{
+#	} [return [incr n -[linenumber]]] x {}
+#    }} [linenumber]
+#} 1
+#test dict-23.9 {CompileWord OBOE} {
+#    apply {n {
+#	dict exists {} {*}{
+#	} [return [incr n -[linenumber]]]
+#    }} [linenumber]
+#} 1
+#test dict-23.10 {CompileWord OBOE} {
+#    apply {n {
+#	dict with foo {*}{
+#	} [return [incr n -[linenumber]]] {}
+#    }} [linenumber]
+#} 1
+#test dict-23.11 {CompileWord OBOE} {
+#    apply {n {
+#	dict with ::foo {*}{
+#	} [return [incr n -[linenumber]]] {}
+#    }} [linenumber]
+#} 1
+#test dict-23.12 {CompileWord OBOE} {
+#    apply {n {
+#	dict with {*}{
+#	} [return [incr n -[linenumber]]] {}
+#    }} [linenumber]
+#} 1
+#test dict-23.13 {CompileWord OBOE} {
+#    apply {n {
+#	dict with {*}{
+#	} [return [incr n -[linenumber]]] {bar}
+#    }} [linenumber]
+#} 1
+#test dict-23.14 {CompileWord OBOE} {
+#    apply {n {
+#	dict with foo {*}{
+#	} [return [incr n -[linenumber]]] {bar}
+#    }} [linenumber]
+#} 1
+#rename linenumber {}
 
-rename linenumber {}
 test dict-24.22 {dict map results (non-compiled)} {
     dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
 	return -level 0 "$k,$v"

tests/error.test

@@ -170,28 +170,28 @@ test error-4.5 {errorInfo and errorCode variables} {
     list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode
 } {1 msg1 msg2 {}}
 
-test error-4.6 {errorstack via info } -body {
-    proc f x {g $x$x}
-    proc g x {error G:$x}
-    catch {f 12}
-    info errorstack
-} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
-test error-4.7 {errorstack via options dict } -body {
-    proc f x {g $x$x}
-    proc g x {error G:$x}
-    catch {f 12} m d
-    dict get $d -errorstack
-} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
-test error-4.8 {errorstack from exec traces} -body {
-    proc foo args {}
-    proc goo {} foo
-    trace add execution foo enter {error bar;#}
-    catch goo m d
-    dict get $d -errorstack
-} -cleanup {
-    rename goo {}; rename foo {}
-    unset -nocomplain m d
-} -result {INNER {error bar} CALL goo UP 1}
+#test error-4.6 {errorstack via info } -body {
+#    proc f x {g $x$x}
+#    proc g x {error G:$x}
+#    catch {f 12}
+#    info errorstack
+#} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
+#test error-4.7 {errorstack via options dict } -body {
+#    proc f x {g $x$x}
+#    proc g x {error G:$x}
+#    catch {f 12} m d
+#    dict get $d -errorstack
+#} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
+#test error-4.8 {errorstack from exec traces} -body {
+#    proc foo args {}
+#    proc goo {} foo
+#    trace add execution foo enter {error bar;#}
+#    catch goo m d
+#    dict get $d -errorstack
+#} -cleanup {
+#    rename goo {}; rename foo {}
+#    unset -nocomplain m d
+#} -result {INNER {error bar} CALL goo UP 1}
 
 # Errors in error command itself
 
@@ -247,15 +247,15 @@ test error-6.9 {catch must reset error state} {
     catch foo
     list $::errorCode
 } {NONE}
-test error-6.10 {catch must reset errorstack} -body {
-	proc f x {g $x$x}
-	proc g x {error G:$x}
-	catch {f 12}
-	set e1 [info errorstack]
-	catch {f 13}
-	set e2 [info errorstack]
-	list $e1 $e2
-} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}}
+#test error-6.10 {catch must reset errorstack} -body {
+#	proc f x {g $x$x}
+#	proc g x {error G:$x}
+#	catch {f 12}
+#	set e1 [info errorstack]
+#	catch {f 13}
+#	set e2 [info errorstack]
+#	list $e1 $e2
+#} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}}
 
 test error-7.1 {Bug 1397843} -body {
     variable cmds

tests/execute.test

@@ -972,7 +972,7 @@ test execute-8.5 {Bug 2038069} -setup {
     demo
 } -cleanup {
     rename demo {}
-} -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO
+} -match glob -result {-code 1 -level 0 -errorcode NONE -errorinfo {FOO
     while executing
 "error FOO"
     invoked from within
@@ -1057,15 +1057,15 @@ test execute-11.2 {Bug 268b23df11} -setup {
     rename crash {}
     rename zero {}
 } -result 0
-test execute-11.3 {Bug a0ece9d6d4} -setup {
-    proc crash {} {expr {rand()}}
-    trace add execution crash enterstep {apply {args {info frame -2}}}
-} -body {
-    string is double [crash]
-} -cleanup {
-    trace remove execution crash enterstep {apply {args {info frame -2}}}
-    rename crash {}
-} -result 1
+#test execute-11.3 {Bug a0ece9d6d4} -setup {
+#    proc crash {} {expr {rand()}}
+#    trace add execution crash enterstep {apply {args {info frame -2}}}
+#} -body {
+#    string is double [crash]
+#} -cleanup {
+#    trace remove execution crash enterstep {apply {args {info frame -2}}}
+#    rename crash {}
+#} -result 1
 
 # cleanup
 if {[info commands testobj] != {}} {

tests/for.test

@@ -690,7 +690,7 @@ test for-6.9 {Tcl_ForObjCmd: error executing command body} -body {
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
-    ("for" body line 1)
+    (loop body line 1)
     invoked from within
 "$z {set i 0} {$i < 5} {incr i} {set}"}
 test for-6.10 {Tcl_ForObjCmd: simple command body} {

tests/foreach.test

@@ -254,16 +254,16 @@ test foreach-9.1 {compiled empty var list} {
     list [catch { foo } msg] $msg
 } {1 {foreach varlist is empty}}
 
-test foreach-9.2 {line numbers} -setup {
-    proc linenumber {} {dict get [info frame -1] line}
-} -body {
-    apply {n {
-        foreach x y {*}{
-        } {return [incr n -[linenumber]]}
-    }} [linenumber]
-} -cleanup {
-    rename linenumber {}
-} -result 1
+#test foreach-9.2 {line numbers} -setup {
+#    proc linenumber {} {dict get [info frame -1] line}
+#} -body {
+#    apply {n {
+#        foreach x y {*}{
+#        } {return [incr n -[linenumber]]}
+#    }} [linenumber]
+#} -cleanup {
+#    rename linenumber {}
+#} -result 1
 
 test foreach-10.1 {foreach: [Bug 1671087]} -setup {
     proc demo {} {

tests/interp.test

@@ -3083,36 +3083,12 @@ test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
     $i eval alias
 } this
 
-test interp-34.1 {basic test of limits - calling commands} -body {
-    set i [interp create]
-    $i eval {
-	proc foobar {} {
-	    for {set x 0} {$x<1000000} {incr x} {
-		# Calls to this are not bytecoded away
-		pid
-	    }
-	}
-    }
-    $i limit command -value 1000
-    $i eval foobar
-} -returnCodes error -result {command count limit exceeded} -cleanup {
-    interp delete $i
-}
-test interp-34.2 {basic test of limits - bytecoded commands} -body {
-    set i [interp create]
-    $i eval {
-	proc foobar {} {
-	    for {set x 0} {$x<1000000} {incr x} {
-		# Calls to this *are* bytecoded away
-		expr {1+2+3}
-	    }
-	}
-    }
-    $i limit command -value 1000
-    $i eval foobar
-} -returnCodes error -result {command count limit exceeded} -cleanup {
-    interp delete $i
-}
+test interp-34.1 {basic test of limits - calling commands} {
+    # testing removed command limits
+} {}
+test interp-34.2 {basic test of limits - bytecoded commands} {
+    # testing removed command limits
+} {}
 test interp-34.3 {basic test of limits - pure bytecode loop} -body {
     set i [interp create]
     $i eval {
@@ -3144,131 +3120,21 @@ test interp-34.3.1 {basic test of limits - pure inside-command loop} -body {
 } -returnCodes error -result {time limit exceeded} -cleanup {
     interp delete $i
 }
-test interp-34.4 {limits with callbacks: extending limits} -setup {
-    set i [interp create]
-    set a 0
-    set b 0
-    set c a
-    proc cb1 {} {
-	global c
-	incr ::$c
-    }
-    proc cb2 {newlimit args} {
-	global c i
-	set c b
-	$i limit command -value $newlimit
-    }
-} -body {
-    interp alias $i foo {} cb1
-    set curlim [$i eval info cmdcount]
-    $i limit command -command "cb2 [expr $curlim+100]" \
-	    -value [expr {$curlim+10}]
-    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
-    list $a $b $c
-} -result {6 4 b} -cleanup {
-    interp delete $i
-    rename cb1 {}
-    rename cb2 {}
-}
+test interp-34.4 {limits with callbacks: extending limits} {
+    # testing removed command limits
+} {}
 # The next three tests exercise all the three ways that limit handlers
 # can be deleted.  Fully verifying this requires additional source
 # code instrumentation.
-test interp-34.5 {limits with callbacks: removing limits} -setup {
-    set i [interp create]
-    set a 0
-    set b 0
-    set c a
-    proc cb1 {} {
-	global c
-	incr ::$c
-    }
-    proc cb2 {newlimit args} {
-	global c i
-	set c b
-	$i limit command -value $newlimit
-    }
-} -body {
-    interp alias $i foo {} cb1
-    set curlim [$i eval info cmdcount]
-    $i limit command -command "cb2 {}" -value [expr {$curlim+10}]
-    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
-    list $a $b $c
-} -result {6 4 b} -cleanup {
-    interp delete $i
-    rename cb1 {}
-    rename cb2 {}
-}
-test interp-34.6 {limits with callbacks: removing limits and handlers} -setup {
-    set i [interp create]
-    set a 0
-    set b 0
-    set c a
-    proc cb1 {} {
-	global c
-	incr ::$c
-    }
-    proc cb2 {args} {
-	global c i
-	set c b
-	$i limit command -value {} -command {}
-    }
-} -body {
-    interp alias $i foo {} cb1
-    set curlim [$i eval info cmdcount]
-    $i limit command -command cb2 -value [expr {$curlim+10}]
-    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
-    list $a $b $c
-} -result {6 4 b} -cleanup {
-    interp delete $i
-    rename cb1 {}
-    rename cb2 {}
-}
-test interp-34.7 {limits with callbacks: deleting the handler interp} -setup {
-    set i [interp create]
-    $i eval {
-	set i [interp create]
-	proc cb1 {} {
-	    global c
-	    incr ::$c
-	}
-	proc cb2 {args} {
-	    global c i curlim
-	    set c b
-	    $i limit command -value [expr {$curlim+1000}]
-	    trapToParent
-	}
-    }
-    proc cb3 {} {
-	global i subi
-	interp alias [list $i $subi] foo {} cb4
-	interp delete $i
-    }
-    proc cb4 {} {
-	global n
-	incr n
-    }
-} -body {
-    set subi [$i eval set i]
-    interp alias $i trapToParent {} cb3
-    set n 0
-    $i eval {
-	set a 0
-	set b 0
-	set c a
-	interp alias $i foo {} cb1
-	set curlim [$i eval info cmdcount]
-	$i limit command -command cb2 -value [expr {$curlim+10}]
-    }
-    $i eval {
-	$i eval {
-	    for {set i 0} {$i<10} {incr i} {foo}
-	}
-    }
-    list $n [interp exists $i]
-} -result {4 0} -cleanup {
-    rename cb3 {}
-    rename cb4 {}
-}
+test interp-34.5 {limits with callbacks: removing limits} {
+    # testing removed command limits
+} {}
+test interp-34.6 {limits with callbacks: removing limits and handlers} {
+    # testing removed command limits
+} {}
+test interp-34.7 {limits with callbacks: deleting the handler interp} {
+    # testing removed command limits
+} {}
 # Bug 1085023
 test interp-34.8 {time limits trigger in vwaits} -body {
     set i [interp create]
@@ -3387,59 +3253,30 @@ test interp-35.2 {interp limit syntax} -body {
 test interp-35.3 {interp limit syntax} -body {
     interp limit {} foo
 } -returnCodes error -result {bad limit type "foo": must be commands or time}
-test interp-35.4 {interp limit syntax} -body {
-    set i [interp create]
-    set dict [interp limit $i commands]
-    set result {}
-    foreach key [lsort [dict keys $dict]] {
-	lappend result $key [dict get $dict $key]
-    }
-    set result
-} -cleanup {
-    interp delete $i
-} -result {-command {} -granularity 1 -value {}}
-test interp-35.5 {interp limit syntax} -body {
-    set i [interp create]
-    interp limit $i commands -granularity
-} -cleanup {
-    interp delete $i
-} -result 1
-test interp-35.6 {interp limit syntax} -body {
-    set i [interp create]
-    interp limit $i commands -granularity 2
-} -cleanup {
-    interp delete $i
-} -result {}
-test interp-35.7 {interp limit syntax} -body {
-    set i [interp create]
-    interp limit $i commands -foobar
-} -cleanup {
-    interp delete $i
-} -returnCodes error -result {bad option "-foobar": must be -command, -granularity, or -value}
-test interp-35.8 {interp limit syntax} -body {
-    set i [interp create]
-    interp limit $i commands -granularity foobar
-} -cleanup {
-    interp delete $i
-} -returnCodes error -result {expected integer but got "foobar"}
-test interp-35.9 {interp limit syntax} -body {
-    set i [interp create]
-    interp limit $i commands -granularity 0
-} -cleanup {
-    interp delete $i
-} -returnCodes error -result {granularity must be at least 1}
-test interp-35.10 {interp limit syntax} -body {
-    set i [interp create]
-    interp limit $i commands -value foobar
-} -cleanup {
-    interp delete $i
-} -returnCodes error -result {expected integer but got "foobar"}
-test interp-35.11 {interp limit syntax} -body {
-    set i [interp create]
-    interp limit $i commands -value -1
-} -cleanup {
-    interp delete $i
-} -returnCodes error -result {command limit value must be at least 0}
+test interp-35.4 {interp limit syntax} {
+    # testing removed command limits
+} {}
+test interp-35.5 {interp limit syntax} {
+    # testing removed command limits
+} {}
+test interp-35.6 {interp limit syntax} {
+    # testing removed command limits
+} {}
+test interp-35.7 {interp limit syntax} {
+    # testing removed command limits
+} {}
+test interp-35.8 {interp limit syntax} {
+    # testing removed command limits
+} {}
+test interp-35.9 {interp limit syntax} {
+    # testing removed command limits
+} {}
+test interp-35.10 {interp limit syntax} {
+    # testing removed command limits
+} {}
+test interp-35.11 {interp limit syntax} {
+    # testing removed command limits
+} {}
 test interp-35.12 {interp limit syntax} -body {
     set i [interp create]
     set dict [interp limit $i time]
@@ -3513,9 +3350,9 @@ test interp-35.22 {interp time limits normalize milliseconds} -body {
     interp delete $i
 } -result {2 500}
 # Bug 3398794
-test interp-35.23 {interp command limits can't touch current interp} -body {
-    interp limit {} commands -value 10
-} -returnCodes error -result {limits on current interpreter inaccessible}
+test interp-35.23 {interp command limits can't touch current interp} {
+    # testing removed command limits
+} {}
 test interp-35.24 {interp time limits can't touch current interp} -body {
     interp limit {} time -seconds 2
 } -returnCodes error -result {limits on current interpreter inaccessible}

tests/nre.test

@@ -28,8 +28,8 @@ if {[testConstraint testnrelevels]} {
     namespace eval testnre {
 	namespace path ::tcl::mathop
 	#
-	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
-	# cmdFrame level, callFrame level, tosPtr and callback depth 
+	# [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels,
+	# callFrame level, tosPtr and callback depth 
 	#
 	variable last [testnrelevels] 
 	proc depthDiff {} {
@@ -52,7 +52,7 @@ if {[testConstraint testnrelevels]} {
 		namespace upvar [namespace qualifiers \
 			[namespace origin depthDiff]] abs abs
 		incr abs [lindex [testnrelevels] 0]
-		return [list [lrange $x 0 3] $abs]
+		return [list [lrange $x 0 2] $abs]
 	    }
 	}
 	proc makebody txt {
@@ -77,7 +77,7 @@ test nre-1.1 {self-recursive procs} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 1 1 1} 0}
+} -result {{0 1 1} 0}
 test nre-1.2 {self-recursive lambdas} -setup {
     set a [list i [makebody {apply $::a $i}]]
 } -body {
@@ -87,7 +87,7 @@ test nre-1.2 {self-recursive lambdas} -setup {
     unset a
 } -constraints {
     testnrelevels
-} -result {{0 1 1 1} 0}
+} -result {{0 1 1} 0}
 test nre-1.3 {mutually recursive procs and lambdas} -setup {
     proc a i {
 	apply $::b [incr i]
@@ -101,7 +101,7 @@ test nre-1.3 {mutually recursive procs and lambdas} -setup {
     unset b
 } -constraints {
     testnrelevels
-} -result {{0 2 2 2} 0}
+} -result {{0 2 2} 0}
 
 #
 # Test that aliases are non-recursive
@@ -118,7 +118,7 @@ test nre-2.1 {alias is not recursive} -setup {
     rename b {}
 } -constraints {
     testnrelevels
-} -result {{0 2 1 1} 0}
+} -result {{0 2 1} 0}
 
 #
 # Test that imports are non-recursive
@@ -138,7 +138,7 @@ test nre-3.1 {imports are not recursive} -setup {
     namespace delete ::foo
 } -constraints {
     testnrelevels
-} -result {{0 2 1 1} 0}
+} -result {{0 2 1} 0}
 
 test nre-4.1 {ensembles are not recursive} -setup {
     proc a i [makebody {b foo $i}]
@@ -153,7 +153,7 @@ test nre-4.1 {ensembles are not recursive} -setup {
     rename b {}
 } -constraints {
     testnrelevels
-} -result {{0 2 1 1} 0}
+} -result {{0 2 1} 0}
 
 test nre-4.2 {(compiled) ensembles do not break tailcall} -setup {
     # Fix Bug d87cb18205
@@ -187,7 +187,7 @@ test nre-5.1 {[namespace eval] is not recursive} -setup {
     namespace delete ::foo
 } -constraints {
     testnrelevels
-} -result {{0 2 2 2} 0}
+} -result {{0 2 2} 0}
 test nre-5.2 {[namespace eval] is not recursive} -setup {
     namespace eval ::foo {
 	setabs
@@ -199,7 +199,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup {
     namespace delete ::foo
 } -constraints {
     testnrelevels
-} -result {{0 2 2 2} 0}
+} -result {{0 2 2} 0}
 
 test nre-6.1 {[uplevel] is not recursive} -setup {
     proc a i [makebody {uplevel 1 [list a $i]}]
@@ -210,7 +210,7 @@ test nre-6.1 {[uplevel] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 2 2 0} 0}
+} -result {{0 2 0} 0}
 test nre-6.2 {[uplevel] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "set x $i; a $i"}]
@@ -220,7 +220,7 @@ test nre-6.2 {[uplevel] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 2 2 0} 0}
+} -result {{0 2 0} 0}
 
 test nre-7.1 {[catch] is not recursive} -setup {
     setabs
@@ -231,7 +231,7 @@ test nre-7.1 {[catch] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 3 3 0} 0}
+} -result {{0 3 0} 0}
 test nre-7.2 {[if] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
@@ -241,7 +241,7 @@ test nre-7.2 {[if] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 2 2 0} 0}
+} -result {{0 2 0} 0}
 test nre-7.3 {[while] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
@@ -251,7 +251,7 @@ test nre-7.3 {[while] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 2 2 0} 0}
+} -result {{0 2 0} 0}
 test nre-7.4 {[for] is not recursive} -setup {
     setabs
     proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
@@ -261,7 +261,7 @@ test nre-7.4 {[for] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 2 2 0} 0}
+} -result {{0 2 0} 0}
 test nre-7.5 {[foreach] is not recursive} -setup {
     #
     # Enable once [foreach] is NR-enabled
@@ -274,7 +274,7 @@ test nre-7.5 {[foreach] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 3 3 0} 0}
+} -result {{0 3 0} 0}
 test nre-7.6 {[eval] is not recursive} -setup {
     proc a i [makebody {eval [list a $i]}]
 } -body {
@@ -284,7 +284,7 @@ test nre-7.6 {[eval] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 2 2 1} 0}
+} -result {{0 2 1} 0}
 test nre-7.7 {[eval] is not recursive} -setup {
     proc a i [makebody {eval "a $i"}]
 } -body {
@@ -294,7 +294,7 @@ test nre-7.7 {[eval] is not recursive} -setup {
     rename a {}
 } -constraints {
     testnrelevels
-} -result {{0 2 2 1} 0}
+} -result {{0 2 1} 0}
 test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
     proc foo args {}
     foo
@@ -358,7 +358,7 @@ test nre-oo.1 {really deep calls in oo - direct} -setup {
     foo destroy
 } -constraints {
     testnrelevels
-} -result {{0 1 1 1} 0}
+} -result {{0 1 1} 0}
 test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
     oo::object create foo
     oo::objdefine foo method bar i [makebody {[self] bar $i}]
@@ -369,7 +369,7 @@ test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
     foo destroy
 } -constraints {
     testnrelevels
-} -result {{0 1 1 1} 0}
+} -result {{0 1 1} 0}
 test nre-oo.3 {really deep calls in oo - private calls} -setup {
     oo::object create foo
     oo::objdefine foo method bar i [makebody {my bar $i}]
@@ -380,7 +380,7 @@ test nre-oo.3 {really deep calls in oo - private calls} -setup {
     foo destroy
 } -constraints {
     testnrelevels
-} -result {{0 1 1 1} 0}
+} -result {{0 1 1} 0}
 test nre-oo.4 {really deep calls in oo - overriding} -setup {
     oo::class create foo {
 	method bar i [makebody {my bar $i}]
@@ -396,7 +396,7 @@ test nre-oo.4 {really deep calls in oo - overriding} -setup {
     foo destroy
 } -constraints {
     testnrelevels
-} -result {{0 1 1 1} 0}
+} -result {{0 1 1} 0}
 test nre-oo.5 {really deep calls in oo - forwards} -setup {
     oo::object create foo
     set body [makebody {my boo $i}]
@@ -411,7 +411,7 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup {
     foo destroy
 } -constraints {
     testnrelevels
-} -result {{0 2 1 1} 0}
+} -result {{0 2 1} 0}
 
 #
 # NASTY BUG found by tcllib's interp package

tests/oo.test

@@ -2847,45 +2847,45 @@ test oo-21.4 {OO: inheritance ordering} -setup {
     A destroy
 } -result {Emix-filt B-filt D-cfilt B-cfilt Fmix Emix o D B C A}
 
-test oo-22.1 {OO and info frame} -setup {
-    oo::class create c
-    c create i
-} -match glob -body {
-    oo::define c self method frame {} {
-	info frame 0
-    }
-    oo::define c {
-	method frames {} {
-	    info frame 0
-	}
-	method level {} {
-	    info frame
-	}
-    }
-    oo::objdefine i {
-	method frames {} {
-	    list [next] [info frame 0]
-	}
-	method level {} {
-	    expr {[next] - [info frame]}
-	}
-    }
-    list [i level] [i frames] [dict get [c frame] object]
-} -cleanup {
-    c destroy
-} -result {1 {{* cmd {info frame 0} method frames class ::c level 0} {* cmd {info frame 0} method frames object ::i level 0}} ::c}
-test oo-22.2 {OO and info frame: Bug 3001438} -setup {
-    oo::class create c
-} -body {
-    oo::define c method test {{x 1}} {
-	if {$x} {my test 0}
-	lsort {q w e r t y u i o p}; # Overwrite the Tcl stack
-	info frame 0
-    }
-    [c new] test
-} -match glob -cleanup {
-    c destroy
-} -result {* cmd {info frame 0} method test class ::c level 0}
+#test oo-22.1 {OO and info frame} -setup {
+#    oo::class create c
+#    c create i
+#} -match glob -body {
+#    oo::define c self method frame {} {
+#	info frame 0
+#    }
+#    oo::define c {
+#	method frames {} {
+#	    info frame 0
+#	}
+#	method level {} {
+#	    info frame
+#	}
+#    }
+#    oo::objdefine i {
+#	method frames {} {
+#	    list [next] [info frame 0]
+#	}
+#	method level {} {
+#	    expr {[next] - [info frame]}
+#	}
+#    }
+#    list [i level] [i frames] [dict get [c frame] object]
+#} -cleanup {
+#    c destroy
+#} -result {1 {{* cmd {info frame 0} method frames class ::c level 0} {* cmd {info frame 0} method frames object ::i level 0}} ::c}
+#test oo-22.2 {OO and info frame: Bug 3001438} -setup {
+#    oo::class create c
+#} -body {
+#    oo::define c method test {{x 1}} {
+#	if {$x} {my test 0}
+#	lsort {q w e r t y u i o p}; # Overwrite the Tcl stack
+#	info frame 0
+#    }
+#    [c new] test
+#} -match glob -cleanup {
+#    c destroy
+#} -result {* cmd {info frame 0} method test class ::c level 0}
 
 # Prove that the issue in [Bug 1865054] isn't an issue any more
 test oo-23.1 {Self-like derivation; complex case!} -setup {

tests/parse.test

@@ -453,7 +453,7 @@ test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
 } {1 {can't read "x": no such variable
     while executing
 "set x"
-    ("for" body line 5)
+    (loop body line 5)
     invoked from within
 "for {} 1 {} {
 
@@ -1124,12 +1124,12 @@ test parse-21.0 {Bug 1884496} testevent {
     testevent queue a head $::script
     vwait done
 } {}
-test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent {
-    testevent queue a head {testevent delete a; \
-	set ::done [dict get [info frame 0] line]}
-    vwait done
-    set ::done
-} 2
+#test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent {
+#    testevent queue a head {testevent delete a; \
+#	set ::done [dict get [info frame 0] line]}
+#    vwait done
+#    set ::done
+#} 2
 
 cleanupTests
 }

tests/result.test

@@ -134,14 +134,15 @@ test result-6.3 {Bug 2383005} {
      catch {return -code error -errorcode {{}a} eek} m
      set m
 } {bad -errorcode value: expected a list but got "{}a"}
-test result-6.4 {non-list -errorstack} -body {
-     catch {return -code error -errorstack {{}a} eek} m o
-     list $m [dict get $o -errorcode] [dict get $o -errorstack]
-} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}}
-test result-6.5 {odd-sized-list -errorstack} -body {
-     catch {return -code error -errorstack a eek} m o
-     list $m [dict get $o -errorcode] [dict get $o -errorstack]
-} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}}
+#test result-6.4 {non-list -errorstack} -body {
+#     catch {return -code error -errorstack {{}a} eek} m o
+#     list $m [dict get $o -errorcode] [dict get $o -errorstack]
+#} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}}
+#test result-6.5 {odd-sized-list -errorstack} -body {
+#     catch {return -code error -errorstack a eek} m o
+#     list $m [dict get $o -errorcode] [dict get $o -errorstack]
+#} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}}
+
 # cleanup
 cleanupTests
 return

tests/source.test

@@ -187,15 +187,15 @@ test source-3.5 {return with special code etc.} -setup {
     invoked from within
 "source $sourcefile"} {a b c}}
 
-test source-4.1 {continuation line parsing} -setup {
-    set sourcefile [makeFile [string map {CL \\\n} {
-	format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]"
-    }] source.file]
-} -body {
-    source $sourcefile
-} -cleanup {
-    removeFile source.file
-} -result {source: 3 4 5}
+#test source-4.1 {continuation line parsing} -setup {
+#    set sourcefile [makeFile [string map {CL \\\n} {
+#	format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]"
+#    }] source.file]
+#} -body {
+#    source $sourcefile
+#} -cleanup {
+#    removeFile source.file
+#} -result {source: 3 4 5}
 
 test source-6.1 {source is binary ok} -setup {
     # Note [makeFile] writes in the system encoding.

tests/tailcall.test

@@ -27,8 +27,8 @@ testConstraint testnrelevels [llength [info commands testnrelevels]]
 if {[testConstraint testnrelevels]} {
     namespace eval testnre {
 	#
-	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
-	# cmdFrame level, callFrame level, tosPtr and callback depth 
+	# [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels,
+	# callFrame level, tosPtr and callback depth 
 	#
 	variable last [testnrelevels] 
 	proc depthDiff {} {
@@ -69,7 +69,7 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup
     a 0
 } -cleanup {
     rename a {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup {
     set a { i {
@@ -86,7 +86,7 @@ test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup
     apply $a 0
 } -cleanup {
     unset a
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup {
     proc a i {
@@ -104,7 +104,7 @@ test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename a {}
     rename b {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup {
     namespace eval ::ns {
@@ -127,7 +127,7 @@ test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename b {}
     namespace delete ::ns
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup {
     proc b i {
@@ -145,7 +145,7 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename a {}
     rename b {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup {
     # 
@@ -175,7 +175,7 @@ test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -set
     rename b {}
     namespace ensemble configure dict -map $map0
     unset map map0
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup {
     #
@@ -200,7 +200,7 @@ test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels known
     rename a {}
     rename c {}
     rename d {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup {
     catch {rename foo {}}
@@ -221,7 +221,7 @@ test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename a {}
     rename foo {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-1 {tailcall} -body {
     namespace eval a {

tests/upvar.test

@@ -414,16 +414,16 @@ test upvar-9.7 {Tcl_UpVar procedure} testupvar {
 } {1234}
 catch {unset a}
 
-test upvar-10.1 {CompileWord OBOE} -setup {
-    proc linenumber {} {dict get [info frame -1] line}
-} -body {
-    apply {n {
-        upvar 1 {*}{
-        } [return [incr n -[linenumber]]] x
-    }} [linenumber]
-} -cleanup {
-    rename linenumber {}
-} -result 1
+#test upvar-10.1 {CompileWord OBOE} -setup {
+#    proc linenumber {} {dict get [info frame -1] line}
+#} -body {
+#    apply {n {
+#        upvar 1 {*}{
+#        } [return [incr n -[linenumber]]] x
+#    }} [linenumber]
+#} -cleanup {
+#    rename linenumber {}
+#} -result 1
 
 #
 # Tests for 'namespace upvar'. As the implementation is essentially the same as
@@ -548,36 +548,36 @@ test upvar-NS-2.2 {TIP 323} -setup {
     namespace delete test_ns_1
 } -result {}
 
-test upvar-NS-3.1 {CompileWord OBOE} -setup {
-    proc linenumber {} {dict get [info frame -1] line}
-} -body {
-    apply {n {
-        namespace upvar {*}{
-        } [return [incr n -[linenumber]]] x y
-    }} [linenumber]
-} -cleanup {
-    rename linenumber {}
-} -result 1
-test upvar-NS-3.2 {CompileWord OBOE} -setup {
-    proc linenumber {} {dict get [info frame -1] line}
-} -body {
-    apply {n {
-        namespace upvar :: {*}{
-        } [return [incr n -[linenumber]]] x
-    }} [linenumber]
-} -cleanup {
-    rename linenumber {}
-} -result 1
-test upvar-NS-3.3 {CompileWord OBOE} -setup {
-    proc linenumber {} {dict get [info frame -1] line}
-} -body {
-    apply {n {
-        variable x {*}{
-        } [return [incr n -[linenumber]]]
-    }} [linenumber]
-} -cleanup {
-    rename linenumber {}
-} -result 1
+#test upvar-NS-3.1 {CompileWord OBOE} -setup {
+#    proc linenumber {} {dict get [info frame -1] line}
+#} -body {
+#    apply {n {
+#        namespace upvar {*}{
+#        } [return [incr n -[linenumber]]] x y
+#    }} [linenumber]
+#} -cleanup {
+#    rename linenumber {}
+#} -result 1
+#test upvar-NS-3.2 {CompileWord OBOE} -setup {
+#    proc linenumber {} {dict get [info frame -1] line}
+#} -body {
+#    apply {n {
+#        namespace upvar :: {*}{
+#        } [return [incr n -[linenumber]]] x
+#    }} [linenumber]
+#} -cleanup {
+#    rename linenumber {}
+#} -result 1
+#test upvar-NS-3.3 {CompileWord OBOE} -setup {
+#    proc linenumber {} {dict get [info frame -1] line}
+#} -body {
+#    apply {n {
+#        variable x {*}{
+#        } [return [incr n -[linenumber]]]
+#    }} [linenumber]
+#} -cleanup {
+#    rename linenumber {}
+#} -result 1
 
 # cleanup
 ::tcltest::cleanupTests

tests/var.test

@@ -883,17 +883,17 @@ test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body {
     apply {{} {set name foo(bar); array set $name {a 1}}}
 } -returnCodes error -match glob -result *
 
-test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
-    proc linenumber {} {dict get [info frame -1] line}
-} -body {
-    apply {n {
-	set foo bar
-        unset foo {*}{
-        } [return [incr n -[linenumber]]]
-    }} [linenumber]
-} -cleanup {
-    rename linenumber {}
-} -result 1
+#test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
+#    proc linenumber {} {dict get [info frame -1] line}
+#} -body {
+#    apply {n {
+#	set foo bar
+#        unset foo {*}{
+#        } [return [incr n -[linenumber]]]
+#    }} [linenumber]
+#} -cleanup {
+#    rename linenumber {}
+#} -result 1
 
 test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
     proc getbytes {} {

tests/while.test

@@ -393,7 +393,7 @@ test while-4.9 {while (not compiled): error compiling command body} -body {
 } -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
-    ("while" body line 1)
+    (loop body line 1)
     invoked from within
 "$z {$i < 5} {set}"}
 test while-4.10 {while (not compiled): simple command body} -body {

tools/cgannotate.tcl

@@ -0,0 +1,24 @@
+#!/usr/bin/tclsh
+#
+# A wrapper around cg_annotate that sets appropriate command-line options
+# and rearranges the output so that annotated files occur in a consistent
+# sorted order.
+#
+
+set in [open |[list cg_annotate --show=Ir --auto=yes --context=40 {*}$argv] r]
+set dest !
+set out(!) {}
+while {![eof $in]} {
+    set line [string map {\t {        }} [gets $in]]
+    if {[regexp {^-- Auto-annotated source: (.*)} $line all name]} {
+	set dest $name
+    } elseif {[regexp {^-- line \d+ ------} $line]} {
+	set line [lreplace $line 2 2 {#}]
+    } elseif {[regexp {^The following files chosen for } $line]} {
+	set dest !
+    }
+    append out($dest) $line\n
+}
+foreach x [lsort [array names out]] {
+    puts $out($x)
+}

tools/microoptimization/clockformatscan.tcl

@@ -0,0 +1,5 @@
+apply {{{limit 5000}} {
+    for {set i 0} {$i < $limit} {incr i} {
+	clock scan [clock format $i -format %T] -format %T
+    }
+}} {*}$argv

tools/microoptimization/generalbytecode.tcl

@@ -0,0 +1,13 @@
+apply {{{limit1 100} {limit2 1000}} {
+    for {set i 0} {$i < $limit1} {incr i} {
+	apply {limit2 {
+	    set a {}
+	    set b {}
+	    for {set i 0} {$i < $limit2} {incr i} {
+		lappend a $i
+		dict set b $i [expr {$i*$i}]
+	    }
+	    return [string length $a],[string length $b]
+	}} $limit2
+    }
+}} {*}$argv

tools/microoptimization/oocreate.tcl

@@ -0,0 +1,13 @@
+oo::class create foo {
+    method bar {} {
+	return abc
+    }
+}
+apply {{{iter 10000}} {
+    for {set i 0} {$i < $iter} {incr i} {
+	set obj1 [foo new]
+	set obj2 [foo create inst]
+	$obj1 destroy
+	$obj2 destroy
+    }
+}} {*}$argv

tools/microoptimization/oodispatch.tcl

@@ -0,0 +1,11 @@
+oo::class create foo {
+    method bar {} {
+	return abc
+    }
+}
+foo create inst
+apply {{{iter 100000}} {
+    for {set i 0} {$i < $iter} {incr i} {
+	inst bar
+    }
+}} {*}$argv

unix/Makefile.in

@@ -95,8 +95,8 @@ TCL_MODULE_PATH		= @TCL_MODULE_PATH@
 CFLAGS_WARNING		= @CFLAGS_WARNING@
 
 # The default switches for optimization or debugging
-CFLAGS_DEBUG		= @CFLAGS_DEBUG@
-CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@
+CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@ -DHAVE_FAST_TSD
+CFLAGS_DEBUG		= @CFLAGS_DEBUG@ $(CFLAGS_OPTIMIZE)
 
 # To change the compiler switches, for example to change from optimization to
 # debugging symbols, change the following line:
@@ -291,7 +291,7 @@ XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
 	tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o
 
 GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
-	tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
+	tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
 	tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
 	tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
 	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
@@ -390,7 +390,6 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/regfree.c \
 	$(GENERIC_DIR)/regerror.c \
 	$(GENERIC_DIR)/tclAlloc.c \
-	$(GENERIC_DIR)/tclAssembly.c \
 	$(GENERIC_DIR)/tclAsync.c \
 	$(GENERIC_DIR)/tclBasic.c \
 	$(GENERIC_DIR)/tclBinary.c \
@@ -462,7 +461,6 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclTrace.c \
 	$(GENERIC_DIR)/tclUtil.c \
 	$(GENERIC_DIR)/tclVar.c \
-	$(GENERIC_DIR)/tclAssembly.c \
 	$(GENERIC_DIR)/tclZlib.c
 
 OO_SRCS = \
@@ -1031,7 +1029,7 @@ FSHDR=$(GENERIC_DIR)/tclFileSystem.h
 IOHDR=$(GENERIC_DIR)/tclIO.h
 MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
 PARSEHDR=$(GENERIC_DIR)/tclParse.h
-NREHDR=$(GENERIC_DIR)/tclInt.h
+NREHDR=$(GENERIC_DIR)/tclNRE.h
 TRIMHDR=$(GENERIC_DIR)/tclStringTrim.h
 
 regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
@@ -1054,9 +1052,6 @@ tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
 tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c
 
-tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
-	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c
-
 tclAsync.o: $(GENERIC_DIR)/tclAsync.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c
 
@@ -1120,7 +1115,7 @@ tclEnv.o: $(GENERIC_DIR)/tclEnv.c
 tclEvent.o: $(GENERIC_DIR)/tclEvent.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c
 
-tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR)
+tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c
 
 tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c
@@ -1282,7 +1277,7 @@ tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
 tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c
 
-tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(NREHDR)
+tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c
 
 tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c $(TCLREHDRS)
@@ -1321,7 +1316,7 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c
 tclZlib.o: $(GENERIC_DIR)/tclZlib.c
 	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c
 
-tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
+tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(NREHDR)
 	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
 
 tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)

unix/tclUnixTest.c

@@ -75,6 +75,21 @@ static Tcl_CmdProc TestsetdefencdirCmd;
 static Tcl_FileProc TestFileHandlerProc;
 static void AlarmHandler(int signum);
 
+static void
+Tcl_AppendElement (
+    Tcl_Interp *interp,
+    const char *element)
+{
+    Tcl_Obj *resPtr = Tcl_GetObjResult(interp);
+
+    if (Tcl_IsShared(resPtr)) {
+        resPtr = Tcl_DuplicateObj(resPtr);
+    }
+    
+    (void) Tcl_ListObjAppendElement(interp, resPtr, Tcl_NewStringObj(element, -1));
+    Tcl_SetObjResult(interp, resPtr); 
+}
+
 /*
  *----------------------------------------------------------------------
  *

unix/tclUnixThrd.c

@@ -680,7 +680,6 @@ TclpInetNtoa(
  */
 
 #ifdef USE_THREAD_ALLOC
-static volatile int initialized = 0;
 static pthread_key_t key;
 
 typedef struct allocMutex {
@@ -727,29 +726,23 @@ TclpFreeAllocCache(
 
 	TclFreeAllocCache(ptr);
 	pthread_setspecific(key, NULL);
-
-    } else if (initialized) {
-	/*
-	 * Called by us in TclFinalizeThreadAlloc() during the library
-	 * finalization initiated from Tcl_Finalize()
-	 */
-
+	
+    } else {
 	pthread_key_delete(key);
-	initialized = 0;
     }
 }
 
+void
+TclpInitThreadAlloc(void)
+{
+    pthread_mutex_lock(allocLockPtr);
+    pthread_key_create(&key, TclpFreeAllocCache);
+    pthread_mutex_unlock(allocLockPtr);   
+}
+
 void *
 TclpGetAllocCache(void)
 {
-    if (!initialized) {
-	pthread_mutex_lock(allocLockPtr);
-	if (!initialized) {
-	    pthread_key_create(&key, TclpFreeAllocCache);
-	    initialized = 1;
-	}
-	pthread_mutex_unlock(allocLockPtr);
-    }
     return pthread_getspecific(key);
 }
 

win/tclWinThrd.c

@@ -122,7 +122,6 @@ typedef struct WinCondition {
  */
 
 #ifdef USE_THREAD_ALLOC
-static int once;
 static DWORD tlsKey;
 
 typedef struct allocMutex {
@@ -971,24 +970,24 @@ TclpFreeAllocMutex(
     free(lockPtr);
 }
 
+void
+TclpInitThreadAlloc(void)
+{
+    /*
+     * We need to make sure that TclpFreeAllocCache is called on each
+     * thread that calls this, but only on threads that call this.
+     */
+    
+    tlsKey = TlsAlloc();
+    if (tlsKey == TLS_OUT_OF_INDEXES) {
+	Tcl_Panic("could not allocate thread local storage");
+    }    
+}
+
 void *
 TclpGetAllocCache(void)
 {
     void *result;
-
-    if (!once) {
-	/*
-	 * We need to make sure that TclpFreeAllocCache is called on each
-	 * thread that calls this, but only on threads that call this.
-	 */
-
-	tlsKey = TlsAlloc();
-	once = 1;
-	if (tlsKey == TLS_OUT_OF_INDEXES) {
-	    Tcl_Panic("could not allocate thread local storage");
-	}
-    }
-
     result = TlsGetValue(tlsKey);
     if ((result == NULL) && (GetLastError() != NO_ERROR)) {
 	Tcl_Panic("TlsGetValue failed from TclpGetAllocCache");
@@ -1024,7 +1023,7 @@ TclpFreeAllocCache(
 	if (!success) {
 	    Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache");
 	}
-    } else if (once) {
+    } else {
 	/*
 	 * Called by us in TclFinalizeThreadAlloc() during the library
 	 * finalization initiated from Tcl_Finalize()
@@ -1034,9 +1033,7 @@ TclpFreeAllocCache(
 	if (!success) {
 	    Tcl_Panic("TlsFree failed from TclpFreeAllocCache");
 	}
-	once = 0; /* reset for next time. */
     }
-
 }
 #endif /* USE_THREAD_ALLOC */