Completely revamped NRE implementation, with (almost) unchanged API.

1 files changed, 137 insertions, 254 deletions

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0102f5a..0aee386 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.387 2008/07/22 21:41:55 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.388 2008/07/29 05:30:26 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -166,27 +166,26 @@ static BuiltinFunc tclBuiltinFuncTable[] = {
 /*
  * NR_TEBC
  * Helpers for NR - non-recursive calls to TEBC
+ * Minimal data required to fully reconstruct the execution state.
  */
 
 typedef struct BottomData {
-#if USE_NR_TEBC
     struct BottomData *prevBottomPtr;
-    TEOV_record *recordPtr;      /* Top record on TEOVI's cleanup stack when
-				  * this level was entered.                   */
-    ByteCode *codePtr;           /* The following data is used on return      */
-    unsigned char *pc;           /* TO this level: they record the state when */
-    ptrdiff_t *catchTop;         /* a new codePtr was received for NR         */
-    int cleanup;     		 /* execution.                                */ 
+    TEOV_callback *rootPtr;      /* State when this bytecode execution began. */
+    ByteCode *codePtr;		 /* These fields remain constant until it     */
+    CmdFrame *cmdFramePtr;       /* returns.                                  */
+                                 /* ------------------------------------------*/
+    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 */
     Tcl_Obj *auxObjList;
-#endif
 } BottomData;
 
-#if USE_NR_TEBC
-
-#define NR_DATA_INIT()			        \
+#define NR_DATA_INIT()				\
     bottomPtr->prevBottomPtr = oldBottomPtr;	\
-    bottomPtr->recordPtr = TOP_RECORD(iPtr);	\
-    bottomPtr->codePtr = codePtr
+    bottomPtr->rootPtr = TOP_CB(iPtr);	\
+    bottomPtr->codePtr = codePtr;	\
+    bottomPtr->cmdFramePtr = iPtr->cmdFramePtr
 
 #define NR_DATA_BURY()				\
     bottomPtr->pc = pc;				\
@@ -201,12 +200,13 @@ typedef struct BottomData {
     catchTop = bottomPtr->catchTop;			\
     cleanup = bottomPtr->cleanup;			\
     auxObjList = bottomPtr->auxObjList;			\
-    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr
-#endif
+    esPtr = iPtr->execEnvPtr->execStackPtr;		\
+    tosPtr = esPtr->tosPtr;				\
+    iPtr->cmdFramePtr = bottomPtr->cmdFramePtr; 
 
 #define PUSH_AUX_OBJ(objPtr)					\
     objPtr->internalRep.twoPtrValue.ptr2 = auxObjList;		\
-    auxObjList = objPtr  
+    auxObjList = objPtr
 
 #define POP_AUX_OBJ()							\
     {									\
@@ -799,8 +799,7 @@ TclCreateExecEnv(
     Tcl_IncrRefCount(eePtr->constants[0]);
     TclNewBooleanObj(eePtr->constants[1], 1);
     Tcl_IncrRefCount(eePtr->constants[1]);
-    eePtr->recordPtr = NULL;
-    eePtr->tebcCall = 0;
+    eePtr->callbackPtr = NULL;
 
     esPtr->prevPtr = NULL;
     esPtr->nextPtr = NULL;
@@ -875,7 +874,7 @@ TclDeleteExecEnv(
 
     TclDecrRefCount(eePtr->constants[0]);
     TclDecrRefCount(eePtr->constants[1]);
-    if (eePtr->recordPtr) {
+    if (eePtr->callbackPtr) {
 	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
     }
     ckfree((char *) eePtr);
@@ -1473,7 +1472,7 @@ FreeExprCodeInternalRep(
  *	This procedure compiles the script contained in a Tcl_Obj 
  *
  * Results:
- *	A pointer to the corresponding ByteCode
+ *	A pointer to the corresponding ByteCode, never NULL.
  *
  * Side effects:
  *	The object is shimmered to bytecode type
@@ -1752,9 +1751,7 @@ TclExecuteByteCode(
     /* NR_TEBC */
 
     BottomData *bottomPtr;
-#if USE_NR_TEBC
     BottomData *oldBottomPtr = NULL;
-#endif
     
     /*
      * Constants: variables that do not change during the execution, used
@@ -1793,10 +1790,7 @@ TclExecuteByteCode(
 
     register int cleanup;
     Tcl_Obj *objResultPtr;
-    int evalFlags = TCL_EVAL_NOERR;
-#if (USE_NR_TEBC)
-    int tailcall = 0;
-#endif    
+
     /*
      * Result variable - needed only when going to checkForcatch or other
      * error handlers; also used as local in some opcodes.
@@ -1826,13 +1820,47 @@ TclExecuteByteCode(
      * execution stack is large enough to execute this ByteCode.
      */
 
-    /*
-     * NR_TEBC
-     */
+    int nested = 0;
     
-#if USE_NR_TEBC
     nonRecursiveCallStart:
+    if (nested) {
+	TEOV_callback *callbackPtr = TOP_CB(interp);
+	Tcl_NRPostProc *procPtr = callbackPtr->procPtr;
+	ByteCode *newCodePtr = callbackPtr->data[0];
+
+	assert((result==TCL_OK));
+	assert((callbackPtr != bottomPtr->rootPtr));	
+
+	TOP_CB(interp) = callbackPtr->nextPtr;
+	TCLNR_FREE(interp, callbackPtr);
+
+	if (procPtr == NRRunBytecode) {
+	    NR_DATA_BURY(); /* this level's state variables */
+	    codePtr = newCodePtr;
+	} else if (procPtr == NRDropCommand) {
+	    /*
+	     * A request to perform a tailcall: just drop this
+	     * bytecode as it is; the tailCall has been scheduled in
+	     * the callbacks.
+	     */
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		fprintf(stdout, "   Tailcall: request received\n");
+	    }
 #endif
+	    if (catchTop != initCatchTop) {
+		result = TCL_ERROR;
+		Tcl_SetResult(interp,"Tailcall called from within a catch environment",
+			TCL_STATIC);
+		goto checkForCatch;
+	    }
+	    goto abnormalReturn; /* drop a level */
+	} else {
+	    Tcl_Panic("TEBC: TRCB sent us a record we cannot handle! (1)");
+	}
+    }
+    nested = 1;
+    
     codePtr->refCount++;
     bottomPtr = (BottomData *) GrowEvaluationStack(iPtr->execEnvPtr,
 	    sizeof(BottomData) + codePtr->maxExceptDepth + sizeof(CmdFrame)
@@ -1840,12 +1868,9 @@ TclExecuteByteCode(
     curInstName = NULL;
     auxObjList = NULL;
     initLevel = 1;
-    
-#if USE_NR_TEBC
     NR_DATA_INIT(); /* record this level's data */
-    
+
     nonRecursiveCallReturn:  
-#endif
     bcFramePtr = (CmdFrame *) (bottomPtr + 1);
     initCatchTop = ((ptrdiff_t *) (bcFramePtr + 1)) - 1;
     initTosPtr = (Tcl_Obj **) (initCatchTop + codePtr->maxExceptDepth);
@@ -1880,10 +1905,6 @@ TclExecuteByteCode(
 
 	TclArgumentBCEnter((Tcl_Interp*) iPtr,codePtr,bcFramePtr);
 
-#if (USE_NR_TEBC)
-    } else if (tailcall) {
-	    goto tailcallEntry;	    
-#endif
     } else {
 	/*
 	 * Returning from a non-recursive call. State is already completely
@@ -2475,6 +2496,25 @@ TclExecuteByteCode(
 	NEXT_INST_F(5, 0, 0);
     }
 
+    case INST_EXPR_STK: {
+	/*
+	 * Moved here to support transforming the eval of an expression to
+	 * a non-recursive TEBC call.
+	 */
+	
+	ByteCode *newCodePtr;
+	
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;	    
+	DECACHE_STACK_INFO();
+	newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
+	CACHE_STACK_INFO();
+	cleanup = 1;
+	pc++;
+	Tcl_NRAddCallback(interp, NRRunBytecode, newCodePtr, NULL, NULL, NULL);
+	goto nonRecursiveCallStart;
+    }
+
     {
 	/*
 	 * INVOCATION BLOCK
@@ -2482,70 +2522,7 @@ TclExecuteByteCode(
 
 	int objc, pcAdjustment;
 	Tcl_Obj **objv;
-#if (USE_NR_TEBC)
-	TEOV_record *recordPtr;
-	ByteCode *newCodePtr;
-#endif
 	
-	case INST_EXPR_STK: {
-	    /*
-	     * Moved here to support transforming the eval of an expression to
-	     * a non-recursive TEBC call.
-	     */
-
-#if (USE_NR_TEBC)
-	    pcAdjustment = 1;
-	    cleanup = 1;
-	    bcFramePtr->data.tebc.pc = (char *) pc;
-	    iPtr->cmdFramePtr = bcFramePtr;	    
-	    DECACHE_STACK_INFO();
-	    newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
-	    CACHE_STACK_INFO();
-	    goto tebc_do_exec;
-#else
-	    Tcl_Obj *objPtr, *valuePtr;
-
-	    objPtr = OBJ_AT_TOS;
-
-	    DECACHE_STACK_INFO();
-	    /*Tcl_ResetResult(interp);*/
-	    result = Tcl_ExprObj(interp, objPtr, &valuePtr);
-	    CACHE_STACK_INFO();
-	    if (result == TCL_OK) {
-		objResultPtr = valuePtr;
-		TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
-		NEXT_INST_F(1, 1, -1);	/* Already has right refct. */
-	    } else {
-		TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
-			Tcl_GetObjResult(interp));
-		cleanup = 1;
-		goto checkForCatch;
-	    }
-#endif
-	}
-
-#if (USE_NR_TEBC)
-	tailcallEntry: {
-	    TEOV_record *recordPtr = TOP_RECORD(iPtr);
-
-	    /*
-	     * We take over the record's object, with its refCount. Clear the
-	     * record type so that it is not freed again when popping the
-	     * record. 
-	     */
-	    
-	    recordPtr->type = TCL_NR_NO_TYPE;
-	    *++tosPtr = recordPtr->data.obj.objPtr;
-	    evalFlags = recordPtr->data.obj.flags;
-	    recordPtr->type = TCL_NR_NO_TYPE;
-#ifdef TCL_COMPILE_DEBUG
-		if (traceInstructions) {
-		    fprintf(stdout, "   Tailcall: pushing obj with refCount %i\n",
-			    (OBJ_AT_TOS)->refCount);
-		}
-#endif
-	}
-#endif
 	case INST_EVAL_STK: {
 	    /*
 	     * Moved here to support transforming the eval of objects to a
@@ -2554,10 +2531,10 @@ TclExecuteByteCode(
 	     */
 	    
 	    Tcl_Obj *objPtr = OBJ_AT_TOS;
+	    ByteCode *newCodePtr;
 
 	    cleanup = 1;
-	    pcAdjustment = !tailcall;
-	    tailcall = 0;
+	    pcAdjustment = 1;
 		
 	    if (objPtr->typePtr == &tclListType) {	/* is a list... */
 		List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
@@ -2580,59 +2557,20 @@ TclExecuteByteCode(
 	    }
 	    
 	    /*
+	     * Run the bytecode in this same TEBC instance!
+	     *
 	     * TIP #280: The invoking context is left NULL for a dynamically
 	     * constructed command. We cannot match its lines to the outer
 	     * context.
-	     */	    
+	     */
 	    
 	    DECACHE_STACK_INFO();
 	    newCodePtr = TclCompileObj(interp, objPtr, NULL, 0);
-	    if (newCodePtr) {
-		/*
-		 * Run the bytecode in this same TEBC instance!
-		 */
-#if (USE_NR_TEBC)
-		bcFramePtr->data.tebc.pc = (char *) pc;
-		iPtr->cmdFramePtr = bcFramePtr;
-		goto tebc_do_exec;
-#else
-		result = TclExecuteByteCode(interp, newCodePtr);
-		CACHE_STACK_INFO();
-		
-		if (result == TCL_OK) {
-		    /*
-		     * Normal return; push the eval's object result.
-		     */
-		    
-		    objResultPtr = Tcl_GetObjResult(interp);
-		    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
-			    Tcl_GetObjResult(interp));
-		    
-		    /*
-		     * Reset the interp's result to avoid possible duplications of
-		     * large objects [Bug 781585]. We do not call Tcl_ResetResult to
-		     * avoid any side effects caused by the resetting of errorInfo and
-		     * errorCode [Bug 804681], which are not needed here. We chose
-		     * instead to manipulate the interp's object result directly.
-		     *
-		     * Note that the result object is now in objResultPtr, it keeps
-		     * the refCount it had in its role of iPtr->objResultPtr.
-		     */
-		    
-		    TclNewObj(objPtr);
-		    Tcl_IncrRefCount(objPtr);
-		    iPtr->objResultPtr = objPtr;
-		    NEXT_INST_F(1, 1, -1);
-		}
-#endif
-	    }
-	    
-	    /*
-	     * Compilation failed, error
-	     */
-	    
-	    result = TCL_ERROR;
-	    goto processExceptionReturn;
+	    bcFramePtr->data.tebc.pc = (char *) pc;
+	    iPtr->cmdFramePtr = bcFramePtr;
+	    pc++;
+	    Tcl_NRAddCallback(interp, NRRunBytecode, newCodePtr, NULL, NULL, NULL);
+	    goto nonRecursiveCallStart;
 	}
 
     case INST_INVOKE_EXPANDED:
@@ -2708,55 +2646,17 @@ TclExecuteByteCode(
 
 	    DECACHE_STACK_INFO();
 
-#if (USE_NR_TEBC)
-	    TEBC_CALL(iPtr) = 1;
-	    recordPtr = TOP_RECORD(iPtr);
-#endif
-	    result = TclEvalObjv(interp, objc, objv, evalFlags, NULL);
+	    result = TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, NULL);
+	    result = TclNRRunCallbacks(interp, result, bottomPtr->rootPtr, 1);
 	    CACHE_STACK_INFO();
-#if (USE_NR_TEBC)
-	    evalFlags = TCL_EVAL_NOERR;
-	    if (TOP_RECORD(iPtr) != recordPtr) {
-		assert((result == TCL_OK));
-		recordPtr = TOP_RECORD(iPtr);
-		switch(recordPtr->type) {
-		case TCL_NR_BC_TYPE:
-		    newCodePtr = recordPtr->data.codePtr;
-		tebc_do_exec:
-		    /*
-		     * A request to execute a bytecode came back. We save
-		     * the current state and restart at the top.
-		     */
 
-		    pc += pcAdjustment;
-		    NR_DATA_BURY(); /* this level's state variables */
-		    codePtr = newCodePtr;
-		    goto nonRecursiveCallStart;
-		case TCL_NR_TAILCALL_TYPE:
-		    /*
-		     * A request to perform a tailcall: just drop this
-		     * bytecode as it is; the tailCall has been scheduled in
-		     * the callbacks.
-		     */
-#ifdef TCL_COMPILE_DEBUG
-		    if (traceInstructions) {
-			fprintf(stdout, "   Tailcall: request received\n");
-		    }
-#endif
-		    if (catchTop != initCatchTop) {
-			result = TCL_ERROR;
-			Tcl_SetResult(interp,"Tailcall called from within a catch environment",
-				TCL_STATIC);
-			goto checkForCatch;
-		    }
-		    goto abnormalReturn; /* drop a level */
-		default:
-		    Tcl_Panic("TEBC: TEOV sent us a record we cannot handle!");
-		}
+	    if (TOP_CB(interp) != bottomPtr->rootPtr) {
+		assert ((result == TCL_OK));
+		pc += pcAdjustment;		
+		goto nonRecursiveCallStart;
 	    }
-#endif
 	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
-
+	    
 	    if (result == TCL_OK) {
 		Tcl_Obj *objPtr;
 #ifndef TCL_COMPILE_DEBUG
@@ -7762,81 +7662,64 @@ TclExecuteByteCode(
 
     TclArgumentBCRelease((Tcl_Interp*) iPtr,codePtr);
 
-#if USE_NR_TEBC
     oldBottomPtr = bottomPtr->prevBottomPtr;
-#endif
     TclStackFree(interp, bottomPtr);     /* free my stack */
 
     if (--codePtr->refCount <= 0) {
 	TclCleanupByteCode(codePtr);
     }
 
-#if USE_NR_TEBC
     if (oldBottomPtr) {
 	/*
 	 * Restore the state to what it was previous to this bytecode.
-	 *
-	 * NR_TEBC
 	 */
-	bottomPtr = oldBottomPtr;        /* back to old bc */
+
+	bottomPtr = oldBottomPtr;        /* back to old bc */	
+	result = TclNRRunCallbacks(interp, result, bottomPtr->rootPtr, 1);
 	
-	/* Please free anything that might still be on my new stack */
-      resumeCleanup:
-	if (TOP_RECORD(iPtr) != bottomPtr->recordPtr) {
-	    CACHE_STACK_INFO();
-	    result = TclEvalObjv_NR2(interp, result, bottomPtr->recordPtr);
-	    if (TOP_RECORD(iPtr) != bottomPtr->recordPtr) {
-		TEOV_record *recordPtr = TOP_RECORD(iPtr);
+	NR_DATA_DIG();
+	DECACHE_STACK_INFO();
+	if (TOP_CB(interp) == bottomPtr->rootPtr) {
+	    /*
+	     * The bytecode is returning, remove the caller's arguments and
+	     * keep processing the caller.
+	     */
+	    
+	    while (cleanup--) {
+		Tcl_Obj *objPtr = POP_OBJECT();
+		Tcl_DecrRefCount(objPtr);
+	    }
+	    goto nonRecursiveCallReturn;
+	} else {
+	    /*
+	     * A request for a new execution: a tailcall. Remove the caller's
+	     * arguments and start the new bytecode.
+	     *
+	     * FIXME KNOWNBUG: we get a pointer smash if we do remove the
+	     * arguments, a leak otherwise: tailcalls are not yet quite
+	     * there. Chose to leave the leak for now.
+	     */
 		
-		assert((result == TCL_OK));
-
-		/*
-		 * A callback scheduled a new evaluation: process it.
-		 */
-
-		switch(recordPtr->type) {
-		    case TCL_NR_BC_TYPE:
-			codePtr = recordPtr->data.codePtr;
-			goto nonRecursiveCallStart;
-		    case TCL_NR_TAILCALL_TYPE:
-			/* FIXME NRE tailcall*/			
-			Tcl_Panic("Tailcall called from a callback!");
-			NR_DATA_DIG();
-			esPtr = iPtr->execEnvPtr->execStackPtr;
-			goto abnormalReturn; /* drop a level */
-		    case TCL_NR_CMD_TYPE: 
-		    case TCL_NR_SCRIPT_TYPE:
-			/*
-			 * FIXME NRE tailcall: error messages will be all wrong?
-			 */
-#ifdef TCL_COMPILE_DEBUG
-			if (traceInstructions) {
-			    fprintf(stdout, "   Tailcall: eval request received from callback\n");
-			}
-#endif
-			tailcall = 1;
-			goto restoreStateVariables;
-		    case TCL_NR_CMDSWAP_TYPE:
-			result = TclEvalObjv(interp, recordPtr->data.objcv.objc,
-				recordPtr->data.objcv.objv, 0, recordPtr->cmdPtr);
-			goto resumeCleanup;
-		    default:
-			Tcl_Panic("TEBC: TEOV_NR2 sent us a record we cannot handle!");
+	    TEOV_callback *callbackPtr = TOP_CB(interp);
+	    Tcl_NRPostProc *procPtr = callbackPtr->procPtr;
+
+	    if (procPtr == NRRunBytecode) {
+		goto nonRecursiveCallStart;
+	    } else if (procPtr == NRDropCommand) {
+		/* FIXME: 'tailcall tailcall' not yet working */
+		Tcl_Panic("Tailcalls from within tailcalls are not yet implemented");
+		if (catchTop != initCatchTop) {
+		    result = TCL_ERROR;
+		    Tcl_SetResult(interp,"Tailcall called from within a catch environment",
+			    TCL_STATIC);
+		    goto checkForCatch;
 		}
+		goto abnormalReturn; /* drop a level */
+	    } else {
+		Tcl_Panic("TEBC: TEOV sent us a record we cannot handle! (2)");		
 	    }
 	}
-      restoreStateVariables:
-	NR_DATA_DIG();
-	esPtr = iPtr->execEnvPtr->execStackPtr;
-	tosPtr = esPtr->tosPtr;
-	while (cleanup--) {
-	    Tcl_Obj *objPtr = POP_OBJECT();
-	    Tcl_DecrRefCount(objPtr);
-	}
-	CACHE_STACK_INFO();
-	goto nonRecursiveCallReturn;
     }
-#endif
     return result;
 }
 #undef iPtr