From c509f61617b25dc0e12c07ca27b5b44bce13cb5f Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 9 Jan 2013 14:00:15 +0000
Subject: [Bug 3599395]: http assumes status line is a proper tcl list. Bump
 http package to 2.7.11.

---
 ChangeLog                 | 8 +++++++-
 library/http/http.tcl     | 4 ++--
 library/http/pkgIndex.tcl | 2 +-
 unix/Makefile.in          | 4 ++--
 win/Makefile.in           | 4 ++--
 5 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5a025f9..e1373fb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,14 @@
+2013-01-09  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* library/http/http.tcl: [Bug 3599395]: http assumes status line
+	is a proper tcl list.
+	Bump http package to 2.7.11.
+
 2013-01-08  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path
 	components.	[Bug 3587096] win vista/7: "can't find init.tcl" when
-	called via junction.
+	called via junction without folder list access.
 
 2013-01-07  Jan Nijtmans  <nijtmans@users.sf.net>
 
diff --git a/library/http/http.tcl b/library/http/http.tcl
index fa0425d..6b82894 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
 package require Tcl 8.4
 # Keep this in sync with pkgIndex.tcl and with the install directories in
 # Makefiles
-package provide http 2.7.10
+package provide http 2.7.11
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -974,7 +974,7 @@ proc http::Event {sock token} {
 	} elseif {$n == 0} {
 	    # We have now read all headers
 	    # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
-	    if {$state(http) == "" || [lindex $state(http) 1] == 100} {
+	    if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {
 		return
 	    }
 
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 0b5cdeb..73b2f36 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,4 +1,4 @@
 # Tcl package index file, version 1.1
 
 if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.7.10 [list tclPkgSetup $dir http 2.7.10 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.7.11 [list tclPkgSetup $dir http 2.7.11 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index e43c252..3daad96 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -766,8 +766,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
 	    done;
-	@echo "Installing package http 2.7.10 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.10.tm;
+	@echo "Installing package http 2.7.11 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.11.tm;
 	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
 	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
 	    do \
diff --git a/win/Makefile.in b/win/Makefile.in
index 4949c70..23f5a2b 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -637,8 +637,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
 	    done;
-	@echo "Installing package http 2.7.10 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.10.tm;
+	@echo "Installing package http 2.7.11 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.11.tm;
 	@echo "Installing library opt0.4 directory";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
 	    do \
-- 
cgit v0.12


From 68785b10799b118a4e44507477861cd574526f17 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 9 Jan 2013 17:32:56 +0000
Subject: more NRE abstraction

---
 generic/tclBasic.c    | 68 +++++++++++++++++++++++++++++++++++++--------------
 generic/tclCompExpr.c |  4 +--
 generic/tclCompile.c  |  7 +++---
 generic/tclExecute.c  |  4 +--
 generic/tclInt.decls  |  3 +--
 generic/tclInt.h      |  3 ++-
 generic/tclIntDecls.h |  5 ++--
 7 files changed, 62 insertions(+), 32 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d931297..9e29e9b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -134,6 +134,10 @@ static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
 static Tcl_NRPostProc	NRCoroutineCallerCallback;
 static Tcl_NRPostProc	NRCoroutineExitCallback;
 static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
+static int NRRoot(ClientData data[], Tcl_Interp *interp, int result);
+#if !NRE_STACK_DEBUG
+static Tcl_NRPostProc NRStackBottom;
+#endif
 
 static Tcl_NRPostProc	NRRunObjProc;
 static Tcl_ObjCmdProc	OldMathFuncProc;
@@ -4134,10 +4138,10 @@ Tcl_EvalObjv(
 				 * TCL_EVAL_NOERR are currently supported. */
 {
     int result;
-    NRE_callback *rootPtr = TOP_CB(interp);
 
+    TclNRSetRoot(interp);
     result = TclNREvalObjv(interp, objc, objv, flags, NULL);
-    return TclNRRunCallbacks(interp, result, rootPtr);
+    return TclNRRunCallbacks(interp, result);
 }
 
 int
@@ -4327,10 +4331,7 @@ TclPushTailcallPoint(
 int
 TclNRRunCallbacks(
     Tcl_Interp *interp,
-    int result,
-    struct NRE_callback *rootPtr)
-				/* All callbacks down to rootPtr not inclusive
-				 * are to be run. */
+    int result) 	/* Callbacks are run until the first NRRoot.*/
 {
     Interp *iPtr = (Interp *) interp;
     NRE_callback *cbPtr;
@@ -4350,12 +4351,43 @@ TclNRRunCallbacks(
 	(void) Tcl_GetObjResult(interp);
     }
 
-    while (TOP_CB(interp) != rootPtr) {
+    while (TOP_CB(interp) && (TOP_CB(interp)->procPtr != NRRoot)) {
 	POP_CB(interp, cbPtr);
 	procPtr = cbPtr->procPtr;
 	result = procPtr(cbPtr->data, interp, result);
 	FREE_CB(interp, cbPtr);
     }
+    if (TOP_CB(interp)) {
+	POP_CB(interp, cbPtr);
+        FREE_CB(interp, cbPtr);
+    }
+    return result;
+}
+
+void
+TclNRSetRoot(
+    Tcl_Interp *interp)
+{
+#if NRE_STACK_DEBUG
+    int first = (TOP_CB(interp) == NULL);
+#else
+    int first = ((TOP_CB(interp) == NULL) ||
+            ((TOP_CB(interp)->procPtr == NRStackBottom) &&
+                    (TOP_CB(interp)->data[0] == NULL)));
+#endif
+    
+    if (!first) {
+        TclNRAddCallback(interp, NRRoot, NULL, NULL, NULL, NULL);
+    }
+}
+
+static int
+NRRoot(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    /* NOT CALLED */
     return result;
 }
 
@@ -5929,10 +5961,10 @@ TclEvalObjEx(
     int word)			/* Index of the word which is in objPtr. */
 {
     int result = TCL_OK;
-    NRE_callback *rootPtr = TOP_CB(interp);
 
+    TclNRSetRoot(interp);
     result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
-    return TclNRRunCallbacks(interp, result, rootPtr);
+    return TclNRRunCallbacks(interp, result);
 }
 
 int
@@ -8132,8 +8164,6 @@ Tcl_NRCallObjProc(
     Tcl_Obj *const objv[])
 {
     int result = TCL_OK;
-    NRE_callback *rootPtr = TOP_CB(interp);
-
 #ifdef USE_DTRACE
     if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
 	const char *a[10];
@@ -8162,8 +8192,10 @@ Tcl_NRCallObjProc(
 		(Tcl_Obj **)(objv + 1));
     }
 #endif /* USE_DTRACE */
+
+    TclNRSetRoot(interp);
     result = objProc(clientData, interp, objc, objv);
-    return TclNRRunCallbacks(interp, result, rootPtr);
+    return TclNRRunCallbacks(interp, result);
 }
 
 /*
@@ -8296,8 +8328,8 @@ TclDeferCallbacks(
 }
 
 #if !NRE_STACK_DEBUG
-int
-TclNRStackBottom(
+static int
+NRStackBottom(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
@@ -8364,7 +8396,7 @@ TclNewCallback(
     }
     eePtr->NRStack = this;
     eePtr->callbackPtr = &this->items[-1];
-    TclNRAddCallback(interp, TclNRStackBottom, orig, NULL, NULL, NULL);
+    TclNRAddCallback(interp, NRStackBottom, orig, NULL, NULL, NULL);
 
     NRE_ASSERT(eePtr->callbackPtr == &this->items[0]);
 
@@ -8383,7 +8415,7 @@ TclNextCallback(
     NRE_callback *cbPtr)
 {
 
-    if (cbPtr->procPtr == TclNRStackBottom) {
+    if (cbPtr->procPtr == NRStackBottom) {
         NRE_stack *prev = cbPtr->data[0];
 
         if (!prev) {
@@ -8700,10 +8732,10 @@ DeleteCoroutine(
 {
     CoroutineData *corPtr = clientData;
     Tcl_Interp *interp = corPtr->eePtr->interp;
-    NRE_callback *rootPtr = TOP_CB(interp);
 
     if (COR_IS_SUSPENDED(corPtr)) {
-	TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
+        TclNRSetRoot(interp);
+	TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK));
     }
 }
 
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 890d518..838bdc0 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2190,7 +2190,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
@@ -2198,6 +2197,7 @@ 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);
     CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
@@ -2209,7 +2209,7 @@ ExecConstantExprTree(
     TclStackFree(interp, envPtr);
     byteCodePtr = byteCodeObj->internalRep.otherValuePtr;
     TclNRExecuteByteCode(interp, byteCodePtr);
-    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+    code = TclNRRunCallbacks(interp, TCL_OK);
     Tcl_DecrRefCount(byteCodeObj);
     return code;
 }
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 45a74d7..b022892 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1044,10 +1044,9 @@ Tcl_SubstObj(
     Tcl_Obj *objPtr,		/* The value to be substituted. */
     int flags)			/* What substitutions to do. */
 {
-    NRE_callback *rootPtr = TOP_CB(interp);
-
-    if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags),
-	    rootPtr) != TCL_OK) {
+    TclNRSetRoot(interp);
+    if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags))
+	    != TCL_OK) {
 	return NULL;
     }
     return Tcl_GetObjResult(interp);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 61ad12d..015a4f8 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1362,14 +1362,14 @@ Tcl_ExprObj(
     Tcl_Obj **resultPtrPtr)	/* Where the Tcl_Obj* that is the expression
 				 * result is stored if no errors occur. */
 {
-    NRE_callback *rootPtr = TOP_CB(interp);
     Tcl_Obj *resultPtr;
 
+    TclNRSetRoot(interp);
     TclNewObj(resultPtr);
     TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr,
 	    NULL, NULL);
     Tcl_NRExprObj(interp, objPtr, resultPtr);
