From 62d36886b926591b14c230558c64c8ccc85cbb82 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Thu, 7 Aug 2008 04:13:49 +0000
Subject: 	* generic/tclBasic.c:   Fix tailcalls falling out of tebc into
 	* generic/tclExecute.c: Tcl_EvalEx [Bug 2017946] 	*
 generic/tclInt.h:

---
 ChangeLog            |  8 +++++++-
 generic/tclBasic.c   | 16 ++++++++++++++--
 generic/tclExecute.c | 16 +++++++---------
 generic/tclInt.h     |  7 ++++++-
 4 files changed, 34 insertions(+), 13 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index f97328a..a4cd4d8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,10 @@
-2008-08-04  Don Porter  <dgp@users.sourceforge.net>S
+2008-08-07  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclBasic.c:   Fix tailcalls falling out of tebc into 
+	* generic/tclExecute.c: Tcl_EvalEx [Bug 2017946]
+	* generic/tclInt.h:
+	
+2008-08-06  Don Porter  <dgp@users.sourceforge.net>S
 
 	* generic/tclOO.c:	Revised TclOO's check for an interp
 	being deleted during handling of object command deletion.  The
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4a4c240..1133c4c 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.350 2008/08/04 14:09:28 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.351 2008/08/07 04:13:50 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -691,7 +691,8 @@ Tcl_CreateInterp(void)
 #endif
     iPtr->pendingObjDataPtr = NULL;
     iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
-
+    iPtr->atExitPtr = NULL;
+    
     /*
      * Create the core commands. Do it here, rather than calling
      * Tcl_CreateCommand, because it's faster (there's no need to check for a
@@ -4169,6 +4170,7 @@ TclNRRunCallbacks(
 	(void) Tcl_GetObjResult(interp);
     }
 
+    restart:
     while (TOP_CB(interp) != rootPtr) {
 	callbackPtr = TOP_CB(interp);
 	procPtr = callbackPtr->procPtr;
@@ -4191,6 +4193,16 @@ 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;
 }
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 87695ba..614a3d9 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.398 2008/08/05 15:52:23 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.399 2008/08/07 04:13:51 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -7832,20 +7832,18 @@ TclExecuteByteCode(
 	NRE_ASSERT(lastPtr->nextPtr == NULL);
 	if (!isTailcall) {
 	    /* save the interp state, arrange for restoring it after
-	       running the callbacks.*/
+	       running the callbacks. Put the callback at the bottom of the
+	       atExit stack */
 	    
 	    Tcl_InterpState state = Tcl_SaveInterpState(interp, result);
 	    
 	    TclNRAddCallback(interp, NRRestoreInterpState, state, NULL,
 		    NULL, NULL);
+	    lastPtr->nextPtr = TOP_CB(iPtr);
+	    TOP_CB(iPtr) = TOP_CB(iPtr)->nextPtr;
+	    lastPtr->nextPtr->nextPtr = NULL;
 	}
-	
-	/*
-	 * splice in the atExit callbacks and rerun all callbacks
-	 */
-	
-	lastPtr->nextPtr = TOP_CB(interp);
-	TOP_CB(interp) = atExitPtr;
+	iPtr->atExitPtr = atExitPtr;
     }
 
     return result;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a7991ab..5b8f104 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.388 2008/08/03 17:49:09 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.389 2008/08/07 04:13:52 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -1964,6 +1964,11 @@ 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. */
+    
 #ifdef TCL_COMPILE_STATS
     /*
      * Statistical information about the bytecode compiler and interpreter's
-- 
cgit v0.12