* generic/tclBasic.c: Redesign of [tailcall] to

	* generic/tclCmdAH.c:    (a) fix #3047235
	* generic/tclCompile.h:  (b) enable fix for #3046594
	* generic/tclExecute.c:  (c) enable recursive tailcalls
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* tests/tailcall.test:

6 files changed, 45 insertions, 82 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5fd559d..5b767fe 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.460 2010/08/11 23:13:50 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.461 2010/08/18 15:44:10 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4398,13 +4398,6 @@ NRCallTEBC(
     switch (type) {
     case TCL_NR_BC_TYPE:
 	return TclExecuteByteCode(interp, data[1]);
-    case TCL_NR_TAILCALL_TYPE:
-	/* For tailcalls */
-	Tcl_SetResult(interp,
-		"tailcall can only be called from a proc or lambda",
-		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
-	return TCL_ERROR;
     case TCL_NR_YIELD_TYPE:
 	if (iPtr->execEnvPtr->corPtr) {
 	    Tcl_SetResult(interp, "cannot yield: C stack busy", TCL_STATIC);
@@ -8294,14 +8287,12 @@ Tcl_NRCmdSwap(
 void
 TclSpliceTailcall(
     Tcl_Interp *interp,
-    TEOV_callback *tailcallPtr,
-    int skip)
+    TEOV_callback *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), and we skip the first command that we
-     * find if requested to do so: it corresponds to [tailcall] itself.
+     * (used by command redirectors).
      */
 
     Interp *iPtr = (Interp *) interp;
@@ -8311,10 +8302,7 @@ TclSpliceTailcall(
   restart:
     for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
 	if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
-	    if (!skip) {
-		break;
-	    }
-	    skip = 0;
+            break;
 	}
     }
     if (!runPtr) {
@@ -8393,9 +8381,8 @@ TclNRTailcallObjCmd(
     TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
     tailcallPtr = TOP_CB(interp);
     TOP_CB(interp) = tailcallPtr->nextPtr;
-
-    TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_TAILCALL_TYPE),
-	    tailcallPtr, NULL, NULL);
+    iPtr->varFramePtr->tailcallPtr = tailcallPtr;
+    
     return TCL_OK;
 }
 
@@ -8444,6 +8431,26 @@ TclClearTailcall(
     TCLNR_FREE(interp, tailcallPtr);
 }
 
+int
+TclNRBlockTailcall(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if (iPtr->varFramePtr->tailcallPtr) {
+	TclClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
+	iPtr->varFramePtr->tailcallPtr = NULL;
+	result = TCL_ERROR;
+	Tcl_SetResult(interp,"tailcall called from within a catch environment",
+		TCL_STATIC);
+	Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
+		NULL);
+    }
+    return result;
+}
+
 
 void
 Tcl_NRAddCallback(
@@ -8612,7 +8619,7 @@ YieldToCallback(
     cbPtr = TOP_CB(interp);
     TOP_CB(interp) = cbPtr->nextPtr;
 
-    TclSpliceTailcall(interp, cbPtr, 0);
+    TclSpliceTailcall(interp, cbPtr);
     return TCL_OK;
 }
 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 6456bd5..e8a249f 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.124 2010/03/05 14:34:03 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.125 2010/08/18 15:44:12 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -290,13 +290,15 @@ TclNRCatchObjCmd(
 	optionVarNamePtr = objv[3];
     }
 
+    TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
+	    varNamePtr, optionVarNamePtr, NULL);
+    TclNRAddCallback(interp, TclNRBlockTailcall, NULL, NULL, NULL,
+	    NULL);
+
     /*
      * TIP #280. Make invoking context available to caught script.
      */
 
-    TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
-	    varNamePtr, optionVarNamePtr, NULL);
-
     return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
 }
 