-    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
+    return TclNRRunCallbacks(interp, TCL_OK);
 }
 
 static int
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f215d32..035db00 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -961,8 +961,7 @@ 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,
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 177765e..bf5859d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4783,6 +4783,8 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
 
 #define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
 
+void TclNRSetRoot(Tcl_Interp *interp);
+
 /*
  * Inline versions of Tcl_NRAddCallback and friends
  */
@@ -4865,7 +4867,6 @@ typedef struct NRE_stack {
 MODULE_SCOPE NRE_callback *TclNewCallback(Tcl_Interp *interp);
 MODULE_SCOPE NRE_callback *TclPopCallback(Tcl_Interp *interp);
 MODULE_SCOPE NRE_callback *TclNextCallback(NRE_callback *ptr);
-MODULE_SCOPE Tcl_NRPostProc TclNRStackBottom;
 
 #endif
 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index df5ac97..d49d2d0 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -569,8 +569,7 @@ 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);
@@ -846,7 +845,7 @@ typedef struct TclIntStubs {
     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 (*tclNRRunCallbacks) (Tcl_Interp *interp, int result); /* 240 */
     int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
     int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
     void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
-- 
cgit v0.12


From 5267c0dbcc4292b8455f2d4fb3d9b08da0a8ebc2 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 10 Jan 2013 00:54:53 +0000
Subject: more info hiding: stop using the macro version of NRAddCallback

---
 generic/tclCmdAH.c    | 28 ++++++++++++++--------------
 generic/tclCmdMZ.c    |  2 +-
 generic/tclDictObj.c  | 12 ++++++------
 generic/tclEnsemble.c |  2 +-
 generic/tclExecute.c  | 14 +++++---------
 generic/tclIOUtil.c   |  2 +-
 generic/tclInt.h      |  1 +
 generic/tclInterp.c   |  2 +-
 generic/tclNamesp.c   |  4 ++--
 generic/tclOO.c       |  6 +++---
 generic/tclOOBasic.c  | 14 +++++++-------
 generic/tclOOCall.c   |  6 +++---
 generic/tclOOMethod.c |  2 +-
 generic/tclProc.c     |  6 +++---
 14 files changed, 49 insertions(+), 52 deletions(-)

diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index eb2a303..1cf4161 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -318,7 +318,7 @@ TclNRCatchObjCmd(
 	optionVarNamePtr = objv[3];
     }
 
-    TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
+    Tcl_NRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
 	    varNamePtr, optionVarNamePtr, NULL);
 
     /*
@@ -790,7 +790,7 @@ TclNREvalObjCmd(
 
 	objPtr = Tcl_ConcatObj(objc-1, objv+1);
     }
-    TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
     return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
 
@@ -889,10 +889,10 @@ TclNRExprObjCmd(
     Tcl_IncrRefCount(resultPtr);
     if (objc == 2) {
 	objPtr = objv[1];
-	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
+	Tcl_NRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
     } else {
 	objPtr = Tcl_ConcatObj(objc-1, objv+1);
-	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
+	Tcl_NRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
     }
 
     return Tcl_NRExprObj(interp, objPtr, resultPtr);
@@ -2423,7 +2423,7 @@ TclNRForObjCmd(
     iterPtr->msg  = "\n    (\"for\" body line %d)";
     iterPtr->word = 4;
 
-    TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);
 
     /*
      * TIP #280. Make invoking context available to initial script.
@@ -2447,7 +2447,7 @@ ForSetupCallback(
 	TclSmallFreeEx(interp, iterPtr);
 	return result;
     }
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
     return TCL_OK;
 }
 
@@ -2471,7 +2471,7 @@ TclNRForIterCallback(
 
 	Tcl_ResetResult(interp);
 	TclNewObj(boolObj);
-	TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL,
+	Tcl_NRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL,
 		NULL);
 	return Tcl_NRExprObj(interp, iterPtr->cond, boolObj);
     case TCL_BREAK:
@@ -2511,10 +2511,10 @@ ForCondCallback(
     if (value) {
 	/* TIP #280. */
 	if (iterPtr->next) {
-	    TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
+	    Tcl_NRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
 		    NULL);
 	} else {
-	    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
+	    Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
 		    NULL, NULL);
 	}
 	return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
