still no good

generic/tcl.h

@@ -1068,6 +1068,8 @@ typedef struct Tcl_DString {
 #define TCL_EVAL_INVOKE		0x080000
 #define TCL_CANCEL_UNWIND	0x100000
 #define TCL_EVAL_NOERR          0x200000
+#define TCL_EVAL_REDIRECT	0x400000
+    
 
 /*
  * Special freeProc values that may be passed to Tcl_SetResult (see the man

generic/tclBasic.c

@@ -162,10 +162,10 @@ 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;
 
+static inline void SpliceDeferred(Tcl_Interp *interp);
+
 MODULE_SCOPE const TclStubs tclStubs;
 
 /*
@@ -4174,15 +4174,14 @@ TclNREvalObjv(
      * finishes the source command and not just the target.
      */
 
-    if (iPtr->evalFlags & TCL_EVAL_REDIRECT) {
+    if (flags & TCL_EVAL_REDIRECT) {
 	TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv);
-	iPtr->evalFlags &= ~TCL_EVAL_REDIRECT;
     } else {
 	TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv);
     }
     cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
 
-    TclNRSpliceDeferred(interp);
+    SpliceDeferred(interp);
 
     iPtr->numLevels++;
     result = TclInterpReady(interp);
@@ -4303,6 +4302,7 @@ TclNREvalObjv(
     if (cmdPtr->nreProc) {
         TclNRAddCallback(interp, NRRunObjProc, cmdPtr,
                 INT2PTR(objc), (ClientData) objv, NULL);
+
         return TCL_OK;
     } else {
 	return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
@@ -4326,7 +4326,7 @@ TclNRRunCallbacks(
 				 * are to be run. */
 {
     Interp *iPtr = (Interp *) interp;
-    NRE_callback *callbackPtr;
+    NRE_callback *cbPtr;
     Tcl_NRPostProc *procPtr;
 
     /*
@@ -4344,11 +4344,10 @@ TclNRRunCallbacks(
     }
 
     while (TOP_CB(interp) != rootPtr) {
-	callbackPtr = TOP_CB(interp);
-	procPtr = callbackPtr->procPtr;
-	TOP_CB(interp) = callbackPtr->nextPtr;
-	result = procPtr(callbackPtr->data, interp, result);
-	TCLNR_FREE(interp, callbackPtr);
+	POP_CB(interp, cbPtr);
+	procPtr = cbPtr->procPtr;
+	result = procPtr(cbPtr->data, interp, result);
+        FREE_CB(cbPtr);
     }
     return result;
 }
@@ -4368,6 +4367,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,10 +4632,10 @@ TEOV_NotFound(
 	savedNsPtr = varFramePtr->nsPtr;
 	varFramePtr->nsPtr = lookupNsPtr;
     }
-    TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
+    TclDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
 	    newObjv, savedNsPtr, NULL);
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
-    return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
+    return TclNREvalObjv(interp, newObjc, newObjv, (TCL_EVAL_NOERR|TCL_EVAL_REDIRECT),
+            NULL);
 }
 
 static int
@@ -6012,7 +6019,7 @@ TclNREvalObjEx(
 	    iPtr->cmdFramePtr = eoFramePtr;
 	}
 
-	TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+	TclDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
 		NULL, NULL);
 
 	ListObjGetElements(listPtr, objc, objv);
@@ -8268,10 +8275,151 @@ Tcl_NRCmdSwap(
  * FIXME NRE!
  */
 
+//#define PR(x) fprint(stdout, x)
+#define PR(x)
+
 void
-TclSpliceTailcall(
+TclDeferCallback(
     Tcl_Interp *interp,
-    NRE_callback *tailcallPtr)
+    Tcl_NRPostProc *postProcPtr,
+    ClientData data0, ClientData data1,
+    ClientData data2, ClientData data3)
+{
+    Interp *iPtr = (Interp *) interp;
+    NRE_callback *cbPtr;
+    
+    TclNRAddCallback(interp, postProcPtr, data0, data1,
+            data2, data3);
+    cbPtr = TOP_CB(interp);
+    cbPtr->nextPtr = iPtr->deferredCallbacks;
+    iPtr->deferredCallbacks = cbPtr;    
+}
+
+static void
+SpliceDeferred(
+    Tcl_Interp *interp)
+{
+    PR("CALLED SpliceDeferred\n");
+    return;
+    /* STUPID: optimize a bit */
+#if 0
+    Interp *iPtr = (Interp *) interp;
+    int deferred = iPtr->deferredCallbacks;
+    NRE_callback *tosPtr = TOP_CB(interp), *runPtr;
+
+    if (deferred) {
+        NRE_callback *tmp;
+        int i;
+
+        tmp = ckalloc(deferred*sizeof(NRE_callback));
+        
+        i = deferred;
+        while (i--) {
+            POP_CB(interp, runPtr);
+            tmp[i] = *runPtr;
+        }
+
+        ALLOC_CB(interp, runPtr);
+        *runPtr = *tosPtr;
+
+        i = deferred;
+        for (i=0; i < deferred; i++) {
+            ALLOC_CB(interp, runPtr);
+            *runPtr = tmp[i];
+        }
+        ckfree(tmp);
+        iPtr->deferredCallbacks = 0;
+    }
+#endif
+}
+
+int
+TclNRStackBottom(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    NRE_stack *this = eePtr->NRStack;
+    NRE_stack *prev = data[0];
+
+    PR("CALLED TclNRStackBottom\n");
+    
+    if (!prev) {
+        Tcl_Panic("Reached the NRE-stack bottom, should not happen!");
+    }
+    
+    /*
+     * Go back to the previous stack.
+     */
+
+    eePtr->NRStack = prev;
+    eePtr->callbackPtr = &prev->items[NRE_STACK_SIZE-1];
+    
+    /*
+     * Keep this stack in reserve. If this one had a successor, free that one:
+     * we always keep just one in reserve. 
+     */
+    
+    if (this->next) {
+        ckfree (this->next);
+        this->next = NULL;
+    }
+
+    return result;
+}
+
+NRE_callback *
+TclNewCallback(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    NRE_callback *cbPtr = eePtr->callbackPtr;
+    NRE_stack *this = eePtr->NRStack;
+#if NEW
+    if (!this || (cbPtr == &this->items[NRE_STACK_SIZE-1])) {
+        PR("ALLOC\n");
+        if (this && this->next) {
+            eePtr->NRStack = this->next;
+        } else {
+            eePtr->NRStack = (NRE_stack *) ckalloc(sizeof(NRE_stack));
+            eePtr->NRStack->next = NULL;
+        }
+        eePtr->callbackPtr = &eePtr->NRStack->items[-1];
+
+        TclNRAddCallback(interp, TclNRStackBottom, this, NULL, NULL, NULL);
+    } else {
+        PR("PUSH\n");
+    }
+    cbPtr++;
+    cbPtr->nextPtr = eePtr->callbackPtr;
+    eePtr->callbackPtr = cbPtr;
+#endif
+    return eePtr->callbackPtr;
+}
+
+NRE_callback *
+TclPopCallback(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+    ExecEnv *eePtr = iPtr->execEnvPtr;
+    NRE_callback *cbPtr = eePtr->callbackPtr, *tmp;
+    NRE_stack *this = eePtr->NRStack;
+    int depth = cbPtr - &this->items[1];
+
+    PR("POP\n");
+    --eePtr->callbackPtr;
+    return cbPtr;
+}
+
+/* ***************************************** */
+void
+TclSetTailcall(
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr)
 {
     /*
      * Find the splicing spot: right before the NRCommand of the thing
@@ -8290,8 +8438,14 @@ TclSpliceTailcall(
         Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
     }
 
-    tailcallPtr->nextPtr = runPtr->nextPtr;
-    runPtr->nextPtr = tailcallPtr;
+    if (runPtr->data[1]) {
+        /*
+         * A tailcall was already scheduled: clear it!
+         */
+        Tcl_Obj *oldPtr = (Tcl_Obj *) runPtr->data[1];
+        Tcl_DecrRefCount(oldPtr);
+    }
+    runPtr->data[1] = listPtr;
 }
 
 int
@@ -8321,7 +8475,7 @@ TclNRTailcallObjCmd(
      */
 
     if (iPtr->varFramePtr->tailcallPtr) {
-        ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
+        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
         iPtr->varFramePtr->tailcallPtr = NULL;
     }
 
@@ -8336,23 +8490,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 +8515,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 +8541,9 @@ TclNRTailcallEval(
      * Perform the tailcall
      */
 
-    TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL,NULL);
+    TclDeferCallback(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 +8553,8 @@ 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,23 +8656,22 @@ TclNRYieldToObjCmd(
      * This is essentially code from TclNRTailcallObjCmd
      */
 
-    listPtr = Tcl_NewListObj(objc-1, objv+1);
-    Tcl_IncrRefCount(listPtr);
+    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);
+    TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, NULL, NULL);
     iPtr->execEnvPtr = corPtr->eePtr;
 
     return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
@@ -8543,20 +8683,7 @@ YieldToCallback(
     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);
+    TclSetTailcall(interp, (Tcl_Obj *) data[1]);
     return TCL_OK;
 }
 

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;
 }
 

generic/tclEnsemble.c

@@ -1914,8 +1914,8 @@ NsEnsembleImplementationCmdNR(
 	 * Hand off to the target command.
 	 */
 
-	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
-	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
+	return TclNREvalObjEx(interp, copyPtr,
+		(TCL_EVAL_INVOKE|TCL_EVAL_REDIRECT), NULL,INT_MIN);
     }
 
   unknownOrAmbiguousSubcommand:
@@ -2122,8 +2122,7 @@ EnsembleUnknownCallback(
      */
 
     Tcl_Preserve(ensemblePtr);
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
-    result = Tcl_EvalObjv(interp, paramc, paramv, 0);
+    result = Tcl_EvalObjv(interp, paramc, paramv, TCL_EVAL_REDIRECT);
     if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
 	if (!Tcl_InterpDeleted(interp)) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(

generic/tclExecute.c

@@ -871,6 +871,7 @@ TclCreateExecEnv(
     TclNewBooleanObj(eePtr->constants[1], 1);
     Tcl_IncrRefCount(eePtr->constants[1]);
     eePtr->interp = interp;
+    eePtr->NRStack = NULL;
     eePtr->callbackPtr = NULL;
     eePtr->corPtr = NULL;
     eePtr->rewind = 0;
@@ -889,6 +890,11 @@ TclCreateExecEnv(
     }
     Tcl_MutexUnlock(&execMutex);
 
+    /* Initialize the NRE stack */
+
+    ((Interp *) interp)->execEnvPtr = eePtr;
+    eePtr->callbackPtr = TclNewCallback(interp);
+    eePtr->callbackPtr--;
     return eePtr;
 }
 
@@ -932,7 +938,7 @@ TclDeleteExecEnv(
 {
     ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
 
-	cachedInExit = TclInExit();
+    cachedInExit = TclInExit();
 
     /*
      * Delete all stacks in this exec env.
@@ -2399,7 +2405,6 @@ TEBCresume(
 
     case INST_TAILCALL: {
 	Tcl_Obj *listPtr, *nsObjPtr;
-        NRE_callback *tailcallPtr;
 
 	opnd = TclGetUInt1AtPtr(pc+1);
 
@@ -2433,18 +2438,9 @@ 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);
+	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
+	iPtr->varFramePtr->tailcallPtr = listPtr;
 
-	/*
-	 * Unstitch ourselves and do a [return].
-	 */
-
-	tailcallPtr = TOP_CB(interp);
-	TOP_CB(interp) = tailcallPtr->nextPtr;
-	iPtr->varFramePtr->tailcallPtr = tailcallPtr;
 	result = TCL_RETURN;
 	cleanup = opnd;
 	goto processExceptionReturn;
@@ -3055,8 +3051,8 @@ TEBCresume(
 	pc += 6;
 	TEBC_YIELD();
 	TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
-	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
-	return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
+	return TclNREvalObjEx(interp, objPtr, (TCL_EVAL_INVOKE|TCL_EVAL_REDIRECT),
+		NULL, INT_MIN);
 
     /*
      * -----------------------------------------------------------------

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;
 
@@ -1497,6 +1497,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;
@@ -2137,8 +2138,7 @@ typedef struct Interp {
 				 * tclOOInt.h and tclOO.c for real definition
 				 * and setup. */
 
-    struct NRE_callback *deferredCallbacks;
-				/* Callbacks that are set previous to a call
+    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*
@@ -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,11 @@ 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  TclDeferCallback(Tcl_Interp *interp,
+	               Tcl_NRPostProc postProcPtr,
+                       ClientData data0, ClientData data1,
+                       ClientData data2, ClientData data3);
 
 /*
  * This structure holds the data for the various iteration callbacks used to
@@ -4774,7 +4776,6 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
  *----------------------------------------------------------------
  */
 
-#define NRE_USE_SMALL_ALLOC	1  /* Only turn off for debugging purposes. */
 #define NRE_ENABLE_ASSERTS	1
 
 /*
@@ -4789,64 +4790,71 @@ typedef struct NRE_callback {
     struct NRE_callback *nextPtr;
 } NRE_callback;
 
-#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
-
 /*
- * Inline version of Tcl_NRAddCallback.
+ * Inline versions of Tcl_NRAddCallback and friends
  */
 
-#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
+#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;					\
+	NRE_callback *cbPtr;						\
+	ALLOC_CB(interp, cbPtr);					\
+	INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3);		\
     } while (0)
 
-#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) \
+#define INIT_CB(cbPtr, 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;		\
+	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)
 
-#define TclNRSpliceCallbacks(interp, topPtr) \
-    do {					\
-	NRE_callback *bottomPtr = topPtr;	\
-	while (bottomPtr->nextPtr) {		\
-	    bottomPtr = bottomPtr->nextPtr;	\
-	}					\
-	bottomPtr->nextPtr = TOP_CB(interp);	\
-	TOP_CB(interp) = topPtr;		\
+#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
+
+#define NRE_STACK_SIZE 100
+
+MODULE_SCOPE NRE_callback *TclNewCallback(Tcl_Interp *interp);
+MODULE_SCOPE NRE_callback *TclPopCallback(Tcl_Interp *interp);
+MODULE_SCOPE Tcl_NRPostProc TclNRStackBottom;
+
+#define NEW 0
+
+#if NEW
+#define POP_CB(interp, cbPtr)                      \
+    (cbPtr) = TclPopCallback(interp)
+
+#define ALLOC_CB(interp, cbPtr)			\
+    (cbPtr) = TclNewCallback(interp)
+
+#define FREE_CB(cbPtr)
+
+#else /* OLD */
+
+#define POP_CB(interp, cbPtr)			\
+    do {\
+	(cbPtr) = TOP_CB(interp);		\
+	TOP_CB(interp) = (cbPtr)->nextPtr;	\
     } 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))
-#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))
+#define ALLOC_CB(interp, cbPtr)		\
+    do {				\
+	(cbPtr) = (NRE_callback *)ckalloc(sizeof(Tcl_Obj));	\
+	(cbPtr)->nextPtr = TOP_CB(interp);			\
+	TOP_CB(interp) = (cbPtr);				\
+    } while (0)
+
+#define FREE_CB(cbPtr)			\
+    ckfree(cbPtr)
 #endif
 
+typedef struct NRE_stack {
+    struct NRE_callback items[NRE_STACK_SIZE];
+    struct NRE_stack *next;
+} NRE_stack;
+
+
 #if NRE_ENABLE_ASSERTS
 #define NRE_ASSERT(expr) assert((expr))
 #else

generic/tclInterp.c

@@ -1754,7 +1754,7 @@ AliasNRCmd(
     int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
     Tcl_Obj *listPtr;
     List *listRep;
-    int flags = TCL_EVAL_INVOKE;
+    int flags = (TCL_EVAL_INVOKE|TCL_EVAL_REDIRECT);
 
     /*
      * Append the arguments to the command prefix and invoke the command in
@@ -1798,9 +1798,8 @@ AliasNRCmd(
      */
 
     if (isRootEnsemble) {
-	TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+	TclDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
     }
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
     return Tcl_NREvalObj(interp, listPtr, flags);
 }
 

generic/tclNamesp.c

@@ -423,7 +423,7 @@ Tcl_PopCallFrame(
     framePtr->nsPtr = NULL;
 
     if (framePtr->tailcallPtr) {
-	TclSpliceTailcall(interp, framePtr->tailcallPtr);
+	TclSetTailcall(interp, framePtr->tailcallPtr);
     }
 }
 
@@ -1945,8 +1945,8 @@ InvokeImportedNRCmd(
     ImportedCmdData *dataPtr = clientData;
     Command *realCmdPtr = dataPtr->realCmdPtr;
 
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
-    return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
+    return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv,
+	    TCL_EVAL_REDIRECT);
 }
 
 static int