Working towards a BCCed [next].

This version <i>almost</i> works, except for a problem with restoring the
context namespace upon return (which produces very strange results!)

7 files changed, 108 insertions, 14 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5beb7bd..96bb9a4 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -5535,6 +5535,35 @@ IndexTailVarIfKnown(
     return localIndex;
 }
 
+/*
+ * Compilations of commands relating to TclOO.
+ */
+
+int
+TclCompileObjectNextCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    int i;
+
+    if (parsePtr->numWords > 255) {
+	return TCL_ERROR;
+    }
+
+    for (i=0 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt1(	INST_TCLOO_NEXT, i,		envPtr);
+    return TCL_OK;
+}
+
 int
 TclCompileObjectSelfCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index ee8511c..188b3f8 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -484,9 +484,13 @@ InstructionDesc const tclInstructionTable[] = {
 	 * qualified version, or produces the empty string if no such command
 	 * exists. Never generates errors.
 	 * Stack:  ... cmdName => ... fullCmdName */
+
     {"tclooSelf",	 1,	+1,	  0,	{OPERAND_NONE}},
 	/* Push the identity of the current TclOO object (i.e., the name of
 	 * its current public access command) on the stack. */
+    {"tclooNext",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
+	/* Push the identity of the current TclOO object (i.e., the name of
+	 * its current public access command) on the stack. */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 08d59fd..e623e87 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -698,10 +698,13 @@ typedef struct ByteCode {
 #define INST_INFO_LEVEL_NUM		150
 #define INST_INFO_LEVEL_ARGS		151
 #define INST_RESOLVE_COMMAND		152
+
+/* For compilation relating to TclOO */
 #define INST_TCLOO_SELF			153
+#define INST_TCLOO_NEXT			154
 
 /* The last opcode */
-#define LAST_INST_OPCODE		153
+#define LAST_INST_OPCODE		154
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1e24cb3..f6b99bf 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4208,10 +4208,18 @@ TEBCresume(
 	TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr);
 	NEXT_INST_F(1, 1, 1);
     }
-    case INST_TCLOO_SELF: {
-	CallFrame *framePtr = iPtr->varFramePtr;
+
+    /*
+     * -----------------------------------------------------------------
+     *	   Start of TclOO support instructions.
+     */
+
+    {
+	CallFrame *framePtr;
 	CallContext *contextPtr;
 
+    case INST_TCLOO_SELF:
+	framePtr = iPtr->varFramePtr;
 	if (framePtr == NULL ||
 		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
 	    TRACE(("=> ERROR: no TclOO call context\n"));
@@ -4230,9 +4238,56 @@ TEBCresume(
 	objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
+
+    case INST_TCLOO_NEXT:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	framePtr = iPtr->varFramePtr;
+	if (framePtr == NULL ||
+		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	    TRACE(("%d => ERROR: no TclOO call context\n", opnd));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "next may only be called from inside a method",
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+	    goto gotError;
+	}
+	contextPtr = framePtr->clientData;
+
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
+
+	if (iPtr->flags & INTERP_DEBUG_FRAME) {
+	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+		    codePtr, bcFramePtr, pc - codePtr->codeStart);
+	}
+
+	pcAdjustment = 2;
+	cleanup = opnd;
+	DECACHE_STACK_INFO();
+
+	/*
+	 * BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG
+	 *
+	 * Bug somewhere near here. The iPtr->varFramePtr must be updated as
+	 * below, but TclOONextRestoreFrame (in tclOOBasic.c) seems to be
+	 * unable to restore the frame upon return...
+	 *
+	 * If TclOONextRestoreFrame is wrong for use here (and it might be!)
+	 * it should be copied to this file and adjusted afterwards. It is
+	 * *correct* for its other uses.
+	 */
+
+	iPtr->varFramePtr = framePtr->callerVarPtr;
+	TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr,
+		NULL, NULL, NULL);
+	pc += pcAdjustment;
+	TEBC_YIELD();
+	return TclNRObjectContextInvokeNext(interp,
+		(Tcl_ObjectContext) contextPtr, opnd, &OBJ_AT_DEPTH(opnd-1), 1);
     }
 
     /*
+     *     End of TclOO support instructions.
      * -----------------------------------------------------------------
      *	   Start of INST_LIST and related instructions.
      */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1fffa1f..549ada9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2804,6 +2804,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
+MODULE_SCOPE Tcl_NRPostProc TclOONextRestoreFrame;
 
 MODULE_SCOPE void  TclSpliceTailcall(Tcl_Interp *interp,
 	               struct NRE_callback *tailcallPtr);
@@ -3620,6 +3621,9 @@ MODULE_SCOPE int	TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileObjectNextCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileObjectSelfCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/generic/tclOO.c b/generic/tclOO.c
index d6d2d6a..68ed766 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -437,10 +437,11 @@ InitFoundation(
      * ensemble.
      */
 
-    Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
-	    NULL, NULL);
+    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
+	    NULL, TclOONextObjCmd, NULL, NULL);
+    cmdPtr->compileProc = TclCompileObjectNextCmd;
+    Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+	    NULL, TclOONextToObjCmd, NULL, NULL);
     cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
 	    TclOOSelfObjCmd, NULL, NULL);
     cmdPtr->compileProc = TclCompileObjectSelfCmd;
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 0676618..cd57063 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -25,8 +25,6 @@ static int		FinalizeConstruction(ClientData data[],
 			    Tcl_Interp *interp, int result);
 static int		FinalizeEval(ClientData data[],
 			    Tcl_Interp *interp, int result);
-static int		RestoreFrame(ClientData data[],
-			    Tcl_Interp *interp, int result);
 
 /*
  * ----------------------------------------------------------------------
@@ -805,7 +803,7 @@ TclOONextObjCmd(
      * that this is like [uplevel 1] and not [eval].
      */
 
-    TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
+    TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr, NULL,NULL,NULL);
     iPtr->varFramePtr = framePtr->callerVarPtr;
     return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
 }
@@ -874,8 +872,8 @@ TclOONextToObjCmd(
 	     * context. Note that this is like [uplevel 1] and not [eval].
 	     */
 
-	    TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
-		    INT2PTR(contextPtr->index), NULL);
+	    TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr,
+		    contextPtr, INT2PTR(contextPtr->index), NULL);
 	    contextPtr->index = i-1;
 	    iPtr->varFramePtr = framePtr->callerVarPtr;
 	    return TclNRObjectContextInvokeNext(interp,
@@ -904,8 +902,8 @@ TclOONextToObjCmd(
     return TCL_ERROR;
 }
 
-static int
-RestoreFrame(
+int
+TclOONextRestoreFrame(
     ClientData data[],
     Tcl_Interp *interp,
     int result)