@@ -2535,7 +2535,7 @@ ForNextCallback(
     Tcl_Obj *next = iterPtr->next;
 
     if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
-	TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
+	Tcl_NRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
 		NULL);
 
 	/*
@@ -2545,7 +2545,7 @@ ForNextCallback(
 	return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3);
     }
 
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
     return result;
 }
 
@@ -2564,7 +2564,7 @@ ForPostNextCallback(
 	}
 	return result;
     }
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
     return result;
 }
 
@@ -2735,7 +2735,7 @@ EachloopCmd(
 	    goto done;
 	}
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+	Tcl_NRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
 	return TclNREvalObjEx(interp, objv[objc-1], 0,
 		((Interp *) interp)->cmdFramePtr, objc-1);
     }
@@ -2801,7 +2801,7 @@ ForeachLoopStep(
 	    goto done;
 	}
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+	Tcl_NRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
 	return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
 		((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
     }
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 95debf8..bdcd80b 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4756,7 +4756,7 @@ TclNRWhileObjCmd(
     iterPtr->msg  = "\n    (\"while\" body line %d)";
     iterPtr->word = 2;
 
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
+    Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
 	    NULL, NULL);
     return TCL_OK;
 }
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 170e744..fc61642 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -2445,7 +2445,7 @@ DictForNRCmd(
      * Run the script.
      */
 
-    TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+    Tcl_NRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
 	    valueVarObj, scriptObj);
     return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
 
@@ -2527,7 +2527,7 @@ DictForLoopCallback(
      * Run the script.
      */
 
-    TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+    Tcl_NRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
 	    valueVarObj, scriptObj);
     return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
 
@@ -2647,7 +2647,7 @@ DictMapNRCmd(
      * Run the script.
      */
 
-    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
+    Tcl_NRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
     return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
 	    iPtr->cmdFramePtr, 3);
 
@@ -2737,7 +2737,7 @@ DictMapLoopCallback(
      * Run the script.
      */
 
-    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
+    Tcl_NRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
     return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
 	    iPtr->cmdFramePtr, 3);
 
@@ -3228,7 +3228,7 @@ DictUpdateCmd(
     objPtr = Tcl_NewListObj(objc-3, objv+2);
     Tcl_IncrRefCount(objPtr);
     Tcl_IncrRefCount(objv[1]);
-    TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
+    Tcl_NRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
 
     return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
 }
@@ -3379,7 +3379,7 @@ DictWithCmd(
 	Tcl_IncrRefCount(pathPtr);
     }
     Tcl_IncrRefCount(objv[1]);
-    TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
+    Tcl_NRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
 	    NULL);
 
     return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 9a2d598..6f0fca2 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1895,7 +1895,7 @@ NsEnsembleImplementationCmdNR(
 		    2 + ensemblePtr->numParameters;
 	    iPtr->ensembleRewrite.numInsertedObjs =
 		    prefixObjc + ensemblePtr->numParameters;
-	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
+	    Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
 		    NULL);
 	} else {
 	    register int ni = 2 + ensemblePtr->numParameters
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 015a4f8..a69b06e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -21,10 +21,6 @@
 #include "tommath.h"
 #include <math.h>
 
-#if NRE_ENABLE_ASSERTS
-#include <assert.h>
-#endif
-
 /*
  * Hack to determine whether we may expect IEEE floating point. The hack is
  * formally incorrect in that non-IEEE platforms might have the same precision
@@ -190,7 +186,7 @@ typedef struct TEBCdata {
 	esPtr->tosPtr = tosPtr;						\
 	TD->pc = pc;							\
 	TD->cleanup = cleanup;						\
-	TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
+	Tcl_NRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
     } while (0)
 
 #define TEBC_DATA_DIG() \
@@ -1366,7 +1362,7 @@ Tcl_ExprObj(
 
     TclNRSetRoot(interp);
     TclNewObj(resultPtr);
-    TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr,
+    Tcl_NRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr,
 	    NULL, NULL);
     Tcl_NRExprObj(interp, objPtr, resultPtr);
     return TclNRRunCallbacks(interp, TCL_OK);
@@ -2016,7 +2012,7 @@ TclNRExecuteByteCode(
      * Push the callback for bytecode execution
      */
 
-    TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
+    Tcl_NRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
 	    NULL, NULL);
     return TCL_OK;
 }
@@ -2391,7 +2387,7 @@ TEBCresume(
 	TEBC_YIELD();
 	
 	Tcl_SetObjResult(interp, OBJ_AT_TOS);
-	TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+	Tcl_NRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
 		INT2PTR(0), NULL, NULL);
 
 	return TCL_OK;
@@ -3044,7 +3040,7 @@ TEBCresume(
 	DECACHE_STACK_INFO();
 	pc += 6;
 	TEBC_YIELD();
-	TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
+	Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
 	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
 	return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
 
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index ab08353..fdbc684 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1945,7 +1945,7 @@ TclNREvalFile(
      */
 
     iPtr->evalFlags |= TCL_EVAL_FILE;
-    TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
+    Tcl_NRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
 	    NULL);
     return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
 }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index bf5859d..93e5354 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4871,6 +4871,7 @@ MODULE_SCOPE NRE_callback *TclNextCallback(NRE_callback *ptr);
 #endif
 
 #if NRE_ENABLE_ASSERTS
+#include <assert.h>
 #define NRE_ASSERT(expr) assert((expr))
 #else
 #define NRE_ASSERT(expr)
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 5dd24c7..9406555 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1799,7 +1799,7 @@ AliasNRCmd(
 
     if (isRootEnsemble) {
 	TclDeferCallbacks(interp);
-	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+	Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
     }
     iPtr->evalFlags |= TCL_EVAL_REDIRECT;
     return Tcl_NREvalObj(interp, listPtr, flags);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index d3cd3e1..0bd82b9 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -3318,7 +3318,7 @@ NRNamespaceEvalCmd(
      * TIP #280: Make invoking context available to eval'd script.
      */
 
-    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
+    Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
 	    NULL, NULL);
     return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
@@ -3783,7 +3783,7 @@ NRNamespaceInscopeCmd(
 	Tcl_DecrRefCount(listPtr);    /* We're done with the list object. */
     }
 
-    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
+    Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
 	    NULL, NULL);
     return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
 }
