* generic/tcl.h:

	* generic/tclInt.h:
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclNamesp.c (Tcl_PopCallFrame): Rewritten tailcall
	implementation, ::unsupported::atProcExit is (temporarily?)
	gone. The new approach is much simpler, and also closer to being
	correct. This commit fixes [Bug 2649975] and [Bug 2695587].

	* tests/coroutine.test:    Moved the tests to their own files,
	* tests/tailcall.test:     removed the unsupported.test. Added
	* tests/unsupported.test:  tests for the fixed bugs.

5 files changed, 136 insertions, 194 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 72c4acd..b5bced7 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.288 2009/01/16 20:44:24 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.289 2009/03/19 23:31:36 msofer Exp $
  */
 
 #ifndef _TCL
@@ -887,6 +887,7 @@ typedef struct Tcl_CallFrame {
     char *dummy10;
     char *dummy11;
     char *dummy12;
+    char *dummy13;
 } Tcl_CallFrame;
 
 /*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 50230ba..739732f 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.387 2009/03/11 10:44:20 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.388 2009/03/19 23:31:37 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -136,8 +136,8 @@ static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
 
 static Tcl_NRPostProc   NRRunObjProc;
 
-static Tcl_NRPostProc	AtProcExitCleanup;
-static Tcl_NRPostProc   NRAtProcExitEval;
+static Tcl_NRPostProc	TailcallCleanup;
+static Tcl_NRPostProc   NRTailcallEval;
 
 /*
  * The following structure define the commands in the Tcl core.
@@ -698,7 +698,7 @@ Tcl_CreateInterp(void)
 #endif
     iPtr->pendingObjDataPtr = NULL;
     iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
-    iPtr->atExitPtr = NULL;
+    iPtr->deferredCallbacks = NULL;
 
     /*
      * Create the core commands. Do it here, rather than calling
@@ -782,14 +782,11 @@ Tcl_CreateInterp(void)
 	    Tcl_DisassembleObjCmd, NULL, NULL);
 
     /*
-     * Create the 'tailcall' command an unsupported command for 'atProcExit'
+     * Create the 'tailcall' command
      */
 
-    Tcl_NRCreateCommand(interp, "tailcall", NULL, TclNRAtProcExitObjCmd,
-	    INT2PTR(TCL_NR_TAILCALL_TYPE), NULL);
-
-    Tcl_NRCreateCommand(interp, "::tcl::unsupported::atProcExit", NULL,
-	    TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_ATEXIT_TYPE), NULL);
+    Tcl_NRCreateCommand(interp, "tailcall", NULL, TclNRTailcallObjCmd,
+	    NULL, NULL);
 
 #ifdef USE_DTRACE
     /*
@@ -4056,7 +4053,7 @@ TclNREvalObjv(
      * will be filled later when the command is found: save its address at
      * objProcPtr.
      *
-     * data[1] stores a marker for use by tailcalls; it will be reset to 0 by
+     * data[1] stores a marker for use by tailcalls; it will be set to 1 by
      * command redirectors (imports, alias, ensembles) so that tailcalls
      * finishes the source command and not just the target.
      */
@@ -4064,6 +4061,8 @@ TclNREvalObjv(
     TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
     cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
 
+    TclNRSpliceDeferred(interp);
+    
     iPtr->numLevels++;
     result = TclInterpReady(interp);
 
@@ -4220,7 +4219,6 @@ TclNRRunCallbacks(
 	(void) Tcl_GetObjResult(interp);
     }
 
-  restart:
     while (TOP_CB(interp) != rootPtr) {
 	callbackPtr = TOP_CB(interp);
 
@@ -4244,16 +4242,6 @@ TclNRRunCallbacks(
 	result = procPtr(callbackPtr->data, interp, result);
 	TCLNR_FREE(interp, callbackPtr);
     }
-    if (iPtr->atExitPtr) {
-	callbackPtr = iPtr->atExitPtr;
-	while (callbackPtr->nextPtr) {
-	    callbackPtr = callbackPtr->nextPtr;
-	}
-	callbackPtr->nextPtr = rootPtr;
-	TOP_CB(iPtr) = iPtr->atExitPtr;
-	iPtr->atExitPtr = NULL;
-	goto restart;
-    }
     return result;
 }
 
@@ -4286,6 +4274,7 @@ NRCommand(
     if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
 	result = Tcl_LimitCheck(interp);
     }
+
     return result;
 }
 
