summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmdsGR.c35
-rw-r--r--generic/tclCompile.c5
-rw-r--r--generic/tclCompile.h6
-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, 116 insertions, 14 deletions
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index df8895f..b8a7e0f 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -3039,6 +3039,41 @@ IndexTailVarIfKnown(
return localIndex;
}
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclCompileObjectNextCmd, TclCompileObjectSelfCmd --
+ *
+ * Compilations of the TclOO utility commands [next] and [self].
+ *
+ * ----------------------------------------------------------------------
+ */
+
+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 0732fe5..ee67e24 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -493,6 +493,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. */
@@ -616,6 +617,10 @@ InstructionDesc const tclInstructionTable[] = {
* of the command named on the top of the stack.
* Stack: ... cmdName => ... fullOriginalCmdName */
+ {"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 fb66e90..6ecadf4 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -751,6 +751,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
@@ -788,8 +790,10 @@ typedef struct ByteCode {
#define INST_ORIGIN_COMMAND 178
+#define INST_TCLOO_NEXT 179
+
/* The last opcode */
-#define LAST_INST_OPCODE 178
+#define LAST_INST_OPCODE 179
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 14ff3dd..ab26161 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4434,10 +4434,18 @@ TEBCresume(
TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
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"));
@@ -4456,6 +4464,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;
@@ -4492,6 +4546,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 94ee836..f10beae 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2734,6 +2734,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
+MODULE_SCOPE Tcl_NRPostProc TclOONextRestoreFrame;
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
@@ -3589,6 +3590,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 529640f..9a0682d 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 853e2ec..49c917b 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);
/*
* ----------------------------------------------------------------------
@@ -808,7 +806,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);
}
@@ -877,8 +875,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,
@@ -907,8 +905,8 @@ TclOONextToObjCmd(
return TCL_ERROR;
}
-static int
-RestoreFrame(
+int
+TclOONextRestoreFrame(
ClientData data[],
Tcl_Interp *interp,
int result)
generated by cgit v0.12 at 2024-11-04 21:26:01 (GMT)