diff --git a/generic/tclOO.c b/generic/tclOO.c
index d6d2d6a..e7071ec 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1774,7 +1774,7 @@ TclNRNewObjectInstance(
      */
 
     AddRef(oPtr);
-    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
+    Tcl_NRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
 	    objectPtr);
     TclPushTailcallPoint(interp);
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
@@ -2578,7 +2578,7 @@ TclOOObjectCmdCore(
      * for the duration.
      */
 
-    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
+    Tcl_NRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
 }
 
@@ -2731,7 +2731,7 @@ TclNRObjectContextInvokeNext(
      * all) come through the same code.
      */
 
-    TclNRAddCallback(interp, FinalizeNext, contextPtr,
+    Tcl_NRAddCallback(interp, FinalizeNext, contextPtr,
 	    INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL);
     contextPtr->index++;
     contextPtr->skip = skip;
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 0676618..f9e1c1d 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -33,7 +33,7 @@ static int		RestoreFrame(ClientData data[],
  *
  * AddCreateCallback, FinalizeConstruction --
  *
- *	Special version of TclNRAddCallback that allows the caller to splice
+ *	Special version of Tcl_NRAddCallback that allows the caller to splice
  *	the object created later on. Always calls FinalizeConstruction, which
  *	converts the object into its name and stores that in the interpreter
  *	result. This is shared by all the construction methods (create,
@@ -50,7 +50,7 @@ static inline Tcl_Object *
 AddConstructionFinalizer(
     Tcl_Interp *interp)
 {
-    TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
     return (Tcl_Object *) &(TOP_CB(interp)->data[0]);
 }
 
@@ -114,7 +114,7 @@ TclOO_Class_Constructor(
     Tcl_IncrRefCount(invoke[0]);
     Tcl_IncrRefCount(invoke[1]);
     Tcl_IncrRefCount(invoke[2]);
-    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
+    Tcl_NRAddCallback(interp, DecrRefsPostClassConstructor,
 	    invoke[0], invoke[1], invoke[2], NULL);
 
     /*
@@ -352,7 +352,7 @@ TclOO_Object_Destroy(
 	if (contextPtr != NULL) {
 	    contextPtr->callPtr->flags |= DESTRUCTOR;
 	    contextPtr->skip = 0;
-	    TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
+	    Tcl_NRAddCallback(interp, AfterNRDestructor, contextPtr,
 		    NULL, NULL, NULL);
 	    TclPushTailcallPoint(interp);
 	    return TclOOInvokeContext(contextPtr, interp, 0, NULL);
@@ -450,7 +450,7 @@ TclOO_Object_Eval(
      * the script completes.
      */
 
-    TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
     return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
 }
 
@@ -805,7 +805,7 @@ TclOONextObjCmd(
      * that this is like [uplevel 1] and not [eval].
      */
 
-    TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
+    Tcl_NRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
     iPtr->varFramePtr = framePtr->callerVarPtr;
     return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
 }
@@ -874,7 +874,7 @@ TclOONextToObjCmd(
 	     * context. Note that this is like [uplevel 1] and not [eval].
 	     */
 
-	    TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
+	    Tcl_NRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
 		    INT2PTR(contextPtr->index), NULL);
 	    contextPtr->index = i-1;
 	    iPtr->varFramePtr = framePtr->callerVarPtr;
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index a79e4fa..88a5bd9 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -278,7 +278,7 @@ TclOOInvokeContext(
 	 * this call is finished.
 	 */
 
-	TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
+	Tcl_NRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
 		NULL);
     }
 
@@ -287,9 +287,9 @@ TclOOInvokeContext(
      */
 
     if (contextPtr->oPtr->flags & FILTER_HANDLING) {
-	TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
+	Tcl_NRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
     } else {
-	TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
+	Tcl_NRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
     }
     if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
 	contextPtr->oPtr->flags |= FILTER_HANDLING;
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 28820e0..1c63216 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -732,7 +732,7 @@ InvokeProcedureMethod(
      * Now invoke the body of the method.
      */
 
-    TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
+    Tcl_NRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
     return TclNRInterpProcCore(interp, fdPtr->nameObj,
 	    Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
 }
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 933e7d2..f5fdf4f 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1022,7 +1022,7 @@ TclNRUplevelObjCmd(
 	objPtr = Tcl_ConcatObj(objc, objv);
     }
 
-    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
+    Tcl_NRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
 	    NULL);
     return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
@@ -1835,7 +1835,7 @@ TclNRInterpProcCore(
     procPtr->refCount++;
     codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
 
-    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
+    Tcl_NRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
 	    NULL, NULL);
     return TclNRExecuteByteCode(interp, codePtr);
 }
@@ -2787,7 +2787,7 @@ TclNRApplyObjCmd(
 
     result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
     if (result == TCL_OK) {
-	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
+	Tcl_NRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
 	result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
     }
     return result;
-- 
cgit v0.12


From d228ad32f1d32b0a3c4d1d3d4dac5828caeee738 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 10 Jan 2013 02:29:39 +0000
Subject: code reorg, trying to make it clearer who needs to know what about
 NRE internals

---
 generic/tclBasic.c   |   5 +--
 generic/tclInt.h     | 103 +++++----------------------------------------------
 generic/tclOOBasic.c |   2 +
 generic/tclTest.c    |   1 +
 unix/Makefile.in     |   8 ++--
 5 files changed, 18 insertions(+), 101 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9e29e9b..640fdc1 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -22,10 +22,7 @@
 #include "tclCompile.h"
 #include "tommath.h"
 #include <math.h>
-
-#if NRE_ENABLE_ASSERTS
-#include <assert.h>
-#endif
+#include "tclNRE.h"
 
 #define INTERP_STACK_INITIAL_SIZE 2000
 #define CORO_STACK_INITIAL_SIZE    200
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 93e5354..831db9f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4771,111 +4771,28 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
  */
 
 #define NRE_ENABLE_ASSERTS	1
-#define NRE_STACK_DEBUG         0
-#define NRE_STACK_SIZE        100
 
-
-/*
- * 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.
- */
-
-#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
+#if NRE_ENABLE_ASSERTS
+#include <assert.h>
+#define NRE_ASSERT(expr) assert((expr))
+#else
+#define NRE_ASSERT(expr)
+#endif
 
 void TclNRSetRoot(Tcl_Interp *interp);
 
-/*
- * Inline versions of Tcl_NRAddCallback and friends
- */
-
-#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3)	\
-    do {								\
-	NRE_callback *cbPtr;						\
-	ALLOC_CB(interp, cbPtr);					\
-	INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3);		\
-    } while (0)
-
-#define INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3)		\
-    do {								\
-	cbPtr->procPtr = (postProcPtr);					\
-	cbPtr->data[0] = (ClientData)(data0);				\
-	cbPtr->data[1] = (ClientData)(data1);				\
-	cbPtr->data[2] = (ClientData)(data2);				\
-	cbPtr->data[3] = (ClientData)(data3);				\
-    } while (0)
-
-#if NRE_STACK_DEBUG
-
-typedef struct NRE_callback {
-    Tcl_NRPostProc *procPtr;
-    ClientData data[4];
-    struct NRE_callback *nextPtr;
-} NRE_callback;
-
-#define POP_CB(interp, cbPtr)                      \
-    do {                                           \
-        cbPtr = TOP_CB(interp);                    \
-        TOP_CB(interp) = cbPtr->nextPtr;           \
-    } while (0)
-
-#define ALLOC_CB(interp, cbPtr)			\
-    do {					\
-	cbPtr = ckalloc(sizeof(NRE_callback));	\
-	cbPtr->nextPtr = TOP_CB(interp);	\
-	TOP_CB(interp) = cbPtr;			\
-    } while (0)
-    
-#define FREE_CB(interp, ptr)			\
-    ckfree((char *) (ptr))
-
-#define NEXT_CB(ptr)  (ptr)->nextPtr
+/* NOTE: this just needed by tclOOBasic.c for a legit operation that deserves
+ * a better API */
 
-#else /* not debugging the NRE stack */
+#ifdef USE_TOP_CB
+#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
 
 typedef struct NRE_callback {
     Tcl_NRPostProc *procPtr;
     ClientData data[4];
-    struct NRE_callback *nextPtr;
 } NRE_callback;
-
-typedef struct NRE_stack {
-    struct NRE_callback items[NRE_STACK_SIZE];
-    struct NRE_stack *next;
-} NRE_stack;
-
-#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[NRE_STACK_SIZE-1])) { \
-	    (cbPtr) = ++eePtr->callbackPtr;				\
-	} else {							\
-	    (cbPtr) = TclNewCallback(interp);				\
-	}								\
-    } while (0)
-
-#define FREE_CB(interp, cbPtr)
-
-#define NEXT_CB(ptr) TclNextCallback(ptr)
-
-MODULE_SCOPE NRE_callback *TclNewCallback(Tcl_Interp *interp);
-MODULE_SCOPE NRE_callback *TclPopCallback(Tcl_Interp *interp);
-MODULE_SCOPE NRE_callback *TclNextCallback(NRE_callback *ptr);
-
 #endif
 
