summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2010-09-27 19:42:37 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2010-09-27 19:42:37 (GMT)
commit869bb6b839721e19027162a8ae89c66d9f5fdbe4 (patch)
tree4d363e5df177abbfaf883365f97c35c5ba84a573 /generic/tclBasic.c
parent2efdc538b9f8bd5d53fe38c26db1df0b19e2ede5 (diff)
downloadtcl-869bb6b839721e19027162a8ae89c66d9f5fdbe4.zip
tcl-869bb6b839721e19027162a8ae89c66d9f5fdbe4.tar.gz
tcl-869bb6b839721e19027162a8ae89c66d9f5fdbe4.tar.bz2
* generic/tclBasic.c: [Patch 3072080] (minus the itcl
* generic/tclCmdIL.c: update): a saner NRE. * generic/tclCompExpr.c: * generic/tclCompile.c: This makes TclNRExecuteByteCode * generic/tclCompile.h: (ex TEBC) to be a normal NRE * generic/tclExecute.c: citizen: it loses its special status. * generic/tclInt.decls: The logic flow within the BC engine is * generic/tclInt.h: simplified considerably. * generic/tclIntDecls.h: * generic/tclObj.c: * generic/tclProc.c: * generic/tclTest.c:
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c327
1 files changed, 136 insertions, 191 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 211771a..e426178 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.465 2010/08/31 20:48:17 nijtmans Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.466 2010/09/27 19:42:37 msofer Exp $
*/
#include "tclInt.h"
@@ -135,6 +135,7 @@ 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 Tcl_NRPostProc NRRunObjProc;
@@ -175,6 +176,9 @@ MODULE_SCOPE const TclStubs tclStubs;
* after particular kinds of [yield].
*/
+#define CORO_ACTIVATE_YIELD PTR2INT(NULL)
+#define CORO_ACTIVATE_YIELDM PTR2INT(NULL)+1
+
#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1)
#define COROUTINE_ARGUMENTS_ARBITRARY (-2)
@@ -810,7 +814,7 @@ Tcl_CreateInterp(void)
Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldTo", NULL,
TclNRYieldToObjCmd, NULL, NULL);
Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldm", NULL,
- TclNRYieldmObjCmd, NULL, NULL);
+ TclNRYieldObjCmd, INT2PTR(CORO_ACTIVATE_YIELDM), NULL);
#ifdef USE_DTRACE
/*
@@ -3049,7 +3053,7 @@ Tcl_DeleteCommandFromToken(
* from a CmdName Tcl object in some ByteCode code sequence. In that case,
* delay the cleanup until all references are either discarded (when a
* ByteCode is freed) or replaced by a new reference (when a cached
- * CmdName Command reference is found to be invalid and TclExecuteByteCode
+ * CmdName Command reference is found to be invalid and TclNRExecuteByteCode
* looks up the command in the command hashtable).
*/
@@ -4095,7 +4099,7 @@ Tcl_EvalObjv(
TEOV_callback *rootPtr = TOP_CB(interp);
result = TclNREvalObjv(interp, objc, objv, flags, NULL);
- return TclNRRunCallbacks(interp, result, rootPtr, 0);
+ return TclNRRunCallbacks(interp, result, rootPtr);
}
int
@@ -4279,11 +4283,9 @@ int
TclNRRunCallbacks(
Tcl_Interp *interp,
int result,
- struct TEOV_callback *rootPtr,
+ struct TEOV_callback *rootPtr)
/* All callbacks down to rootPtr not inclusive
* are to be run. */
- int tebcCall) /* Normal callers set this to 0; only TEBC
- * sets it to 1. */
{
Interp *iPtr = (Interp *) interp;
TEOV_callback *callbackPtr;
@@ -4305,23 +4307,7 @@ TclNRRunCallbacks(
while (TOP_CB(interp) != rootPtr) {
callbackPtr = TOP_CB(interp);
-
procPtr = callbackPtr->procPtr;
-
- if (tebcCall && (procPtr == NRCallTEBC)) {
- NRE_ASSERT(result==TCL_OK);
- return TCL_OK;
- }
-
- /*
- * IMPLEMENTATION REMARKS (FIXME)
- *
- * Add here other direct handling possibilities for optimisation? One
- * could handle the very frequent NRCommand and NRRunObjProc right
- * here to save an indirect function call and improve icache
- * management. Would it? Test it, time it ...
- */
-
TOP_CB(interp) = callbackPtr->nextPtr;
result = procPtr(callbackPtr->data, interp, result);
TCLNR_FREE(interp, callbackPtr);
@@ -4381,41 +4367,6 @@ NRRunObjProc(
return result;
}
-int
-NRCallTEBC(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- /*
- * This is not run normally, the callback is passed up to tebc. This
- * function is only called when no tebc is above.
- */
-
- int type = PTR2INT(data[0]);
- Interp *iPtr = ((Interp *) interp);
-
- NRE_ASSERT(result == TCL_OK);
-
- switch (type) {
- case TCL_NR_BC_TYPE:
- return TclExecuteByteCode(interp, data[1]);
- case TCL_NR_YIELD_TYPE:
- if (iPtr->execEnvPtr->corPtr) {
- Tcl_SetResult(interp, "cannot yield: C stack busy", TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", NULL);
- } else {
- Tcl_SetResult(interp, "yield can only be called in a coroutine",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
- NULL);
- }
- return TCL_ERROR;
- default:
- Tcl_Panic("unknown call type to TEBC");
- }
- return result; /* not reached */
-}
/*
*----------------------------------------------------------------------
@@ -5933,7 +5884,7 @@ TclEvalObjEx(
TEOV_callback *rootPtr = TOP_CB(interp);
result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
- return TclNRRunCallbacks(interp, result, rootPtr, 0);
+ return TclNRRunCallbacks(interp, result, rootPtr);
}
int
@@ -6060,9 +6011,7 @@ TclNREvalObjEx(
TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
objPtr, INT2PTR(allowExceptions), NULL);
- TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
- NULL, NULL);
- return TCL_OK;
+ return TclNRExecuteByteCode(interp, codePtr);
}
{
@@ -8166,7 +8115,7 @@ Tcl_NRCallObjProc(
(Tcl_Obj **)(objv + 1));
}
result = objProc(clientData, interp, objc, objv);
- return TclNRRunCallbacks(interp, result, rootPtr, 0);
+ return TclNRRunCallbacks(interp, result, rootPtr);
}
/*
@@ -8480,8 +8429,6 @@ TclNRYieldObjCmd(
Tcl_Obj *const objv[])
{
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
- int numLevels = iPtr->numLevels;
-
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
return TCL_ERROR;
@@ -8498,38 +8445,13 @@ TclNRYieldObjCmd(
Tcl_SetObjResult(interp, objv[1]);
}
- iPtr->numLevels = corPtr->auxNumLevels;
- corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
- corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
-
- TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_YIELD_TYPE),
- NULL, NULL, NULL);
+ NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
+ TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ clientData, NULL, NULL);
return TCL_OK;
}
int
-TclNRYieldmObjCmd(
- ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
- int result;
-
- if (!corPtr) {
- Tcl_SetResult(interp, "yieldm can only be called in a coroutine",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
- return TCL_ERROR;
- }
-
- result = TclNRYieldObjCmd(clientData, interp, objc, objv);
- corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
- return result;
-}
-
-int
TclNRYieldToObjCmd(
ClientData clientData,
Tcl_Interp *interp,
@@ -8623,7 +8545,6 @@ RewindCoroutine(
NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
NRE_ASSERT(corPtr->eePtr != NULL);
- NRE_ASSERT(corPtr->eePtr->bottomPtr != NULL);
NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr);
corPtr->eePtr->rewind = 1;
@@ -8641,7 +8562,7 @@ DeleteCoroutine(
TEOV_callback *rootPtr = TOP_CB(interp);
if (COR_IS_SUSPENDED(corPtr)) {
- TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr, 0);
+ TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
}
}
@@ -8677,7 +8598,7 @@ NRCoroutineCallerCallback(
NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
SAVE_CONTEXT(corPtr->running);
RESTORE_CONTEXT(corPtr->caller);
-
+
if (cmdPtr->flags & CMD_IS_DELETED) {
/*
* The command was deleted while it was running: wind down the
@@ -8717,17 +8638,10 @@ NRCoroutineExitCallback(
TclCleanupCommandMacro(cmdPtr);
corPtr->eePtr->corPtr = NULL;
- TclPopStackFrame(interp);
TclDeleteExecEnv(corPtr->eePtr);
corPtr->eePtr = NULL;
- RESTORE_CONTEXT(corPtr->caller);
-
- NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
- NRE_ASSERT(iPtr->varFramePtr = corPtr->caller.varFramePtr);
- NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
-
- iPtr->execEnvPtr = corPtr->callerEEPtr;
+ corPtr->stackLevel = NULL;
/*
* #280.
@@ -8735,13 +8649,98 @@ NRCoroutineExitCallback(
* command arguments in bytecode.
*/
- Tcl_DeleteHashTable(corPtr->base.lineLABCPtr);
- ckfree((char *) corPtr->base.lineLABCPtr);
- corPtr->base.lineLABCPtr = NULL;
+ Tcl_DeleteHashTable(corPtr->lineLABCPtr);
+ ckfree((char *) corPtr->lineLABCPtr);
+ corPtr->lineLABCPtr = NULL;
+
+ RESTORE_CONTEXT(corPtr->caller);
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ iPtr->numLevels++;
return result;
}
+
+/*
+ * NRCoroutineActivateCallback --
+ *
+ * This is the workhorse for coroutines: it implements both yield and resume.
+ *
+ * It is important that both be implemented in the same callback: the
+ * detection of the impossibility to suspend due to a busy C-stack relies on
+ * the precise position of a local variable in the stack. We do not want the
+ * compiler to play tricks on us, either by moving things around or inlining.
+ */
+
+static int
+NRCoroutineActivateCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ CoroutineData *corPtr = data[0];
+ int type = PTR2INT(data[1]);
+ int numLevels, unused;
+ int *stackLevel = &unused;
+
+ if (!corPtr->stackLevel) {
+ /*
+ * -- Coroutine is suspended --
+ * Push the callback to restore the caller's context on yield or return
+ */
+
+ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
+ NULL);
+
+ /*
+ * Record the stackLevel at which the resume is happening, then swap
+ * the interp's environment to make it suitable to run this
+ * coroutine.
+ */
+
+ corPtr->stackLevel = stackLevel;
+ numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = iPtr->numLevels;
+
+ SAVE_CONTEXT(corPtr->caller);
+ corPtr->callerEEPtr = iPtr->execEnvPtr;
+ RESTORE_CONTEXT(corPtr->running);
+ iPtr->execEnvPtr = corPtr->eePtr;
+ iPtr->numLevels += numLevels;
+
+ return TCL_OK;
+ } else {
+ /*
+ * Coroutine is active: yield
+ */
+
+ if (corPtr->stackLevel != stackLevel) {
+ Tcl_SetResult(interp, "cannot yield: C stack busy",
+ TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ if (type == CORO_ACTIVATE_YIELD) {
+ corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
+ } else if (type == CORO_ACTIVATE_YIELDM) {
+ corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
+ } else {
+ Tcl_Panic("Yield received an option which is not implemented");
+ }
+
+ corPtr->stackLevel = NULL;
+
+ numLevels = iPtr->numLevels;
+ iPtr->numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
+
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
+ return TCL_OK;
+ }
+}
+
int
NRInterpCoroutine(
ClientData clientData,
@@ -8750,7 +8749,6 @@ NRInterpCoroutine(
Tcl_Obj *const objv[]) /* Argument objects. */
{
CoroutineData *corPtr = clientData;
- int nestNumLevels = corPtr->auxNumLevels;
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_ResetResult(interp);
@@ -8791,26 +8789,8 @@ NRInterpCoroutine(
break;
}
- /*
- * Swap the interp's environment to make it suitable to run this
- * coroutine. TEBC needs no info to resume executing after a suspension:
- * the codePtr will be read from the execEnv's saved bottomPtr.
- */
-
- SAVE_CONTEXT(corPtr->caller);
- corPtr->base.framePtr->callerPtr = iPtr->framePtr;
- RESTORE_CONTEXT(corPtr->running);
- corPtr->auxNumLevels = iPtr->numLevels;
- iPtr->numLevels += nestNumLevels;
-
- TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
- NULL);
-
- corPtr->callerEEPtr = iPtr->execEnvPtr;
- iPtr->execEnvPtr = corPtr->eePtr;
-
- TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), NULL,
- NULL, NULL);
+ TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ NULL, NULL, NULL);
return TCL_OK;
}
@@ -8823,11 +8803,9 @@ TclNRCoroutineObjCmd(
{
Command *cmdPtr;
CoroutineData *corPtr;
- Tcl_Obj *cmdObjPtr;
const char *fullName, *procName;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_DString ds;
- Tcl_CallFrame *framePtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
@@ -8866,18 +8844,10 @@ TclNRCoroutineObjCmd(
/*
* We ARE creating the coroutine command: allocate the corresponding
- * struct, add the callback in caller's env and record the caller's
- * frames.
+ * struct and create the corresponding command.
*/
corPtr = (CoroutineData *) ckalloc(sizeof(CoroutineData));
- TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
- NULL);
- SAVE_CONTEXT(corPtr->caller);
-
- /*
- * Create the coroutine command.
- */
Tcl_DStringInit(&ds);
if (nsPtr != iPtr->globalNsPtr) {
@@ -8906,84 +8876,59 @@ TclNRCoroutineObjCmd(
Tcl_HashSearch hSearch;
Tcl_HashEntry *hePtr;
- corPtr->base.lineLABCPtr = (Tcl_HashTable *)
+ corPtr->lineLABCPtr = (Tcl_HashTable *)
ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(corPtr->base.lineLABCPtr, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
int isNew;
Tcl_HashEntry *newPtr =
- Tcl_CreateHashEntry(corPtr->base.lineLABCPtr,
+ Tcl_CreateHashEntry(corPtr->lineLABCPtr,
Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr),
&isNew);
Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
}
-
- /*
- * The new copy is immediately plugged interpreter for use by the
- * first coroutine commands (see below). The interp's copy of the
- * table is already saved, see the SAVE_CONTEXT found just above this
- * whole code block. This also properly prepares us for the
- * SAVE/RESTORE dances during yields which swizzle the pointers
- * around.
- */
-
- iPtr->lineLABCPtr = corPtr->base.lineLABCPtr;
}
/*
- * Create the coro's execEnv and switch to it so that any CallFrames or
- * callbacks refer to the new execEnv's stack.
+ * Save the base context.
+ */
+
+ corPtr->running.framePtr = iPtr->rootFramePtr;
+ corPtr->running.varFramePtr = iPtr->rootFramePtr;
+ corPtr->running.cmdFramePtr = NULL;
+ corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
+ corPtr->stackLevel = NULL;
+ corPtr->auxNumLevels = 0;
+ iPtr->numLevels--;
+
+ /*
+ * Create the coro's execEnv, switch to it to push the exit and coro
+ * command callbacks, then switch back.
*/
corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
corPtr->callerEEPtr = iPtr->execEnvPtr;
corPtr->eePtr->corPtr = corPtr;
+
iPtr->execEnvPtr = corPtr->eePtr;
- /* push a base call frame; save the current namespace to do a correct
- * command lookup.
- */
+ TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
+ NULL, NULL, NULL);
- nsPtr = iPtr->varFramePtr->nsPtr;
- TclPushStackFrame(interp, &framePtr,
- (Tcl_Namespace *) iPtr->globalNsPtr, 0);
- iPtr->varFramePtr = iPtr->rootFramePtr;
+ iPtr->lookupNsPtr = iPtr->varFramePtr->nsPtr;
+ Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
/*
- * Save the base context. The base cmdFramePtr is unknown at this time: it
- * will be allocated in the Tcl stack. So signal TEBC that it has to
- * initialize the base cmdFramePtr by setting it to NULL.
+ * Now just resume the coroutine. Take care to insure that the command is
+ * looked up in the correct namespace.
*/
- SAVE_CONTEXT(corPtr->base);
- corPtr->base.cmdFramePtr = NULL;
- corPtr->running = NULL_CONTEXT;
- corPtr->stackLevel = NULL;
- corPtr->auxNumLevels = iPtr->numLevels;
-
- /*
- * Create the command that will run at the bottom of the coroutine.
- * Be sure not to pass a canonical list for the command so that we insure
- * the body is bytecompiled: we need a TEBC instance to handle [yield]
- */
-
- cmdObjPtr = Tcl_NewListObj(objc-2, &objv[2]);
- TclGetString(cmdObjPtr);
- TclFreeIntRep(cmdObjPtr);
- cmdObjPtr->typePtr = NULL;
-
- /*
- * Add the exit callback, then the callback to eval the coro body
- */
-
- TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
- NULL, NULL, NULL);
- iPtr->lookupNsPtr = nsPtr;
- TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
-
+ TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ NULL, NULL, NULL);
return TCL_OK;
}