duh ... committed only the ChangeLog entry, not the rest

4 files changed, 77 insertions, 67 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 98d2944..4a4c240 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.349 2008/08/03 18:00:46 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.350 2008/08/04 14:09:28 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4152,7 +4152,8 @@ TclNRRunCallbacks(
 				     * returns.  */
 {
     Interp *iPtr = (Interp *) interp;
-    TEOV_callback *callbackPtr = TOP_CB(interp);
+    TEOV_callback *callbackPtr;
+    Tcl_NRPostProc *procPtr;
 
     /*
      * If the interpreter has a non-empty string result, the result object is
@@ -4170,23 +4171,11 @@ TclNRRunCallbacks(
 
     while (TOP_CB(interp) != rootPtr) {
 	callbackPtr = TOP_CB(interp);
+	procPtr = callbackPtr->procPtr;
 
-	if (tebcCall && (callbackPtr->procPtr == NRRunBytecode)) {
-		return TCL_OK;
-	} else if (callbackPtr->procPtr == NRAtProcExit) {
-	    if (tebcCall == 1) {
-		return TCL_OK;
-	    } else if (tebcCall == 2) {
-		Tcl_SetResult(interp,
-			"atProcExit/tailcall cannot be invoked recursively", TCL_STATIC);
-	    } else {
-		Tcl_SetResult(interp,
-			"atProcExit/tailcall can only be called from a proc or lambda", TCL_STATIC);
-	    }
-	    TOP_CB(interp) = callbackPtr->nextPtr;
-	    result = TCL_ERROR;
-	    TCLNR_FREE(interp, callbackPtr);
-	    continue;
+	if (tebcCall && (procPtr == NRCallTEBC)) {
+	    NRE_ASSERT(result==TCL_OK);
+	    return TCL_OK;
 	}
 	
 	/*
@@ -4199,7 +4188,7 @@ TclNRRunCallbacks(
 	 */
 
 	TOP_CB(interp) = callbackPtr->nextPtr;
-	result = callbackPtr->procPtr(callbackPtr->data, interp, result);
+	result = (procPtr)(callbackPtr->data, interp, result);
 	TCLNR_FREE(interp, callbackPtr);
     }
     return result;
@@ -4258,31 +4247,29 @@ NRRunObjProc(
 }
 
 int
-NRRunBytecode(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    ByteCode *codePtr = data[0];
-
-    if (result == TCL_OK) {
-	return TclExecuteByteCode(interp, codePtr);
-    }
-    return result;
-}
-
-int
-NRAtProcExit(
+NRCallTEBC(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
 {
-    /* For tailcalls!
-     * drop all callbacks until the last command start: nothing to do here,
-     * just need this to be able to pass it up to tebc.
+    /*
+     * This is not run normally, the callback is passed up to tebc. This
+     function is only called when no tebc is above.
      */
-
-    return result;
+    int type = PTR2INT(data[0]);
+    
+    switch (type) {
+	case TCL_NR_BC_TYPE:
+	    return TclExecuteByteCode(interp, data[1]);
+	case TCL_NR_ATEXIT_TYPE:
+	    /* For atProcExit and tailcalls */
+	    Tcl_SetResult(interp,
+		    "atProcExit/tailcall can only be called from a proc or lambda", TCL_STATIC);
+	    return TCL_ERROR;
+	default:
+	    Tcl_Panic("unknown call type to TEBC");
+    }
+    return result; /* not reached */
 }
 
 /*
@@ -5771,7 +5758,8 @@ TclNREvalObjEx(
 
 	TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
 		    objPtr, INT2PTR(allowExceptions), NULL);
-	TclNRAddCallback(interp, NRRunBytecode, codePtr, NULL, NULL, NULL);
+	TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
+		NULL, NULL);
 	return TCL_OK;
     }
     
@@ -7880,7 +7868,8 @@ TclNRAtProcExitObjCmd(
      */
 
     TclNRAddCallback(interp, NRAtProcExitEval, listPtr, nsPtr, NULL, NULL);
-    TclNRAddCallback(interp, NRAtProcExit, clientData, NULL, NULL, NULL);
+    TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_ATEXIT_TYPE), clientData,
+	    NULL, NULL);
 
     return TCL_OK;
 }
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 68e6afe..1653ea5 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.100 2008/08/03 18:00:49 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.101 2008/08/04 14:09:31 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -837,8 +837,10 @@ typedef struct {
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE Tcl_NRPostProc   NRRunBytecode;
-MODULE_SCOPE Tcl_NRPostProc   NRAtProcExit;
+MODULE_SCOPE Tcl_NRPostProc   NRCallTEBC;
+
+#define TCL_NR_BC_TYPE         0
+#define TCL_NR_ATEXIT_TYPE     1
 
 /*
  *----------------------------------------------------------------
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 360525e..0c77b9e 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.395 2008/08/04 04:49:24 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.396 2008/08/04 14:09:31 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1831,27 +1831,27 @@ TclExecuteByteCode(
     nonRecursiveCallStart:
     if (nested) {
 	TEOV_callback *callbackPtr = TOP_CB(interp);
-	Tcl_NRPostProc *procPtr = callbackPtr->procPtr;
-	ByteCode *newCodePtr = callbackPtr->data[0];
-
-	isTailcall = PTR2INT(callbackPtr->data[0]);
+	int type = PTR2INT(callbackPtr->data[0]);
+	ClientData param = callbackPtr->data[1];
 	
 	NRE_ASSERT(result==TCL_OK);
 	NRE_ASSERT(callbackPtr != bottomPtr->rootPtr);	
-
+	NRE_ASSERT(callbackPtr->procPtr == NRCallTEBC);
+	
 	TOP_CB(interp) = callbackPtr->nextPtr;
 	TCLNR_FREE(interp, callbackPtr);
 
 	NR_DATA_BURY();
-	if (procPtr == NRRunBytecode) {
+	
+	if (type == TCL_NR_BC_TYPE) {
 	    /*
 	     * A request to run a bytecode: record this level's state
 	     * variables, swap codePtr and start running the new one.
 	     */
 	    
 	    NR_DATA_BURY();
-	    codePtr = newCodePtr;
-	} else if (procPtr == NRAtProcExit) {
+	    codePtr = param;
+	} else if (type == TCL_NR_ATEXIT_TYPE) {
 	    /*
 	     * A request to perform a command at exit: schedule the command at
 	     * its proper place, then continue or just drop the present bytecode if
@@ -1862,6 +1862,7 @@ TclExecuteByteCode(
 
 	    TOP_CB(interp) = newPtr->nextPtr;
 
+	    isTailcall = PTR2INT(param);
 	    if (!isTailcall) {	    
 #ifdef TCL_COMPILE_DEBUG
 		if (traceInstructions) {
@@ -1905,7 +1906,7 @@ TclExecuteByteCode(
 		goto abnormalReturn;
 	    }
 	} else {
-	    Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle! (1)");
+	    Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
 	}
     }
     nested = 1;
@@ -2570,7 +2571,8 @@ TclExecuteByteCode(
 	CACHE_STACK_INFO();
 	cleanup = 1;
 	pc++;
-	Tcl_NRAddCallback(interp, NRRunBytecode, newCodePtr, NULL, NULL, NULL);
+	Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), newCodePtr,
+		NULL, NULL);
 	goto nonRecursiveCallStart;
     }
 
@@ -2628,7 +2630,8 @@ TclExecuteByteCode(
 	    bcFramePtr->data.tebc.pc = (char *) pc;
 	    iPtr->cmdFramePtr = bcFramePtr;
 	    pc++;
-	    Tcl_NRAddCallback(interp, NRRunBytecode, newCodePtr, NULL, NULL, NULL);
+	    Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), newCodePtr,
+		    NULL, NULL);
 	    goto nonRecursiveCallStart;
 	}
 
@@ -7738,7 +7741,7 @@ TclExecuteByteCode(
 	bottomPtr = oldBottomPtr;        /* back to old bc */
 
       rerunCallbacks:
-	result = TclNRRunCallbacks(interp, result, bottomPtr->rootPtr, 2);
+	result = TclNRRunCallbacks(interp, result, bottomPtr->rootPtr, 1);
 	
 	NR_DATA_DIG();
 	DECACHE_STACK_INFO();
@@ -7784,16 +7787,31 @@ TclExecuteByteCode(
 		Tcl_DecrRefCount(objPtr);
 	    }
 	    goto nonRecursiveCallReturn;
-	} else 	if (TOP_CB(interp)->procPtr == NRRunBytecode) {
-	    /*
-	     * One of the callbacks requested a new execution: a tailcall!
-	     * Start the new bytecode.
-	     */
-
+	} else 	{
+	    TEOV_callback *callbackPtr = TOP_CB(iPtr);
+	    int type = PTR2INT(callbackPtr->data[0]);
+	    
+	    NRE_ASSERT(TOP_CB(interp)->procPtr == NRCallTEBC);
 	    NRE_ASSERT(result == TCL_OK);
-           goto nonRecursiveCallStart;
+
+	    if (type == TCL_NR_BC_TYPE) {
+		/*
+		 * One of the callbacks requested a new execution: a tailcall! 
+		 * Start the new bytecode.
+		 */
+		
+		goto nonRecursiveCallStart;
+	    } else if (type == TCL_NR_ATEXIT_TYPE) {
+		TOP_CB(iPtr) = callbackPtr->nextPtr;
+		TCLNR_FREE(interp, callbackPtr);
+	    
+		Tcl_SetResult(interp,
+			"atProcExit/tailcall cannot be invoked recursively", TCL_STATIC);
+		result = TCL_ERROR;
+		goto rerunCallbacks;
+	    }
 	}
-	Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle! (2)");
+	Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
     }
 
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 0cc9ae4..1fe9b39 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.154 2008/07/31 14:43:47 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.155 2008/08/04 14:09:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1772,7 +1772,8 @@ TclNRInterpProcCore(
 
     TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
 	    NULL, NULL);
-    TclNRAddCallback(interp, NRRunBytecode, codePtr, NULL, NULL, NULL);
+    TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
+	    NULL, NULL);
     return TCL_OK;
 }