-#if NRE_ENABLE_ASSERTS
-#include <assert.h>
-#define NRE_ASSERT(expr) assert((expr))
-#else
-#define NRE_ASSERT(expr)
-#endif
 
 #include "tclIntDecls.h"
 #include "tclIntPlatDecls.h"
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index f9e1c1d..5f45c2d 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -13,6 +13,8 @@
 #ifdef HAVE_CONFIG_H
 #include "config.h"
 #endif
+
+#define USE_TOP_CB 1
 #include "tclInt.h"
 #include "tclOOInt.h"
 
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b385e25..241057d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -22,6 +22,7 @@
 #include "tclInt.h"
 #include "tclOO.h"
 #include <math.h>
+#include "tclNRE.h"
 
 /*
  * Required for Testregexp*Cmd
diff --git a/unix/Makefile.in b/unix/Makefile.in
index ee31282..cc7f42f 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1001,7 +1001,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
 
 regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
 		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
@@ -1083,7 +1083,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
@@ -1242,7 +1242,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)
@@ -1281,7 +1281,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)
-- 
cgit v0.12


From e97463a0fb4ada0093dbe69808351b2ccb643c6d Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 10 Jan 2013 02:32:21 +0000
Subject: adding new file, forgotten in last commit

---
 generic/tclNRE.h | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)
 create mode 100644 generic/tclNRE.h

diff --git a/generic/tclNRE.h b/generic/tclNRE.h
new file mode 100644
index 0000000..d740105
--- /dev/null
+++ b/generic/tclNRE.h
@@ -0,0 +1,100 @@
+/* **********************************************
+ * NRE internals   
+ * **********************************************
+ */
+
+#define NRE_STACK_DEBUG         0
+#define NRE_STACK_SIZE        100
+
+
+/*
+ * 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.
+ */
+
+/*
+ * Inline versions of Tcl_NRAddCallback and friends
+ */
+
+#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
+
+#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3)	\
+    do {								\
+	NRE_callback *cbPtr;						\
+	ALLOC_CB(interp, cbPtr);					\
+	INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3);		\
+    } while (0)
+
+#define INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3)		\
+    do {								\
+	cbPtr->procPtr = (postProcPtr);					\
+	cbPtr->data[0] = (ClientData)(data0);				\
+	cbPtr->data[1] = (ClientData)(data1);				\
+	cbPtr->data[2] = (ClientData)(data2);				\
+	cbPtr->data[3] = (ClientData)(data3);				\
+    } while (0)
+
+#if NRE_STACK_DEBUG
+
+typedef struct NRE_callback {
+    Tcl_NRPostProc *procPtr;
+    ClientData data[4];
+    struct NRE_callback *nextPtr;
+} NRE_callback;
+
+#define POP_CB(interp, cbPtr)                      \
+    do {                                           \
+        cbPtr = TOP_CB(interp);                    \
+        TOP_CB(interp) = cbPtr->nextPtr;           \
+    } while (0)
+
+#define ALLOC_CB(interp, cbPtr)			\
+    do {					\
+	cbPtr = ckalloc(sizeof(NRE_callback));	\
+	cbPtr->nextPtr = TOP_CB(interp);	\
+	TOP_CB(interp) = cbPtr;			\
+    } while (0)
+    
+#define FREE_CB(interp, ptr)			\
+    ckfree((char *) (ptr))
+
+#define NEXT_CB(ptr)  (ptr)->nextPtr
+
+#else /* not debugging the NRE stack */
+
+typedef struct NRE_callback {
+    Tcl_NRPostProc *procPtr;
+    ClientData data[4];
+} NRE_callback;
+
+typedef struct NRE_stack {
+    struct NRE_callback items[NRE_STACK_SIZE];
+    struct NRE_stack *next;
+} NRE_stack;
+
+#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[NRE_STACK_SIZE-1])) { \
+	    (cbPtr) = ++eePtr->callbackPtr;				\
+	} else {							\
+	    (cbPtr) = TclNewCallback(interp);				\
+	}								\
+    } while (0)
+
+#define FREE_CB(interp, cbPtr)
+
+#define NEXT_CB(ptr) TclNextCallback(ptr)
+
+MODULE_SCOPE NRE_callback *TclNewCallback(Tcl_Interp *interp);
+MODULE_SCOPE NRE_callback *TclPopCallback(Tcl_Interp *interp);
+MODULE_SCOPE NRE_callback *TclNextCallback(NRE_callback *ptr);
+
+#endif
-- 
cgit v0.12


From 41c09d7b4d37c2b2fc7cec61aaaa3ca59a56a7c5 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 10 Jan 2013 18:17:33 +0000
Subject: fix off-by-one error introduced in bd7d7a2061

