summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclAssembly.c9
-rw-r--r--generic/tclBasic.c15
-rw-r--r--generic/tclCompCmdsSZ.c43
-rw-r--r--generic/tclCompile.c12
-rw-r--r--generic/tclCompile.h17
-rw-r--r--generic/tclExecute.c26
-rw-r--r--generic/tclInt.h4
7 files changed, 104 insertions, 22 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 27720c7..5ff96fd 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -370,6 +370,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
{"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1},
{"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1},
+ {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1},
{"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1},
{"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1},
{"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1},
@@ -452,7 +453,6 @@ static const TalInstDesc TalInstructionTable[] = {
{"neq", ASSEM_1BYTE, INST_NEQ, 2, 1},
{"nop", ASSEM_1BYTE, INST_NOP, 0, 0},
{"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
- {"nscurrent", ASSEM_1BYTE, INST_NS_CURRENT, 0, 1},
{"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1},
{"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
{"pop", ASSEM_1BYTE, INST_POP, 1, 0},
@@ -487,6 +487,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1},
{"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1},
{"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0},
+ {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1},
{NULL, 0, 0, 0, 0}
};
@@ -506,10 +507,10 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_PUSH_RETURN_OPTIONS, /* 108 */
INST_REVERSE, /* 126 */
INST_NOP, /* 132 */
- INST_NS_CURRENT, /* 141 */
INST_COROUTINE_NAME, /* 142 */
- INST_INFO_LEVEL_NUM, /* 143 */
- INST_RESOLVE_COMMAND /* 145 */
+ INST_NS_CURRENT, /* 143 */
+ INST_INFO_LEVEL_NUM, /* 144 */
+ INST_RESOLVE_COMMAND /* 146 */
};
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3848d5b..ab087e6 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -131,7 +131,6 @@ static Tcl_Obj * GetCommandSource(Interp *iPtr, int objc,
Tcl_Obj *const objv[], int lookup);
static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
-static Tcl_NRPostProc NRCoroutineActivateCallback;
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
@@ -258,7 +257,7 @@ static const CmdInfo builtInCmds[] = {
{"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, NULL, 1},
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, 1},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, 1},
- {"yield", NULL, NULL, TclNRYieldObjCmd, 1},
+ {"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, 1},
{"yieldto", NULL, NULL, TclNRYieldToObjCmd, 1},
/*
@@ -8495,7 +8494,7 @@ TclNRYieldObjCmd(
}
NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
clientData, NULL, NULL);
return TCL_OK;
}
@@ -8712,7 +8711,7 @@ NRCoroutineExitCallback(
/*
*----------------------------------------------------------------------
*
- * NRCoroutineActivateCallback --
+ * TclNRCoroutineActivateCallback --
*
* This is the workhorse for coroutines: it implements both yield and
* resume.
@@ -8726,8 +8725,8 @@ NRCoroutineExitCallback(
*----------------------------------------------------------------------
*/
-static int
-NRCoroutineActivateCallback(
+int
+TclNRCoroutineActivateCallback(
ClientData data[],
Tcl_Interp *interp,
int result)
@@ -8902,7 +8901,7 @@ TclNRInterpCoroutine(
break;
}
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
NULL, NULL, NULL);
return TCL_OK;
}
@@ -9059,7 +9058,7 @@ TclNRCoroutineObjCmd(
* Now just resume the coroutine.
*/
- TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
NULL, NULL, NULL);
return TCL_OK;
}
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 8ed3a95..d7dd58e 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2752,6 +2752,49 @@ TclCompileWhileCmd(
/*
*----------------------------------------------------------------------
*
+ * TclCompileYieldCmd --
+ *
+ * Procedure called to compile the "yield" command.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "yield" command at
+ * runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldCmd(
+ 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. */
+{
+ if (parsePtr->numWords < 1 || parsePtr->numWords > 2) {
+ return TCL_ERROR;
+ }
+
+ if (parsePtr->numWords == 1) {
+ PushLiteral(envPtr, "", 0);
+ } else {
+ DefineLineInformation; /* TIP #280 */
+ Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+ CompileWord(envPtr, valueTokenPtr, interp, 1);
+ }
+ TclEmitOpcode(INST_YIELD, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* PushVarName --
*
* Procedure used in the compiling where pushing a variable name is
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index b331551..1924334 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -435,12 +435,18 @@ InstructionDesc const tclInstructionTable[] = {
* indicated by the LVT index. Part of [dict with].
* Stack: ... path keyList => ... */
- {"nscurrent", 1, +1, 0, {OPERAND_NONE}},
- /* Push the name of the interpreter's current namespace as an object
- * on the stack. */
+ {"yield", 1, 0, 0, {OPERAND_NONE}},
+ /* Makes the current coroutine yield the value at the top of the
+ * stack, and places the response back on top of the stack when it
+ * resumes.
+ * Stack: ... valueToYield => ... resumeValue */
{"coroName", 1, +1, 0, {OPERAND_NONE}},
/* Push the name of the interpreter's current coroutine as an object
* on the stack. */
+
+ {"currentNamespace", 1, +1, 0, {OPERAND_NONE}},
+ /* Push the name of the interpreter's current namespace as an object
+ * on the stack. */
{"infoLevelNumber", 1, +1, 0, {OPERAND_NONE}},
/* Push the stack depth (i.e., [info level]) of the interpreter as an
* object on the stack. */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 86a0f77..fcff46c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -681,16 +681,19 @@ typedef struct ByteCode {
#define INST_DICT_RECOMBINE_STK 139
#define INST_DICT_RECOMBINE_IMM 140
-/* For compilation of basic information operations */
-#define INST_NS_CURRENT 141
+/* For operations to do with coroutines */
+#define INST_YIELD 141
#define INST_COROUTINE_NAME 142
-#define INST_INFO_LEVEL_NUM 143
-#define INST_INFO_LEVEL_ARGS 144
-#define INST_RESOLVE_COMMAND 145
-#define INST_TCLOO_SELF 146
+
+/* For compilation of basic information operations */
+#define INST_NS_CURRENT 143
+#define INST_INFO_LEVEL_NUM 144
+#define INST_INFO_LEVEL_ARGS 145
+#define INST_RESOLVE_COMMAND 146
+#define INST_TCLOO_SELF 147
/* The last opcode */
-#define LAST_INST_OPCODE 146
+#define LAST_INST_OPCODE 147
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a24c806..30f8d77 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2332,6 +2332,32 @@ TEBCresume(
cleanup = 1;
goto processExceptionReturn;
+ case INST_YIELD: {
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+ TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
+ if (!corPtr) {
+ TRACE_APPEND(("ERROR: yield outside coroutine\n"));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yield can only be called in a coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+ NULL);
+ goto gotError;
+ }
+
+ Tcl_SetObjResult(interp, OBJ_AT_TOS);
+ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
+ INT2PTR(0), NULL, NULL);
+
+#ifdef TCL_COMPILE_DEBUG
+ TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
+ if (traceInstructions) {
+ fprintf(stdout, "\n");
+ }
+#endif
+ goto checkForCatch;
+ }
+
case INST_DONE:
if (tosPtr > initTosPtr) {
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 448a7cd..865378e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2797,6 +2797,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd;
MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback;
+MODULE_SCOPE Tcl_NRPostProc TclNRCoroutineActivateCallback;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
@@ -3654,6 +3655,9 @@ MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp,
MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclInvertOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
generated by cgit v0.12 at 2024-11-10 18:50:40 (GMT)