summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCompCmds.c29
-rw-r--r--generic/tclCompile.c5
-rw-r--r--generic/tclCompile.h5
-rw-r--r--generic/tclExecute.c59
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclOO.c9
-rw-r--r--generic/tclOOBasic.c12
7 files changed, 109 insertions, 14 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 160fa3c..917fd20 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -5919,6 +5919,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 309682d..e7462e6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -491,6 +491,7 @@ 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. */
@@ -529,6 +530,10 @@ InstructionDesc const tclInstructionTable[] = {
/* Forces the variable indexed by opnd to be an array. Does not touch
* 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 3302f9b..42f55cd 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -700,6 +700,8 @@ typedef struct ByteCode {
#define INST_INFO_LEVEL_NUM 152
#define INST_INFO_LEVEL_ARGS 153
#define INST_RESOLVE_COMMAND 154
+
+/* For compilation relating to TclOO */
#define INST_TCLOO_SELF 155
#define INST_TCLOO_CLASS 156
#define INST_TCLOO_NS 157
@@ -710,9 +712,10 @@ typedef struct ByteCode {
#define INST_ARRAY_EXISTS_IMM 160
#define INST_ARRAY_MAKE_STK 161
#define INST_ARRAY_MAKE_IMM 162
+#define INST_TCLOO_NEXT 163
/* The last opcode */
-#define LAST_INST_OPCODE 162
+#define LAST_INST_OPCODE 163
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index caf35ba..2fe4ca1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4310,10 +4310,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"));
@@ -4332,6 +4340,52 @@ 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);
}
{
Object *oPtr;
@@ -4368,6 +4422,7 @@ TEBCresume(
}
/*
+ * End of TclOO support instructions.
* -----------------------------------------------------------------
* Start of INST_LIST and related instructions.
*/
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1d04c82..95f8602 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);
@@ -3644,6 +3645,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)
generated by cgit v0.12 at 2024-12-04 08:30:57 (GMT)