---
 generic/tclExecute.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8759ec9..ade71f6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1089,7 +1089,7 @@ GrowEvaluationStack(
     if (move) {
 	moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
     }
-    needed = growth + moveWords + WALLOCALIGN - 1;
+    needed = growth + moveWords + WALLOCALIGN;
 
     
     /*
-- 
cgit v0.12


From 4b98ee238e6233c06010badf783f08d816929ae9 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 10 Jan 2013 20:43:44 +0000
Subject: tailcall now running in a simpler model, with no eval-flags and no
 nre-stack rewriting.

---
 generic/tclBasic.c    | 22 ++++++++++------------
 generic/tclEnsemble.c |  4 ++--
 generic/tclExecute.c  |  2 +-
 generic/tclInt.h      |  3 +--
 generic/tclInterp.c   |  3 +--
 generic/tclNamesp.c   |  2 +-
 6 files changed, 16 insertions(+), 20 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 640fdc1..a23a034 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4183,11 +4183,6 @@ TclNREvalObjv(
     }
     cmdPtrPtr = (Command **) &(callbackPtr->data[0]);
 
-
-    if (iPtr->evalFlags & TCL_EVAL_REDIRECT) {
-        callbackPtr->data[1] = INT2PTR(1);
-        iPtr->evalFlags &= ~TCL_EVAL_REDIRECT;
-    }
     callbackPtr->data[2] = INT2PTR(objc);
     callbackPtr->data[3] = (ClientData) objv;
 
@@ -4667,10 +4662,9 @@ TEOV_NotFound(
 	savedNsPtr = varFramePtr->nsPtr;
 	varFramePtr->nsPtr = lookupNsPtr;
     }
-    TclDeferCallbacks(interp);
+    TclDeferCallbacks(interp, 1);
     TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
 	    newObjv, savedNsPtr, NULL);
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
     return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
 }
 
@@ -6055,7 +6049,7 @@ TclNREvalObjEx(
 	    iPtr->cmdFramePtr = eoFramePtr;
 	}
 
-	TclDeferCallbacks(interp);
+	TclDeferCallbacks(interp, 0);
         TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
 		NULL, NULL);
 
@@ -8314,14 +8308,18 @@ Tcl_NRCmdSwap(
 
 void
 TclDeferCallbacks(
-    Tcl_Interp *interp)
+    Tcl_Interp *interp,
+    int skipTailcall)
 {
     Interp *iPtr = (Interp *) interp;
+    void *skip = INT2PTR(skipTailcall != 0);
 
     if (iPtr->deferredCallbacks == NULL) {
-	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+	TclNRAddCallback(interp, NRCommand, NULL, skip, NULL, NULL);
         iPtr->deferredCallbacks = TOP_CB(interp);
-    }
+    } else if (skipTailcall) {
+        iPtr->deferredCallbacks->data[1] = skip;
+    }        
 }
 
 #if !NRE_STACK_DEBUG
@@ -8549,7 +8547,7 @@ TclNRTailcallEval(
      * Perform the tailcall
      */
 
-    TclDeferCallbacks(interp);
+    TclDeferCallbacks(interp, 0);
     TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
     iPtr->lookupNsPtr = (Namespace *) nsPtr;
     return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 6f0fca2..b42bc9c 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1914,7 +1914,7 @@ NsEnsembleImplementationCmdNR(
 	 * Hand off to the target command.
 	 */
 
-	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+	TclDeferCallbacks(interp, /* skipTailcall */ 1);
 	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
     }
 
@@ -2122,7 +2122,7 @@ EnsembleUnknownCallback(
      */
 
     Tcl_Preserve(ensemblePtr);
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
+    TclDeferCallbacks(interp, /* skipTailcall */ 1);
     result = Tcl_EvalObjv(interp, paramc, paramv, 0);
     if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
 	if (!Tcl_InterpDeleted(interp)) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 87427cf..327b117 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3041,7 +3041,7 @@ TEBCresume(
 	pc += 6;
 	TEBC_YIELD();
 	Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
-	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+	TclDeferCallbacks(interp, /* skipTailcall */ 1);
 	return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
 
     /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 831db9f..526699c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2246,7 +2246,6 @@ typedef struct InterpList {
 #define TCL_ALLOW_EXCEPTIONS	4
 #define TCL_EVAL_FILE		2
 #define TCL_EVAL_CTX		8
-#define TCL_EVAL_REDIRECT	16
 
 /*
  * Flag bits for Interp structures:
@@ -2802,7 +2801,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
 
 MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
-MODULE_SCOPE void  TclDeferCallbacks(Tcl_Interp *interp);
+MODULE_SCOPE void  TclDeferCallbacks(Tcl_Interp *interp, int skipTailcall);
 
 /*
  * This structure holds the data for the various iteration callbacks used to
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 9406555..cd58bf8 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1797,11 +1797,10 @@ AliasNRCmd(
      * stuff ...
      */
 
+    TclDeferCallbacks(interp, /* skipTailcall */ 1);
     if (isRootEnsemble) {
-	TclDeferCallbacks(interp);
 	Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
     }
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
     return Tcl_NREvalObj(interp, listPtr, flags);
 }
 
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 0bd82b9..a8d53b1 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1945,7 +1945,7 @@ InvokeImportedNRCmd(
     ImportedCmdData *dataPtr = clientData;
     Command *realCmdPtr = dataPtr->realCmdPtr;
 
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
+    TclDeferCallbacks(interp, /* skipTailcall */ 1);
     return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
 }
 
-- 
cgit v0.12


From e89dea9b9b819e7b5ddc8d171127b749e237af35 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 10 Jan 2013 21:18:52 +0000
Subject: tailcall now running in a simpler model, with no eval-flags and no
 nre-stack rewriting; yieldto also requires one fewer bounce. Mostly from
 mig-nre-mods

---
 generic/tclBasic.c      | 142 +++++++++++++++++++++++-------------------------
 generic/tclCompCmdsSZ.c |   4 +-
 generic/tclEnsemble.c   |   4 +-
 generic/tclExecute.c    |  20 +++----
 generic/tclInt.h        |  36 +-----------
 generic/tclInterp.c     |   4 +-
 generic/tclNamesp.c     |   4 +-
 7 files changed, 87 insertions(+), 127 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 562cca6..55014ec 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -160,10 +160,7 @@ static Tcl_NRPostProc	TEOV_Exception;
 static Tcl_NRPostProc	TEOV_NotFoundCallback;
 static Tcl_NRPostProc	TEOV_RestoreVarFrame;
 static Tcl_NRPostProc	TEOV_RunLeaveTraces;
-static Tcl_NRPostProc	YieldToCallback;
 
-static void	        ClearTailcall(Tcl_Interp *interp,
-			    struct NRE_callback *tailcallPtr);
 static Tcl_ObjCmdProc NRCoroInjectObjCmd;
 
 MODULE_SCOPE const TclStubs tclStubs;
@@ -4161,7 +4158,8 @@ TclNREvalObjv(
     int result;
     Namespace *lookupNsPtr = iPtr->lookupNsPtr;
     Command **cmdPtrPtr;
-
+    NRE_callback *callbackPtr;
+    
     iPtr->lookupNsPtr = NULL;
 
     /*
@@ -4174,15 +4172,17 @@ TclNREvalObjv(
      * finishes the source command and not just the target.
      */
 
-    if (iPtr->evalFlags & TCL_EVAL_REDIRECT) {
-	TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv);
-	iPtr->evalFlags &= ~TCL_EVAL_REDIRECT;
+    if (iPtr->deferredCallbacks) {
+        callbackPtr = iPtr->deferredCallbacks;
+        iPtr->deferredCallbacks = NULL;
     } else {
-	TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv);
+	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+        callbackPtr = TOP_CB(interp);
     }
-    cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
+    cmdPtrPtr = (Command **) &(callbackPtr->data[0]);
 
-    TclNRSpliceDeferred(interp);
+    callbackPtr->data[2] = INT2PTR(objc);
+    callbackPtr->data[3] = (ClientData) objv;
 
     iPtr->numLevels++;
     result = TclInterpReady(interp);
@@ -4368,6 +4368,14 @@ NRCommand(
     }
     ((Interp *)interp)->numLevels--;
 
+     /*
+      * If there is a tailcall, schedule it
+      */
+ 
+    if (data[1] && (data[1] != INT2PTR(1))) {
+        TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
+    }
+
     /* OPT ??
      * Do not interrupt a series of cleanups with async or limit checks:
      * just check at the end?
@@ -4625,9 +4633,9 @@ TEOV_NotFound(
 	savedNsPtr = varFramePtr->nsPtr;
 	varFramePtr->nsPtr = lookupNsPtr;
     }
-    TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
+    TclDeferCallbacks(interp, 1);
+    TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
 	    newObjv, savedNsPtr, NULL);
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
     return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
 }
 
@@ -6012,7 +6020,8 @@ TclNREvalObjEx(
 	    iPtr->cmdFramePtr = eoFramePtr;
 	}
 
-	TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+	TclDeferCallbacks(interp, 0);
+        TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
 		NULL, NULL);
 
 	ListObjGetElements(listPtr, objc, objv);
@@ -8269,29 +8278,43 @@ Tcl_NRCmdSwap(
  */
 
 void
-TclSpliceTailcall(
+TclDeferCallbacks(
     Tcl_Interp *interp,
-    NRE_callback *tailcallPtr)
+    int skipTailcalls)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (iPtr->deferredCallbacks == NULL) {
+	TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(skipTailcalls != 0),
+                NULL, NULL);
+        iPtr->deferredCallbacks = TOP_CB(interp);
+    } else if (skipTailcalls) {
+        iPtr->deferredCallbacks->data[1] = INT2PTR(skipTailcalls != 0);
+    }
+}
+
+void
+TclSetTailcall(
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr)
 {
     /*
      * Find the splicing spot: right before the NRCommand of the thing
-     * being tailcalled. Note that we skip NRCommands marked in data[1]
+     * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1]
      * (used by command redirectors).
      */
 
     NRE_callback *runPtr;
 
     for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
-	if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
+        if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
             break;
         }
     }
     if (!runPtr) {
         Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
     }