@@ -313,19 +315,6 @@ CatchObjCmdCallback(
     int rewind = iPtr->execEnvPtr->rewind;
 
     /*
-     * catch has to disable any tailcall
-     */
-
-    if (iPtr->varFramePtr->tailcallPtr) {
-	TclClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
-	iPtr->varFramePtr->tailcallPtr = NULL;
-	result = TCL_ERROR;
-	Tcl_SetResult(interp,"Tailcall called from within a catch environment",
-		TCL_STATIC);
-    }
-
-
-    /*
      * We disable catch in interpreters where the limit has been exceeded.
      */
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index e73ce73..686f508 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.125 2010/04/29 23:39:32 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.126 2010/08/18 15:44:12 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -869,8 +869,7 @@ MODULE_SCOPE Tcl_ObjCmdProc	NRInterpCoroutine;
 
 #define TCL_NR_BC_TYPE		0
 #define TCL_NR_ATEXIT_TYPE	1
-#define TCL_NR_TAILCALL_TYPE	2
-#define TCL_NR_YIELD_TYPE	3
+#define TCL_NR_YIELD_TYPE	2
 
 /*
  *----------------------------------------------------------------
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 249d748..c3201a5 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.489 2010/07/19 14:10:43 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.490 2010/08/18 15:44:12 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2851,33 +2851,6 @@ TclExecuteByteCode(
 		    OBP = BP;
 		    goto resumeCoroutine;
 		}
-	    case TCL_NR_TAILCALL_TYPE:
-		/*
-		 * A request to perform a tailcall: just drop this bytecode.
-		 */
-
-#ifdef TCL_COMPILE_DEBUG
-		if (TAUX.traceInstructions) {
-		    fprintf(stdout, "   Tailcall request received\n");
-		}
-#endif /* TCL_COMPILE_DEBUG */
-		iPtr->cmdFramePtr = bcFramePtr->nextPtr;
-		TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
-
-		if (catchTop != initCatchTop) {
-		    TclClearTailcall(interp, param);
-		    iPtr->varFramePtr->tailcallPtr = NULL;
-		    Tcl_SetResult(interp,
-			    "tailcall called from within a catch environment",
-			    TCL_STATIC);
-		    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
-			    NULL);
-		    pc--;
-		    goto gotError;
-		}
-		iPtr->varFramePtr->tailcallPtr = param;
-		TclSpliceTailcall(interp, param, 1);
-		goto abnormalReturn;
 	    case TCL_NR_YIELD_TYPE: {		/* [yield] */
 		CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
 
@@ -6592,7 +6565,6 @@ TclExecuteByteCode(
   returnToCaller:
     if (OBP) {
 	BP = OBP; /* back to old bc */
-    rerunCallbacks:
 	TRESULT = TclNRRunCallbacks(interp, TRESULT, BP->rootPtr, 1);
 
 	NR_DATA_DIG();
@@ -6618,15 +6590,6 @@ TclExecuteByteCode(
 		 */
 
 		goto nonRecursiveCallSetup;
-	    case TCL_NR_TAILCALL_TYPE:
-		TOP_CB(iPtr) = callbackPtr->nextPtr;
-		TCLNR_FREE(interp, callbackPtr);
-
-		Tcl_SetResult(interp,
-			"tailcall cannot be invoked recursively", TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "REENTRY", NULL);
-		TRESULT = TCL_ERROR;
-		goto rerunCallbacks;
 	    default:
 		Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
 	    }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3d30581..2f18375 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.479 2010/08/14 17:13:02 nijtmans Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.480 2010/08/18 15:44:12 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -2759,8 +2759,9 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
 MODULE_SCOPE void	TclClearTailcall(Tcl_Interp *interp,
 			    struct TEOV_callback *tailcallPtr);
 MODULE_SCOPE void       TclSpliceTailcall(Tcl_Interp *interp,
-	                    struct TEOV_callback *tailcallPtr,
-	                    int skip);
+	                    struct TEOV_callback *tailcallPtr);
+MODULE_SCOPE Tcl_NRPostProc TclNRBlockTailcall;
+
 
 /*
  * This structure holds the data for the various iteration callbacks used to
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 12fb46e..401eea4 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * 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.209 2010/06/08 12:54:38 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.210 2010/08/18 15:44:13 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -391,6 +391,10 @@ Tcl_PopCallFrame(
 	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
     }
     framePtr->nsPtr = NULL;
+
+    if (framePtr->tailcallPtr) {
+        TclSpliceTailcall(interp, framePtr->tailcallPtr);
+    }
 }
 
 /*