@@ -4327,11 +4316,10 @@ NRCallTEBC(
     switch (type) {
     case TCL_NR_BC_TYPE:
 	return TclExecuteByteCode(interp, data[1]);
-    case TCL_NR_ATEXIT_TYPE:
     case TCL_NR_TAILCALL_TYPE:
-	/* For atProcExit and tailcalls */
+	/* For tailcalls */
 	Tcl_SetResult(interp,
-		"atProcExit/tailcall can only be called from a proc or lambda",
+		"tailcall can only be called from a proc or lambda",
 		TCL_STATIC);
 	return TCL_ERROR;
     case TCL_NR_YIELD_TYPE:
@@ -5767,6 +5755,20 @@ TclNREvalObjEx(
 	 * UpdateStringOfList from the internal rep).
 	 */
 
+	/*
+	 * Shimmer protection! Always pass an unshared obj. The caller could
+	 * incr the refCount of objPtr AFTER calling us! To be completely safe
+	 * we always make a copy. The callback takes care od the refCounts for
+	 * both listPtr and objPtr.
+	 *
+	 * FIXME OPT: preserve just the internal rep?
+	 */
+
+	Tcl_IncrRefCount(objPtr);
+	listPtr = TclListObjCopy(interp, objPtr);
+	Tcl_IncrRefCount(listPtr);
+	TclDecrRefCount(objPtr);
+	
 	if (word != INT_MIN) {
 	    /*
 	     * TIP #280 Structures for tracking lines. As we know that this is
@@ -5795,26 +5797,14 @@ TclNREvalObjEx(
 	    eoFramePtr->framePtr = iPtr->framePtr;
 	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
 
-	    eoFramePtr->cmd.listPtr = objPtr;
+	    eoFramePtr->cmd.listPtr = listPtr;
 	    eoFramePtr->data.eval.path = NULL;
 
 	    iPtr->cmdFramePtr = eoFramePtr;
 	}
 
-	/*
-	 * Shimmer protection! Always pass an unshared obj. The caller could
-	 * incr the refCount of objPtr AFTER calling us! To be completely safe
-	 * we always make a copy. The callback takes care od the refCounts for
-	 * both listPtr and objPtr.
-	 *
-	 * FIXME OPT: preserve just the internal rep?
-	 */
-
-	Tcl_IncrRefCount(objPtr);
-	listPtr = TclListObjCopy(interp, objPtr);
-	Tcl_IncrRefCount(listPtr);
-	TclNRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr,
-		listPtr, NULL);
+	TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+		NULL, NULL);
 
 	ListObjGetElements(listPtr, objc, objv);
 	return TclNREvalObjv(interp, objc, objv, flags, NULL);
@@ -5991,9 +5981,8 @@ TEOEx_ListCallback(
     int result)
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *objPtr = data[0];
+    Tcl_Obj *listPtr = data[0];
     CmdFrame *eoFramePtr = data[1];
-    Tcl_Obj *listPtr = data[2];
 
     /*
      * Remove the cmdFrame
@@ -6003,7 +5992,6 @@ TEOEx_ListCallback(
 	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
 	TclStackFree(interp, eoFramePtr);
     }
-    TclDecrRefCount(objPtr);
     TclDecrRefCount(listPtr);
 
     return result;
@@ -7992,25 +7980,26 @@ Tcl_NRCmdSwap(
  */
 
 int
-TclNRAtProcExitObjCmd(
+TclNRTailcallObjCmd(
     ClientData clientData,
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const objv[])
 {
     Interp *iPtr = (Interp *) interp;
+    TEOV_callback *tailcallPtr;
     Tcl_Obj *listPtr;
     Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
-
+    
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
 	return TCL_ERROR;
     }
-
+    
     if (!iPtr->varFramePtr->isProcCallFrame ||	      /* is not a body ... */
 	    (iPtr->framePtr != iPtr->varFramePtr)) {  /* or is upleveled   */
 	Tcl_SetResult(interp,
-		"atProcExit/tailcall can only be called from a proc or lambda",
+		"tailcall can only be called from a proc or lambda",
 		TCL_STATIC);
 	return TCL_ERROR;
     }
@@ -8023,15 +8012,21 @@ TclNRAtProcExitObjCmd(
      * Add two callbacks: first the one to actually evaluate the tailcalled
      * command, then the one that signals TEBC to stash the first at its
      * proper place.
+     *
+     * Being lazy: add the callback, then remove it (to exploit the
+     * TclNRAddCallBack macro to build the callback)
      */
 
-    TclNRAddCallback(interp, NRAtProcExitEval, listPtr, nsPtr, NULL, NULL);
-    TclNRAddCallback(interp, NRCallTEBC, clientData, NULL, NULL, NULL);
+    TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL);
+    tailcallPtr = TOP_CB(interp);
+    TOP_CB(interp) = tailcallPtr->nextPtr;
+
+    TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_TAILCALL_TYPE), tailcallPtr, NULL, NULL);
     return TCL_OK;
 }
 
 int