-
-    tailcallPtr->nextPtr = runPtr->nextPtr;
-    runPtr->nextPtr = tailcallPtr;
+    runPtr->data[1] = listPtr;
 }
 
 int
@@ -8321,7 +8344,7 @@ TclNRTailcallObjCmd(
      */
 
     if (iPtr->varFramePtr->tailcallPtr) {
-        ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
+        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
         iPtr->varFramePtr->tailcallPtr = NULL;
     }
 
@@ -8336,23 +8359,20 @@ TclNRTailcallObjCmd(
         Tcl_Obj *listPtr, *nsObjPtr;
         Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
         Tcl_Namespace *ns1Ptr;
-        NRE_callback *tailcallPtr;
 
-        listPtr = Tcl_NewListObj(objc-1, objv+1);
-        Tcl_IncrRefCount(listPtr);
+        /* The tailcall data is in a Tcl list: the first element is the
+         * namespace, the rest the command to be tailcalled. */
+        
+        listPtr = Tcl_NewListObj(objc, objv);
 
         nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
         if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
                 || (nsPtr != ns1Ptr)) {
             Tcl_Panic("Tailcall failed to find the proper namespace");
         }
-        Tcl_IncrRefCount(nsObjPtr);
-
-        TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr,
-                NULL, NULL);
-        tailcallPtr = TOP_CB(interp);
-        TOP_CB(interp) = tailcallPtr->nextPtr;
-        iPtr->varFramePtr->tailcallPtr = tailcallPtr;
+ 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+        
+        iPtr->varFramePtr->tailcallPtr = listPtr;
     }
     return TCL_RETURN;
 }
@@ -8364,12 +8384,14 @@ TclNRTailcallEval(
     int result)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *listPtr = data[0];
-    Tcl_Obj *nsObjPtr = data[1];
+    Tcl_Obj *listPtr = data[0], *nsObjPtr;
     Tcl_Namespace *nsPtr;
     int objc;
     Tcl_Obj **objv;
 
+    Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); 
+    nsObjPtr = objv[0];
+    
     if (result == TCL_OK) {
 	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
     }
@@ -8388,10 +8410,10 @@ TclNRTailcallEval(
      * Perform the tailcall
      */
 
-    TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL,NULL);
+    TclDeferCallbacks(interp, 0);
+    TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
     iPtr->lookupNsPtr = (Namespace *) nsPtr;
-    ListObjGetElements(listPtr, objc, objv);
-    return TclNREvalObjv(interp, objc, objv, 0, NULL);
+    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
 }
 
 static int
@@ -8401,19 +8423,9 @@ TailcallCleanup(
     int result)
 {
     Tcl_DecrRefCount((Tcl_Obj *) data[0]);
-    Tcl_DecrRefCount((Tcl_Obj *) data[1]);
     return result;
 }
 
-static void
-ClearTailcall(
-    Tcl_Interp *interp,
-    NRE_callback *tailcallPtr)
-{
-    TailcallCleanup(tailcallPtr->data, interp, TCL_OK);
-    TCLNR_FREE(interp, tailcallPtr);
-}
-
 
 void
 Tcl_NRAddCallback(
@@ -8515,50 +8527,32 @@ TclNRYieldToObjCmd(
      * This is essentially code from TclNRTailcallObjCmd
      */
 
-    listPtr = Tcl_NewListObj(objc-1, objv+1);
-    Tcl_IncrRefCount(listPtr);
+    /*
+     * Add the tailcall in the caller env, then just yield.
+     *
+     * This is essentially code from TclNRTailcallObjCmd
+     */
+
+    listPtr = Tcl_NewListObj(objc, objv);
 
     nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
     if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
 	    || (nsPtr != ns1Ptr)) {
 	Tcl_Panic("yieldto failed to find the proper namespace");
     }
-    Tcl_IncrRefCount(nsObjPtr);
+    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+
 
     /*
      * Add the callback in the caller's env, then instruct TEBC to yield.
      */
 
     iPtr->execEnvPtr = corPtr->callerEEPtr;
-    TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr,
-	    NULL);
+    TclSetTailcall(interp, listPtr);
     iPtr->execEnvPtr = corPtr->eePtr;
 
     return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
 }
-
-static int
-YieldToCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    /* CoroutineData *corPtr = data[0];*/
-    Tcl_Obj *listPtr = data[1];
-    ClientData nsPtr = data[2];
-    NRE_callback *cbPtr;
-
-    /*
-     * yieldTo: invoke the command using tailcall tech.
-     */
-
-    TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL);
-    cbPtr = TOP_CB(interp);
-    TOP_CB(interp) = cbPtr->nextPtr;
-
-    TclSpliceTailcall(interp, cbPtr);
-    return TCL_OK;
-}
 
 static int
 RewindCoroutineCallback(
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 1d04d8b..6e31481 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1953,11 +1953,13 @@ TclCompileTailcallCmd(
 	return TCL_ERROR;
     }
 
+    /* make room for the nsObjPtr */
+    CompileWord(envPtr, tokenPtr, interp, 0);
     for (i=1 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
-    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords-1,	envPtr);
+    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords,	envPtr);
     return TCL_OK;
 }
 
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 9a2d598..2753876 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1914,7 +1914,7 @@ NsEnsembleImplementationCmdNR(
 	 * Hand off to the target command.
 	 */
 
-	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+	TclDeferCallbacks(interp, /* skip tailcalls */ 1);
 	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
     }
 
@@ -2122,7 +2122,7 @@ EnsembleUnknownCallback(
      */
 
     Tcl_Preserve(ensemblePtr);
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
+    TclDeferCallbacks (interp, /*skip tailcalls */ 1);
     result = Tcl_EvalObjv(interp, paramc, paramv, 0);
     if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
 	if (!Tcl_InterpDeleted(interp)) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ade71f6..af60a95 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2399,7 +2399,6 @@ TEBCresume(
 
     case INST_TAILCALL: {
 	Tcl_Obj *listPtr, *nsObjPtr;
-        NRE_callback *tailcallPtr;
 
 	opnd = TclGetUInt1AtPtr(pc+1);
 
@@ -2433,18 +2432,12 @@ TEBCresume(
 
 	listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
 	nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1);
-	Tcl_IncrRefCount(listPtr);
-	Tcl_IncrRefCount(nsObjPtr);
-	TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr,
-		NULL, NULL);
-
-	/*
-	 * Unstitch ourselves and do a [return].
-	 */
+	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+	if (iPtr->varFramePtr->tailcallPtr) {
+	    Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
+	}
+	iPtr->varFramePtr->tailcallPtr = listPtr;
 
-	tailcallPtr = TOP_CB(interp);
-	TOP_CB(interp) = tailcallPtr->nextPtr;
-	iPtr->varFramePtr->tailcallPtr = tailcallPtr;
 	result = TCL_RETURN;
 	cleanup = opnd;
 	goto processExceptionReturn;
@@ -3054,8 +3047,9 @@ TEBCresume(
 	DECACHE_STACK_INFO();
 	pc += 6;
 	TEBC_YIELD();
+
 	TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
-	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+	TclDeferCallbacks(interp, /*skip tailcalls */ 1);
 	return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
 
     /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 537afb3..6cf594e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1154,7 +1154,7 @@ typedef struct CallFrame {
 				 * meaning of the value is, which we do not
 				 * specify. */
     LocalCache *localCachePtr;
-    struct NRE_callback *tailcallPtr;
+    Tcl_Obj    *tailcallPtr;
 				/* NULL if no tailcall is scheduled */
 } CallFrame;
 
@@ -2250,7 +2250,6 @@ typedef struct InterpList {
 #define TCL_ALLOW_EXCEPTIONS	4
 #define TCL_EVAL_FILE		2
 #define TCL_EVAL_CTX		8
-#define TCL_EVAL_REDIRECT	16
 
 /*
  * Flag bits for Interp structures:
@@ -2805,8 +2804,8 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
 
-MODULE_SCOPE void  TclSpliceTailcall(Tcl_Interp *interp,
-	               struct NRE_callback *tailcallPtr);
+MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
+MODULE_SCOPE void  TclDeferCallbacks(Tcl_Interp *interp, int skipTailcall);
 
 /*
  * This structure holds the data for the various iteration callbacks used to
@@ -4808,35 +4807,6 @@ typedef struct NRE_callback {
 	TOP_CB(interp) = callbackPtr;					\
     } while (0)
 
-#define TclNRDeferCallback(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 = ((Interp *)interp)->deferredCallbacks;	\
-	((Interp *)interp)->deferredCallbacks = callbackPtr;		\
-    } while (0)
-
-#define TclNRSpliceCallbacks(interp, topPtr) \
-    do {					\
-	NRE_callback *bottomPtr = topPtr;	\
-	while (bottomPtr->nextPtr) {		\
-	    bottomPtr = bottomPtr->nextPtr;	\
-	}					\
-	bottomPtr->nextPtr = TOP_CB(interp);	\
-	TOP_CB(interp) = topPtr;		\
-    } while (0)
-
-#define TclNRSpliceDeferred(interp)					\
-    if (((Interp *)interp)->deferredCallbacks) {			\
-	TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \
-	((Interp *)interp)->deferredCallbacks = NULL;			\
-    }
-
 #if NRE_USE_SMALL_ALLOC
 #define TCLNR_ALLOC(interp, ptr) \
     TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 0b0f652..2e90caf 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1798,9 +1798,9 @@ AliasNRCmd(
      */
 
     if (isRootEnsemble) {
-	TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
     }
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+    TclDeferCallbacks(interp, /* skip tailcalls */ 1);
     return Tcl_NREvalObj(interp, listPtr, flags);
 }
 
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 8da4b42..ee8aaa6 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -423,7 +423,7 @@ Tcl_PopCallFrame(
     framePtr->nsPtr = NULL;
 
     if (framePtr->tailcallPtr) {
-	TclSpliceTailcall(interp, framePtr->tailcallPtr);
+	TclSetTailcall(interp, framePtr->tailcallPtr);
     }
 }
 
@@ -1945,7 +1945,7 @@ InvokeImportedNRCmd(
     ImportedCmdData *dataPtr = clientData;
     Command *realCmdPtr = dataPtr->realCmdPtr;
 
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
+    TclDeferCallbacks(interp, /* skip tailcalls */ 1);
     return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
 }
 
-- 
cgit v0.12