-NRAtProcExitEval(
+NRTailcallEval(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
@@ -8039,11 +8034,12 @@ NRAtProcExitEval(
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *listPtr = data[0];
     Namespace *nsPtr = data[1];
+    int omit = PTR2INT(data[2]);
     int objc;
     Tcl_Obj **objv;
 
-    TclNRAddCallback(interp, AtProcExitCleanup, listPtr, NULL, NULL, NULL);
-    if (result == TCL_OK) {
+    TclNRDeferCallback(interp, TailcallCleanup, listPtr, NULL, NULL, NULL);
+    if (!omit && (result == TCL_OK)) {
 	iPtr->lookupNsPtr = nsPtr;
 	ListObjGetElements(listPtr, objc, objv);
 	result = TclNREvalObjv(interp, objc, objv, 0, NULL);
@@ -8063,7 +8059,7 @@ NRAtProcExitEval(
 }
 
 static int
-AtProcExitCleanup(
+TailcallCleanup(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index e98545e..49862ae 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.428 2009/02/25 14:56:07 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.429 2009/03/19 23:31:37 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -177,8 +177,6 @@ typedef struct BottomData {
     TEOV_callback *rootPtr;	/* State when this bytecode execution began: */
     ByteCode *codePtr;		/* constant until it returns                 */
 				/* ------------------------------------------*/
-    TEOV_callback *atExitPtr;	/* This field is used on return FROM here    */
-				/* ------------------------------------------*/
     const unsigned char *pc;	/* These fields are used on return TO this   */
     ptrdiff_t *catchTop;	/* this level: they record the state when  a */
     int cleanup;		/* new codePtr was received for NR execution */
@@ -189,7 +187,6 @@ typedef struct BottomData {
     bottomPtr->prevBottomPtr = oldBottomPtr;	\
     bottomPtr->rootPtr = TOP_CB(iPtr);		\
     bottomPtr->codePtr = codePtr;		\
-    bottomPtr->atExitPtr = NULL
 
 #define NR_DATA_BURY()				\
     bottomPtr->pc = pc;				\
@@ -207,8 +204,6 @@ typedef struct BottomData {
     esPtr = iPtr->execEnvPtr->execStackPtr;		\
     tosPtr = esPtr->tosPtr
 
-static Tcl_NRPostProc NRRestoreInterpState;
-
 #define PUSH_AUX_OBJ(objPtr)					\
     objPtr->internalRep.twoPtrValue.ptr2 = auxObjList;		\
     auxObjList = objPtr
@@ -1722,22 +1717,6 @@ TclIncrObj(
  *----------------------------------------------------------------------
  */
 
-static int
-NRRestoreInterpState(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    /* FIXME
-     * Save the current state somewhere for instrospection of what happened in
-     * the atExit handlers?
-     */
-
-    Tcl_InterpState state = data[0];
-
-    return Tcl_RestoreInterpState(interp, state);
-}
-
 int
 TclExecuteByteCode(
     Tcl_Interp *interp,		/* Token for command interpreter. */
@@ -1835,8 +1814,6 @@ TclExecuteByteCode(
      */
 
     int nested = 0;
-    TEOV_callback *atExitPtr = NULL;
-    int isTailcall = 0;
 
     if (!codePtr) {
 	/*
@@ -1884,65 +1861,28 @@ TclExecuteByteCode(
 
 		codePtr = param;
 		break;
-	    case TCL_NR_ATEXIT_TYPE: {
-		/*
-		 * A request to perform a command at exit: put it in the stack
-		 * and continue exec'ing the current bytecode
-		 */
-
-		TEOV_callback *newPtr = TOP_CB(interp);
-
-		TOP_CB(interp) = newPtr->nextPtr;
-
-#ifdef TCL_COMPILE_DEBUG
-		if (traceInstructions) {
-		    fprintf(stdout, "   atProcExit request received\n");
-		}
-#endif
-		newPtr->nextPtr = bottomPtr->atExitPtr;
-		bottomPtr->atExitPtr = newPtr;
-		oldBottomPtr = bottomPtr;
-		goto returnToCaller;
-	    }
 	    case TCL_NR_TAILCALL_TYPE: {
 		/*
-		 * A request to perform a tailcall: put it at the front of the
-		 * atExit stack and abandon the current bytecode.
+		 * A request to perform a tailcall: just drop this bytecode.
 		 */
 
-		TEOV_callback *newPtr = TOP_CB(interp);
-
-		TOP_CB(interp) = newPtr->nextPtr;
-		isTailcall = 1;
 #ifdef TCL_COMPILE_DEBUG
 		if (traceInstructions) {
 		    fprintf(stdout, "   Tailcall request received\n");
 		}
 #endif
+		TEOV_callback *tailcallPtr = param;
+
+		iPtr->varFramePtr->tailcallPtr = tailcallPtr;
+		
 		if (catchTop != initCatchTop) {
-		    isTailcall = 0;
+		    tailcallPtr->data[2] = INT2PTR(1);
 		    result = TCL_ERROR;
 		    Tcl_SetResult(interp,"Tailcall called from within a catch environment",
 			    TCL_STATIC);
+		    pc--;
 		    goto checkForCatch;
 		}
-
-		newPtr->nextPtr = NULL;
-		if (!bottomPtr->atExitPtr) {
-		    newPtr->nextPtr = NULL;
-		    bottomPtr->atExitPtr = newPtr;
-		} else {
-		    /*
-		     * There are already atExit callbacks: run last.
-		     */
-
-		    TEOV_callback *tmpPtr = bottomPtr->atExitPtr;
-
-		    while (tmpPtr->nextPtr) {
-			tmpPtr = tmpPtr->nextPtr;
-		    }
-		    tmpPtr->nextPtr = newPtr;
-		}
 		goto abnormalReturn;
 	    }
 	    case TCL_NR_YIELD_TYPE: { /*[yield] */
@@ -1954,6 +1894,7 @@ TclExecuteByteCode(
 			    TCL_STATIC);
 		    Tcl_SetErrorCode(interp, "COROUTINE_ILLEGAL_YIELD", NULL);
 		    result = TCL_ERROR;
+		    pc--;
 		    goto checkForCatch;
 		}
 		NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
@@ -1964,6 +1905,7 @@ TclExecuteByteCode(
 			    TCL_STATIC);
 		    Tcl_SetErrorCode(interp, "COROUTINE_CANT_YIELD", NULL);
 		    result = TCL_ERROR;
+		    pc--;
 		    goto checkForCatch;
 		}
 
@@ -7823,7 +7765,6 @@ TclExecuteByteCode(
     TclArgumentBCRelease((Tcl_Interp*) iPtr,codePtr);
 
     oldBottomPtr = bottomPtr->prevBottomPtr;
-    atExitPtr = bottomPtr->atExitPtr;
     iPtr->cmdFramePtr = bcFramePtr->nextPtr;
     TclStackFree(interp, bottomPtr);	/* free my stack */
 
@@ -7835,7 +7776,7 @@ TclExecuteByteCode(
     if (oldBottomPtr) {
 	/*
 	 * Restore the state to what it was previous to this bytecode, deal
-	 * with atExit handlers and tailcalls.
+	 * with tailcalls.
 	 */
 
 	bottomPtr = oldBottomPtr;	/* back to old bc */
@@ -7846,43 +7787,10 @@ TclExecuteByteCode(
 	NR_DATA_DIG();
 	if (TOP_CB(interp) == bottomPtr->rootPtr) {
 	    /*
-	     * The bytecode is returning, all callbacks were run. Run atExit
-	     * handlers, remove the caller's arguments and keep processing the
-	     * caller.
+	     * The bytecode is returning, all callbacks were run. Remove the
+	     * caller's arguments and keep processing the caller.
 	     */
 
-	    if (atExitPtr) {
-		/*
-		 * Find the last one
-		 */
-
-		TEOV_callback *lastPtr = atExitPtr;
-		while (lastPtr->nextPtr) {
-		    lastPtr = lastPtr->nextPtr;
-		}
-		NRE_ASSERT(lastPtr->nextPtr == NULL);
-		if (!isTailcall) {
-		    /*
-		     * Save the interp state, arrange for restoring it after
-		     * running the callbacks.
-		     */
-
-		    TclNRAddCallback(interp, NRRestoreInterpState,
-			    Tcl_SaveInterpState(interp, result), NULL,
-			    NULL, NULL);
-		}
-
-		/*
-		 * splice in the atExit callbacks and rerun all callbacks
-		 */
-
-		lastPtr->nextPtr = TOP_CB(interp);
-		TOP_CB(interp) = atExitPtr;
-		isTailcall = 0;
-		atExitPtr = NULL;
-		goto rerunCallbacks;
-	    }
-
 	    while (cleanup--) {
 		Tcl_Obj *objPtr = POP_OBJECT();
 		Tcl_DecrRefCount(objPtr);
@@ -7903,7 +7811,6 @@ TclExecuteByteCode(
 		     */
 
 		    goto nonRecursiveCallStart;
-		case TCL_NR_ATEXIT_TYPE:
 		case TCL_NR_TAILCALL_TYPE:
 		    TOP_CB(iPtr) = callbackPtr->nextPtr;
 		    TCLNR_FREE(interp, callbackPtr);
@@ -7919,32 +7826,6 @@ TclExecuteByteCode(
 	}
     }
 
-
-    if (atExitPtr) {
-	if (!isTailcall) {
-	    /*
-	     * Save the interp state, arrange for restoring it after running
-	     * the callbacks. Put the callback at the bottom of the atExit
-	     * stack.
-	     */
-
-	    Tcl_InterpState state = Tcl_SaveInterpState(interp, result);
-	    TEOV_callback *lastPtr = atExitPtr;
-
-	    while (lastPtr->nextPtr) {
-		lastPtr = lastPtr->nextPtr;
-	    }
-	    NRE_ASSERT(lastPtr->nextPtr == NULL);
-
-	    TclNRAddCallback(interp, NRRestoreInterpState, state, NULL,
-		    NULL, NULL);
-	    lastPtr->nextPtr = TOP_CB(iPtr);
-	    TOP_CB(iPtr) = TOP_CB(iPtr)->nextPtr;
-	    lastPtr->nextPtr->nextPtr = NULL;
-	}
-	iPtr->atExitPtr = atExitPtr;
-    }
-
     iPtr->execEnvPtr->bottomPtr = NULL;
     return result;
 }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3f7a2dc..48473bd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.418 2009/03/09 09:12:39 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.419 2009/03/19 23:31:37 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -1056,6 +1056,13 @@ typedef struct CallFrame {
 				 * meaning of the value is, which we do not
 				 * specify. */
     LocalCache *localCachePtr;
+    struct TEOV_callback *tailcallPtr;
+                                /* The callback implementing the call to be
+				 * executed by the command that pushed this
+				 * frame. It can be TAILCALL_NONE to signal
+				 * that we are tailcalling a frame further up
+				 * the stack. 
+				 */
 } CallFrame;
 
 #define FRAME_IS_PROC	0x1
@@ -2006,10 +2013,13 @@ typedef struct Interp {
 				 * tclOOInt.h and tclOO.c for real definition
 				 * and setup. */
 
-    struct TEOV_callback *atExitPtr;
-				/* Callbacks to be run after a command exited;
-				 * this is only set for atProcExirt or
-				 * tailcalls that fall back out of tebc. */
+    struct TEOV_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 - ie, they should be run *before*
+				 * any tailcall is invoked.
+				 */
 
 #ifdef TCL_COMPILE_STATS
     /*
@@ -2589,7 +2599,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd;
 
 MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRAtProcExitObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 
@@ -4208,6 +4218,33 @@ typedef struct TEOV_callback {
 	TOP_CB(interp) = callbackPtr;					\
     }
 
+#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) {	\
+	TEOV_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;		\
+    }
+
+#define TclNRSpliceCallbacks(interp,topPtr) {	\
+	TEOV_callback *bottomPtr = topPtr;	\
+	while (bottomPtr->nextPtr) {		\
+	    bottomPtr = bottomPtr->nextPtr;	\
+	}					\
+	bottomPtr->nextPtr = TOP_CB(interp);	\
+	TOP_CB(interp) = topPtr;		\
+    }
+
+#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(TEOV_callback), (ptr))
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 20b28eb..8caf7db 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,10 +23,11 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.189 2009/02/10 22:50:07 nijtmans Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.190 2009/03/19 23:31:37 msofer Exp $
  */
 
 #include "tclInt.h"
+#include "tclCompile.h" /* just for NRCommand */
 
 /*
  * Thread-local storage used to avoid having a global lock on data that is not
@@ -428,7 +429,8 @@ Tcl_PushCallFrame(
     framePtr->compiledLocals = NULL;
     framePtr->clientData = NULL;
     framePtr->localCachePtr = NULL;
-
+    framePtr->tailcallPtr = NULL;
+    
     /*
      * Push the new call frame onto the interpreter's stack of procedure call
      * frames making it the current frame.
@@ -454,6 +456,7 @@ Tcl_PushCallFrame(
  *	Modifies the call stack of the interpreter. Resets various fields of
  *	the popped call frame. If a namespace has been deleted and has no more
  *	activations on the call stack, the namespace is destroyed.
+ *      Schedules a tailcall if one is present. 
  *
  *----------------------------------------------------------------------
  */
@@ -505,6 +508,30 @@ Tcl_PopCallFrame(
 	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
     }
     framePtr->nsPtr = NULL;
+
+    if (framePtr->tailcallPtr) {
+	/*
+	 * Find the splicing spot: right before the NRCommand of the thing being
+	 * tailcalled. Note that we skip NRCommands marked in data[1] (used by
+	 * command redirectors) 
+	 */
+
+	TEOV_callback *tailcallPtr, *runPtr;
+	
+	for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
+	    if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
+		break;
+	    }
+	}
+	if (!runPtr) {
+	    Tcl_Panic("Tailcall cannot find the right splicing spot: should not happen!");
+	}
+
+	tailcallPtr = framePtr->tailcallPtr;
+	
+	tailcallPtr->nextPtr = runPtr->nextPtr;
+	runPtr->nextPtr = tailcallPtr;
+    }
 }
 
 /*