Attachment "inv.diff" to
ticket [3072080fff]
added by
msofer
2010-09-28 01:16:06.
Index: generic/tclBasic.c
===================================================================
--- generic/tclBasic.c
+++ generic/tclBasic.c
@@ -133,10 +133,11 @@
static Tcl_ObjCmdProc ExprWideFunc;
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;
static Tcl_NRPostProc NRTailcallEval;
static Tcl_ObjCmdProc OldMathFuncProc;
@@ -172,10 +173,13 @@
/*
* Magical counts for the number of arguments accepted by a coroutine command
* 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)
/*
@@ -808,11 +812,11 @@
Tcl_RepresentationCmd, NULL, NULL);
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
/*
* Register the tcl::dtrace command.
*/
@@ -3047,11 +3051,11 @@
/*
* Now free the Command structure, unless there is another reference to it
* 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).
*/
TclCleanupCommandMacro(cmdPtr);
return 0;
@@ -4093,11 +4097,11 @@
{
int result;
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
TclNREvalObjv(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
@@ -4277,15 +4281,13 @@
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;
Tcl_NRPostProc *procPtr;
@@ -4303,27 +4305,11 @@
(void) Tcl_GetObjResult(interp);
}
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 ...
- */
-
+ procPtr = callbackPtr->procPtr;
TOP_CB(interp) = callbackPtr->nextPtr;
result = procPtr(callbackPtr->data, interp, result);
TCLNR_FREE(interp, callbackPtr);
}
return result;
@@ -4379,45 +4365,10 @@
return objProc(objClientData, interp, objc, objv);
}
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 */
-}
/*
*----------------------------------------------------------------------
*
* TEOV_Exception -
@@ -5931,11 +5882,11 @@
{
int result = TCL_OK;
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
TclNREvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
@@ -6058,13 +6009,11 @@
Tcl_IncrRefCount(objPtr);
codePtr = TclCompileObj(interp, objPtr, invoker, word);
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);
}
{
/*
* We're not supposed to use the compiler or byte-code
@@ -8164,11 +8113,11 @@
if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
result = objProc(clientData, interp, objc, objv);
- return TclNRRunCallbacks(interp, result, rootPtr, 0);
+ return TclNRRunCallbacks(interp, result, rootPtr);
}
/*
*----------------------------------------------------------------------
*
@@ -8478,12 +8427,10 @@
Tcl_Interp *interp,
int objc,
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;
}
@@ -8496,39 +8443,14 @@
if (objc == 2) {
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);
- 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;
+ NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
+ TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
+ clientData, NULL, NULL);
+ return TCL_OK;
}
int
TclNRYieldToObjCmd(
ClientData clientData,
@@ -8621,11 +8543,10 @@
Tcl_Interp *interp = corPtr->eePtr->interp;
Tcl_InterpState state = Tcl_SaveInterpState(interp, result);
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;
TclNRAddCallback(interp, RewindCoroutineCallback, state,
NULL, NULL, NULL);
@@ -8639,11 +8560,11 @@
CoroutineData *corPtr = clientData;
Tcl_Interp *interp = corPtr->eePtr->interp;
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);
}
}
static int
NRCoroutineCallerCallback(
@@ -8675,11 +8596,11 @@
}
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
* execEnv, this will do the complete cleanup. RewindCoroutine will
* restore both the caller's context and interp state.
@@ -8715,33 +8636,111 @@
cmdPtr->deleteProc = NULL;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
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.
* Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
* 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,
@@ -8748,11 +8747,10 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
CoroutineData *corPtr = clientData;
- int nestNumLevels = corPtr->auxNumLevels;
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "coroutine \"", Tcl_GetString(objv[0]),
"\" is already running", NULL);
@@ -8789,30 +8787,12 @@
Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1));
}
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;
}
int
TclNRCoroutineObjCmd(
@@ -8821,15 +8801,13 @@
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
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 ...?");
return TCL_ERROR;
}
@@ -8864,22 +8842,14 @@
return TCL_ERROR;
}
/*
* 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) {
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
Tcl_DStringAppend(&ds, "::", 2);
@@ -8904,88 +8874,63 @@
{
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;
}
/*
* This is used in the [info] ensemble
Index: generic/tclCmdIL.c
===================================================================
--- generic/tclCmdIL.c
+++ generic/tclCmdIL.c
@@ -1153,15 +1153,26 @@
: iPtr->cmdFramePtr->level);
if (iPtr->execEnvPtr->corPtr) {
/*
- * A coroutine: must fix the level computations
- */
-
- topLevel += iPtr->execEnvPtr->corPtr->caller.cmdFramePtr->level -
- iPtr->execEnvPtr->corPtr->base.cmdFramePtr->level;
+ * A coroutine: must fix the level computations AND the cmdFrame chain,
+ * which is interrupted at the base.
+ */
+
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ CmdFrame *runPtr = iPtr->cmdFramePtr;
+ CmdFrame *lastPtr = NULL;
+
+ topLevel += corPtr->caller.cmdFramePtr->level;
+ while (runPtr && (runPtr != corPtr->caller.cmdFramePtr)) {
+ lastPtr = runPtr;
+ runPtr = runPtr->nextPtr;
+ }
+ if (lastPtr && !runPtr) {
+ lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
+ }
}
if (objc == 1) {
/*
* Just "info frame".
Index: generic/tclCompExpr.c
===================================================================
--- generic/tclCompExpr.c
+++ generic/tclCompExpr.c
@@ -2099,10 +2099,11 @@
{
CompileEnv *envPtr;
ByteCode *byteCodePtr;
int code;
Tcl_Obj *byteCodeObj = Tcl_NewObj();
+ TEOV_callback *rootPtr = TOP_CB(interp);
/*
* Note we are compiling an expression with literal arguments. This means
* there can be no [info frame] calls when we execute the resulting
* bytecode, so there's no need to tend to TIP 280 issues.
@@ -2116,11 +2117,12 @@
Tcl_IncrRefCount(byteCodeObj);
TclInitByteCodeObj(byteCodeObj, envPtr);
TclFreeCompileEnv(envPtr);
TclStackFree(interp, envPtr);
byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
- code = TclExecuteByteCode(interp, byteCodePtr);
+ TclNRExecuteByteCode(interp, byteCodePtr);
+ code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
Tcl_DecrRefCount(byteCodeObj);
return code;
}
/*
Index: generic/tclCompile.c
===================================================================
--- generic/tclCompile.c
+++ generic/tclCompile.c
@@ -913,11 +913,11 @@
int flags) /* What substitutions to do. */
{
TEOV_callback *rootPtr = TOP_CB(interp);
if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags),
- rootPtr, 0) != TCL_OK) {
+ rootPtr) != TCL_OK) {
return NULL;
}
return Tcl_GetObjResult(interp);
}
@@ -947,13 +947,11 @@
{
ByteCode *codePtr = CompileSubstObj(interp, objPtr, flags);
/* TODO: Confirm we do not need this. */
/* Tcl_ResetResult(interp); */
- Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
- NULL, NULL);
- return TCL_OK;
+ return TclNRExecuteByteCode(interp, codePtr);
}
/*
*----------------------------------------------------------------------
*
@@ -1649,11 +1647,11 @@
/*
* Mark the start of the command; the proper bytecode
* length will be updated later. There is no need to
* do this for the first bytecode in the compile env,
* as the check is done before calling
- * TclExecuteByteCode(). Do emit an INST_START_CMD in
+ * TclNRExecuteByteCode(). Do emit an INST_START_CMD in
* special cases where the first bytecode is in a
* loop, to insure that the corresponding command is
* counted properly. Compilers for commands able to
* produce such a beast (currently 'while 1' only) set
* envPtr->atCmdStart to 0 in order to signal this
Index: generic/tclCompile.h
===================================================================
--- generic/tclCompile.h
+++ generic/tclCompile.h
@@ -861,17 +861,12 @@
*----------------------------------------------------------------
* Procedures exported by tclBasic.c to be used within the engine.
*----------------------------------------------------------------
*/
-MODULE_SCOPE Tcl_NRPostProc NRCallTEBC;
MODULE_SCOPE Tcl_NRPostProc NRCommand;
MODULE_SCOPE Tcl_ObjCmdProc NRInterpCoroutine;
-
-#define TCL_NR_BC_TYPE 0
-#define TCL_NR_ATEXIT_TYPE 1
-#define TCL_NR_YIELD_TYPE 2
/*
*----------------------------------------------------------------
* Procedures exported by the engine to be used by tclBasic.c
*----------------------------------------------------------------
@@ -921,11 +916,11 @@
MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
-MODULE_SCOPE int TclExecuteByteCode(Tcl_Interp *interp,
+MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
ByteCode *codePtr);
MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
int create, CompileEnv *envPtr);
MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
Index: generic/tclExecute.c
===================================================================
--- generic/tclExecute.c
+++ generic/tclExecute.c
@@ -4,11 +4,11 @@
* This file contains procedures that execute byte-compiled Tcl commands.
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
- * Copyright (c) 2002-2008 by Miguel Sofer.
+ * Copyright (c) 2002-2010 by Miguel Sofer.
* Copyright (c) 2005-2007 by Donal K. Fellows.
* Copyright (c) 2007 Daniel A. Steffen <[email protected]>
* Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
@@ -169,44 +169,33 @@
* Helpers for NR - non-recursive calls to TEBC
* Minimal data required to fully reconstruct the execution state.
*/
typedef struct BottomData {
- struct BottomData *prevBottomPtr;
- TEOV_callback *rootPtr; /* State when this bytecode execution
- * began: */
- ByteCode *codePtr; /* constant until it returns */
+ ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
+ struct BottomData *expanded;/* NULL if unchanged, pointer to the succesor
+ * if it was expanded */
const unsigned char *pc; /* These fields are used on return TO this */
ptrdiff_t *catchTop; /* this level: they record the state when a */
int cleanup; /* new codePtr was received for NR */
Tcl_Obj *auxObjList; /* execution. */
+ int checkInterp;
} BottomData;
-#define NR_DATA_INIT() \
- do { \
- BP->prevBottomPtr = OBP; \
- BP->rootPtr = TOP_CB(iPtr); \
- BP->codePtr = codePtr; \
- } while (0)
-
-#define NR_DATA_BURY() \
- do { \
- BP->pc = pc; \
- BP->cleanup = cleanup; \
- OBP = BP; \
- } while (0)
-
-#define NR_DATA_DIG() \
- do { \
- pc = BP->pc; \
- codePtr = BP->codePtr; \
- cleanup = BP->cleanup; \
- TAUX.esPtr = iPtr->execEnvPtr->execStackPtr; \
- tosPtr = TAUX.esPtr->tosPtr; \
- TAUX.compiledLocals = iPtr->varFramePtr->compiledLocals;\
- } while (0)
+#define NR_YIELD(invoke) \
+ esPtr->tosPtr = tosPtr; \
+ BP->pc = pc; \
+ BP->cleanup = cleanup; \
+ TclNRAddCallback(interp, TEBCresume, BP, \
+ INT2PTR(invoke), NULL, NULL)
+
+#define NR_DATA_DIG() \
+ pc = BP->pc; \
+ cleanup = BP->cleanup; \
+ tosPtr = esPtr->tosPtr
+
#define PUSH_TAUX_OBJ(objPtr) \
do { \
objPtr->internalRep.twoPtrValue.ptr2 = auxObjList; \
auxObjList = objPtr; \
@@ -307,23 +296,20 @@
} while (0)
/*
* Macros used to cache often-referenced Tcl evaluation stack information
* in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
- * pair must surround any call inside TclExecuteByteCode (and a few other
+ * pair must surround any call inside TclNRExecuteByteCode (and a few other
* procedures that use this scheme) that could result in a recursive call
- * to TclExecuteByteCode.
+ * to TclNRExecuteByteCode.
*/
#define CACHE_STACK_INFO() \
- TAUX.checkInterp = 1
+ checkInterp = 1
#define DECACHE_STACK_INFO() \
- do { \
- TAUX.esPtr->tosPtr = tosPtr; \
- iPtr->execEnvPtr->bottomPtr = BP; \
- } while (0)
+ esPtr->tosPtr = tosPtr
/*
* Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
* increments the object's ref count since it makes the stack have another
* reference pointing to the object. However, POP_OBJECT does not decrement
@@ -351,31 +337,31 @@
#define CURR_DEPTH (tosPtr - initTosPtr)
/*
* Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode. O2S is
+ * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
* only used in TRACE* calls to get a string from an object.
*/
#ifdef TCL_COMPILE_DEBUG
# define TRACE(a) \
- while (TAUX.traceInstructions) { \
+ while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
(unsigned) (pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
break; \
}
# define TRACE_APPEND(a) \
- while (TAUX.traceInstructions) { \
+ while (traceInstructions) { \
printf a; \
break; \
}
# define TRACE_WITH_OBJ(a, objPtr) \
- while (TAUX.traceInstructions) { \
+ while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
(unsigned) (pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
@@ -397,28 +383,28 @@
*/
#define TCL_DTRACE_INST_NEXT() \
do { \
if (TCL_DTRACE_INST_DONE_ENABLED()) { \
- if (TAUX.curInstName) { \
- TCL_DTRACE_INST_DONE(TAUX.curInstName, (int) CURR_DEPTH, \
+ if (curInstName) { \
+ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, \
tosPtr); \
} \
- TAUX.curInstName = tclInstructionTable[*pc].name; \
+ curInstName = tclInstructionTable[*pc].name; \
if (TCL_DTRACE_INST_START_ENABLED()) { \
- TCL_DTRACE_INST_START(TAUX.curInstName, (int) CURR_DEPTH, \
+ TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, \
tosPtr); \
} \
} else if (TCL_DTRACE_INST_START_ENABLED()) { \
TCL_DTRACE_INST_START(tclInstructionTable[*pc].name, \
(int) CURR_DEPTH, tosPtr); \
} \
} while (0)
#define TCL_DTRACE_INST_LAST() \
do { \
- if (TCL_DTRACE_INST_DONE_ENABLED() && TAUX.curInstName) { \
- TCL_DTRACE_INST_DONE(TAUX.curInstName, (int) CURR_DEPTH, tosPtr);\
+ if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) { \
+ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
} \
} while (0)
/*
* Macro used in this file to save a function call for common uses of
@@ -732,10 +718,13 @@
static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords);
static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
static Tcl_NRPostProc CopyCallback;
static Tcl_NRPostProc ExprObjCallback;
+static Tcl_NRPostProc TEBCresume;
+static Tcl_NRPostProc TEBCreturn;
+
/*
* The structure below defines a bytecode Tcl object type to hold the
* compiled bytecode for Tcl expressions.
*/
@@ -791,20 +780,20 @@
* TclCreateExecEnv --
*
* This procedure creates a new execution environment for Tcl bytecode
* execution. An ExecEnv points to a Tcl evaluation stack. An ExecEnv is
* typically created once for each Tcl interpreter (Interp structure) and
- * recursively passed to TclExecuteByteCode to execute ByteCode sequences
+ * recursively passed to TclNRExecuteByteCode to execute ByteCode sequences
* for nested commands.
*
* Results:
* A newly allocated ExecEnv is returned. This points to an empty
* evaluation stack of the standard initial size.
*
* Side effects:
* The bytecode interpreter is also initialized here, as this procedure
- * will be called before any call to TclExecuteByteCode.
+ * will be called before any call to TclNRExecuteByteCode.
*
*----------------------------------------------------------------------
*/
ExecEnv *
@@ -824,11 +813,10 @@
TclNewBooleanObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
eePtr->interp = interp;
eePtr->callbackPtr = NULL;
eePtr->corPtr = NULL;
- eePtr->bottomPtr = NULL;
eePtr->rewind = 0;
esPtr->prevPtr = NULL;
esPtr->nextPtr = NULL;
esPtr->markerPtr = NULL;
@@ -1298,11 +1286,11 @@
TclNewObj(resultPtr);
TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr,
NULL, NULL);
Tcl_NRExprObj(interp, objPtr, resultPtr);
- return TclNRRunCallbacks(interp, TCL_OK, rootPtr, 0);
+ return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
static int
CopyCallback(
ClientData data[],
@@ -1361,13 +1349,11 @@
/* TODO: Confirm reset not required? */
/*Tcl_ResetResult(interp);*/
Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr,
NULL, NULL);
- Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
- NULL, NULL);
- return TCL_OK;
+ return TclNRExecuteByteCode(interp, codePtr);
}
static int
ExprObjCallback(
ClientData data[],
@@ -1868,11 +1854,11 @@
}
/*
*----------------------------------------------------------------------
*
- * TclExecuteByteCode --
+ * TclNRExecuteByteCode --
*
* This procedure executes the instructions of a ByteCode structure. It
* returns when a "done" instruction is executed or an error occurs.
*
* Results:
@@ -1883,15 +1869,124 @@
* Side effects:
* Almost certainly, depending on the ByteCode's instructions.
*
*----------------------------------------------------------------------
*/
+#define bcFramePtr ((CmdFrame *) (BP + 1))
+#define initCatchTop (((ptrdiff_t *) (bcFramePtr + 1)) - 1)
+#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
+#define esPtr (iPtr->execEnvPtr->execStackPtr)
int
-TclExecuteByteCode(
+TclNRExecuteByteCode(
Tcl_Interp *interp, /* Token for command interpreter. */
ByteCode *codePtr) /* The bytecode sequence to interpret. */
+{
+ Interp *iPtr = (Interp *) interp;
+ BottomData *BP;
+
+ if (iPtr->execEnvPtr->rewind) {
+ return TCL_ERROR;
+ }
+
+ codePtr->refCount++;
+
+ /*
+ * Reserve the stack, setup the BottomPtr and CallFrame
+ *
+ * The execution uses a unified stack: first a BottomData, immediately
+ * above it a CmdFrame, then the catch stack, then the execution stack.
+ *
+ * Make sure the catch stack is large enough to hold the maximum number of
+ * catch commands that could ever be executing at the same time (this will
+ * be no more than the exception range array's depth). Make sure the
+ * execution stack is large enough to execute this ByteCode.
+ */
+
+ BP = (BottomData *) GrowEvaluationStack(iPtr->execEnvPtr,
+ sizeof(BottomData) + codePtr->maxExceptDepth + sizeof(CmdFrame)
+ + codePtr->maxStackDepth, 0);
+ esPtr->tosPtr = initTosPtr;
+
+ BP->codePtr = codePtr;
+ BP->expanded = NULL;
+ BP->pc = codePtr->codeStart;
+ BP->catchTop = initCatchTop;
+ BP->cleanup = 0;
+ BP->auxObjList = NULL;
+ BP->checkInterp = 0;
+
+ /*
+ * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
+ * every time that we call out from this BP, popped when we return to it.
+ */
+
+ bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
+ ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
+ bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
+ bcFramePtr->numLevels = iPtr->numLevels;
+ bcFramePtr->framePtr = iPtr->framePtr;
+ bcFramePtr->nextPtr = iPtr->cmdFramePtr;
+ bcFramePtr->nline = 0;
+ bcFramePtr->line = NULL;
+ bcFramePtr->litarg = NULL;
+ bcFramePtr->data.tebc.codePtr = codePtr;
+ bcFramePtr->data.tebc.pc = NULL;
+ bcFramePtr->cmd.str.cmd = NULL;
+ bcFramePtr->cmd.str.len = 0;
+
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ PrintByteCodeInfo(codePtr);
+ fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
+ fflush(stdout);
+ }
+#endif
+
+#ifdef TCL_COMPILE_STATS
+ iPtr->stats.numExecutions++;
+#endif
+
+ /*
+ * Push the callbacks for
+ * - exception handling and cleanup
+ * - bytecode execution
+ */
+
+ TclNRAddCallback(interp, TEBCreturn, BP, NULL,
+ NULL, NULL);
+ TclNRAddCallback(interp, TEBCresume, BP,
+ /*resume*/ INT2PTR(0), NULL, NULL);
+
+ return TCL_OK;
+}
+
+static int
+TEBCreturn(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ BottomData *BP = data[0];
+ ByteCode *codePtr = BP->codePtr;
+
+ if (--codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+ while (BP->expanded) {
+ BP = BP->expanded;
+ }
+ TclStackFree(interp, BP); /* free my stack */
+
+ return result;
+}
+
+static int
+TEBCresume(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
{
/*
* Compiler cast directive - not a real variable.
* Interp *iPtr = (Interp *) interp;
*/
@@ -1913,66 +2008,44 @@
/*
* Constants: variables that do not change during the execution, used
* sporadically: no special need for speed.
*/
- struct auxTEBCdata {
- ExecStack *esPtr;
- Var *compiledLocals;
- BottomData *bottomPtr; /* Bottom of stack holds NR data */
- BottomData *oldBottomPtr;
- Tcl_Obj **constants;
- int instructionCount; /* Counter that is used to work out when to
+ int instructionCount = 0; /* Counter that is used to work out when to
* call Tcl_AsyncReady() */
- int checkInterp; /* Indicates when a check of interp readyness
- * is necessary. Set by CACHE_STACK_INFO() */
- const char *curInstName;
- int result; /* Return code returned after execution.
- * Result variable - needed only when going to
- * checkForCatch or other error handlers; also
- * used as local in some opcodes. */
-#ifdef TCL_COMPILE_DEBUG
- int traceInstructions; /* Whether we are doing instruction-level
+ const char *curInstName;
+#ifdef TCL_COMPILE_DEBUG
+ int traceInstructions; /* Whether we are doing instruction-level
* tracing or not. */
#endif
- } TAUX = {
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- 0,
- 0,
- NULL,
- TCL_OK
- };
-
-#define LOCAL(i) (&(TAUX.compiledLocals[(i)]))
-#define TCONST(i) (TAUX.constants[(i)])
-#define BP (TAUX.bottomPtr)
-#define OBP (TAUX.oldBottomPtr)
-#define TRESULT (TAUX.result)
+#define LOCAL(i) (&iPtr->varFramePtr->compiledLocals[(i)])
+#define TCONST(i) (iPtr->execEnvPtr->constants[(i)])
/*
* These macros are just meant to save some global variables that are not
* used too frequently
*/
-#define bcFramePtr ((CmdFrame *) (BP + 1))
-#define initCatchTop (((ptrdiff_t *) (bcFramePtr + 1)) - 1)
-#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
+ BottomData *BP = data[0];
#define auxObjList (BP->auxObjList)
#define catchTop (BP->catchTop)
+#define codePtr (BP->codePtr)
+#define checkInterp (BP->checkInterp)
+ /* Indicates when a check of interp readyness
+ * is necessary. Set by CACHE_STACK_INFO() */
/*
* Globals: variables that store state, must remain valid at all times.
*/
- Tcl_Obj **tosPtr = NULL; /* Cached pointer to top of evaluation
- * stack. */
- const unsigned char *pc = NULL;
- /* The current program counter. */
+ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
+ * stack. */
+ const unsigned char *pc; /* The current program counter. */
+
+#ifdef TCL_COMPILE_DEBUG
+ traceInstructions = (tclTraceExec == 3);
+#endif
/*
* Transfer variables - needed only between opcodes, but not while
* executing an instruction.
*/
@@ -1992,124 +2065,76 @@
Var *varPtr, *arrayPtr;
#ifdef TCL_COMPILE_DEBUG
char cmdNameBuf[21];
#endif
- TAUX.constants = &iPtr->execEnvPtr->constants[0];
- if (!codePtr) {
- CoroutineData *corPtr;
-
- resumeCoroutine:
- /*
- * Reawakening a suspended coroutine: the [yield] command is
- * returning:
- * - monkey-patch the cmdFrame chain
- * - set the running level of the coroutine
- * - monkey-patch the BP chain
- * - restart the code at [yield]'s return
- */
-
- corPtr = iPtr->execEnvPtr->corPtr;
-
- NRE_ASSERT(corPtr != NULL);
- NRE_ASSERT(corPtr->eePtr == iPtr->execEnvPtr);
- NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
-
+ NR_DATA_DIG();
+
+ if (data[1] /* resume from invocation */) {
if (iPtr->execEnvPtr->rewind) {
- TRESULT = TCL_ERROR;
- }
-
- corPtr->base.cmdFramePtr->nextPtr = corPtr->caller.cmdFramePtr;
- corPtr->stackLevel = &TAUX;
- *corPtr->callerBPPtr = OBP;
- OBP = iPtr->execEnvPtr->bottomPtr;
- goto returnToCaller;
- }
-
- /*
- * The execution uses a unified stack: first a BottomData, immediately
- * above it a CmdFrame, then the catch stack, then the execution stack.
- *
- * Make sure the catch stack is large enough to hold the maximum number of
- * catch commands that could ever be executing at the same time (this will
- * be no more than the exception range array's depth). Make sure the
- * execution stack is large enough to execute this ByteCode.
- */
-
- nonRecursiveCallStart:
-#ifdef TCL_COMPILE_DEBUG
- TAUX.traceInstructions = (tclTraceExec == 3);
-#endif
- codePtr->refCount++;
- BP = (BottomData *) GrowEvaluationStack(iPtr->execEnvPtr,
- sizeof(BottomData) + codePtr->maxExceptDepth + sizeof(CmdFrame)
- + codePtr->maxStackDepth, 0);
- TAUX.curInstName = NULL;
- auxObjList = NULL;
- NR_DATA_INIT(); /* record this level's data */
-
- iPtr->execEnvPtr->bottomPtr = BP;
- TAUX.esPtr = iPtr->execEnvPtr->execStackPtr;
-
- TAUX.compiledLocals = iPtr->varFramePtr->compiledLocals;
-
- pc = codePtr->codeStart;
- catchTop = initCatchTop;
- tosPtr = initTosPtr;
-
- /*
- * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
- * every time that we call out from this BP, popped when we return to it.
- */
-
- bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
- ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
- bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
- bcFramePtr->numLevels = iPtr->numLevels;
- bcFramePtr->framePtr = iPtr->framePtr;
- bcFramePtr->nextPtr = iPtr->cmdFramePtr;
- bcFramePtr->nline = 0;
- bcFramePtr->line = NULL;
- bcFramePtr->litarg = NULL;
- bcFramePtr->data.tebc.codePtr = codePtr;
- bcFramePtr->data.tebc.pc = NULL;
- bcFramePtr->cmd.str.cmd = NULL;
- bcFramePtr->cmd.str.len = 0;
-
- if (iPtr->execEnvPtr->corPtr) {
- CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-
- if (!corPtr->base.cmdFramePtr) {
- /*
- * First coroutine run, incomplete init:
- * - base.cmdFramePtr not set
- * - need to monkey-patch the BP chain
- * - set the running level for the coroutine
- */
-
- corPtr->base.cmdFramePtr = bcFramePtr;
- corPtr->callerBPPtr = &BP->prevBottomPtr;
- corPtr->stackLevel = &TAUX;
- }
-
- if (iPtr->execEnvPtr->rewind) {
- TRESULT = TCL_ERROR;
- goto abnormalReturn;
- }
- }
-
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceExec >= 2) {
- PrintByteCodeInfo(codePtr);
- fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
- fflush(stdout);
- }
-#endif
-
-#ifdef TCL_COMPILE_STATS
- iPtr->stats.numExecutions++;
-#endif
+ result = TCL_ERROR;
+ }
+ NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
+ NRE_ASSERT(TOP_CB(interp)->procPtr == TEBCreturn);
+ iPtr->cmdFramePtr = bcFramePtr->nextPtr;
+ TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+
+ if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
+ }
+
+ CACHE_STACK_INFO();
+ if (result == TCL_OK) {
+#ifndef TCL_COMPILE_DEBUG
+ if (*pc == INST_POP) {
+ NEXT_INST_V(1, cleanup, 0);
+ }
+#endif
+ /*
+ * Push the call's object result and continue execution with
+ * the next instruction.
+ */
+
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
+
+ objResultPtr = Tcl_GetObjResult(interp);
+
+ /*
+ * Reset the interp's result to avoid possible duplications of
+ * large objects [Bug 781585]. We do not call Tcl_ResetResult
+ * to avoid any side effects caused by the resetting of
+ * errorInfo and errorCode [Bug 804681], which are not needed
+ * here. We chose instead to manipulate the interp's object
+ * result directly.
+ *
+ * Note that the result object is now in objResultPtr, it
+ * keeps the refCount it had in its role of
+ * iPtr->objResultPtr.
+ */
+
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
+ NEXT_INST_V(0, cleanup, -1);
+ }
+
+ /*
+ * Result not TCL_OK: fall through
+ */
+ }
+
+ if (iPtr->execEnvPtr->rewind) {
+ result = TCL_ERROR;
+ goto abnormalReturn;
+ }
+
+ if (result != TCL_OK) {
+ pc--;
+ goto processExceptionReturn;
+ }
/*
* Loop executing instructions until a "done" instruction, a TCL_RETURN,
* or some error.
*/
@@ -2179,11 +2204,11 @@
* Skip the stack depth check if an expansion is in progress.
*/
ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0,
/*checkStack*/ auxObjList == NULL);
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
TclPrintInstruction(codePtr, pc);
fflush(stdout);
}
#endif /* TCL_COMPILE_DEBUG */
@@ -2195,15 +2220,15 @@
/*
* Check for asynchronous handlers [Bug 746722]; we do the check every
* ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
*/
- if ((TAUX.instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+ if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
DECACHE_STACK_INFO();
if (TclAsyncReady(iPtr)) {
- TRESULT = Tcl_AsyncInvoke(interp, TRESULT);
- if (TRESULT == TCL_ERROR) {
+ result = Tcl_AsyncInvoke(interp, result);
+ if (result == TCL_ERROR) {
CACHE_STACK_INFO();
goto gotError;
}
}
@@ -2247,13 +2272,13 @@
/*
* OBJ_AT_TOS is returnOpts, OBJ_UNDER_TOS is resultObjPtr.
*/
TRACE(("%u %u => ", code, level));
- TRESULT = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
- if (TRESULT == TCL_OK) {
- TRACE_APPEND(("continuing to next instruction (TRESULT=\"%.30s\")",
+ result = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
+ if (result == TCL_OK) {
+ TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
O2S(objResultPtr)));
NEXT_INST_F(9, 1, 0);
}
Tcl_SetObjResult(interp, OBJ_UNDER_TOS);
if (*pc == INST_SYNTAX) {
@@ -2264,15 +2289,15 @@
}
case INST_RETURN_STK:
TRACE(("=> "));
objResultPtr = POP_OBJECT();
- TRESULT = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
+ result = Tcl_SetReturnOptions(interp, OBJ_AT_TOS);
Tcl_DecrRefCount(OBJ_AT_TOS);
OBJ_AT_TOS = objResultPtr;
- if (TRESULT == TCL_OK) {
- TRACE_APPEND(("continuing to next instruction (TRESULT=\"%.30s\")",
+ if (result == TCL_OK) {
+ TRACE_APPEND(("continuing to next instruction (result=\"%.30s\")",
O2S(objResultPtr)));
NEXT_INST_F(1, 0, 0);
}
Tcl_SetObjResult(interp, objResultPtr);
cleanup = 1;
@@ -2287,13 +2312,13 @@
* or "abnormalReturn".
*/
Tcl_SetObjResult(interp, OBJ_AT_TOS);
#ifdef TCL_COMPILE_DEBUG
- TRACE_WITH_OBJ(("=> return code=%d, result=", TRESULT),
+ TRACE_WITH_OBJ(("=> return code=%d, result=", result),
iPtr->objResultPtr);
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, "\n");
}
#endif
goto checkForCatch;
}
@@ -2352,16 +2377,16 @@
* that the interp is not deleted. If no outside call has been made
* since the last check, it is safe to omit the check.
*/
iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
- if (!TAUX.checkInterp) {
+ if (!checkInterp) {
goto instStartCmdOK;
} else if (((codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsEpoch == iPtr->varFramePtr->nsPtr->resolverEpoch))
|| (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
- TAUX.checkInterp = 0;
+ checkInterp = 0;
instStartCmdOK:
NEXT_INST_F(9, 0, 0);
} else {
const char *bytes;
@@ -2611,20 +2636,20 @@
length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
DECACHE_STACK_INFO();
moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
- (Tcl_Obj **) BP;
-
if (moved) {
/*
* Change the global data to point to the new stack: move the
* bottomPtr, recompute the position of every other
* stack-allocated parameter, update the stack pointers.
*/
- BP = (BottomData *) (((Tcl_Obj **)BP) + moved);
- TAUX.esPtr = iPtr->execEnvPtr->execStackPtr;
+ esPtr = iPtr->execEnvPtr->execStackPtr;
+ BP->expanded = (BottomData *) (((Tcl_Obj **)BP) + moved);
+ BP = BP->expanded;
catchTop += moved;
tosPtr += moved;
}
@@ -2640,109 +2665,36 @@
Tcl_DecrRefCount(objPtr);
NEXT_INST_F(5, 0, 0);
}
case INST_EXPR_STK: {
- /*
- * Moved here to support transforming the eval of an expression to
- * a non-recursive TEBC call.
- */
-
ByteCode *newCodePtr;
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
DECACHE_STACK_INFO();
newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
CACHE_STACK_INFO();
cleanup = 1;
pc++;
- NR_DATA_BURY();
- codePtr = newCodePtr;
- goto nonRecursiveCallStart;
+ NR_YIELD(1);
+ return TclNRExecuteByteCode(interp, newCodePtr);
}
/*
* INVOCATION BLOCK
*/
instEvalStk:
case INST_EVAL_STK:
- /*
- * Moved here to support transforming the eval of objects to a simple
- * command invocation (for canonical lists) or a non-recursive TEBC
- * call (compiled scripts).
- */
-
- objPtr = OBJ_AT_TOS;
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
+
cleanup = 1;
- pcAdjustment = 1;
-
- if (objPtr->typePtr == &tclListType) {
- List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_Obj *copyPtr;
-
- /*
- * Test if the list is "pure" or "canonical", since in that case
- * we can know for sure that there are no syntactic nasties and
- * treat the list's elements as literal words without need for
- * further substitution. "Pure" lists are those that have no
- * string representation at all; they're known OK because we know
- * the algorithm for generating the string representation never
- * produces hazards. "Canonical" lists are where we know that the
- * string representation was produced from the internal
- * representation of the list.
- */
-
- if (objPtr->bytes == NULL || listRepPtr->canonicalFlag) {
- if (Tcl_IsShared(objPtr)) {
- copyPtr = TclListObjCopy(interp, objPtr);
- Tcl_IncrRefCount(copyPtr);
- OBJ_AT_TOS = copyPtr;
- listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
-
- /*
- * Decrement the refcount on the *original* copy of the
- * list directly; we know it was greater than 1 here so it
- * can't be deallocated.
- */
-
- objPtr->refCount--;
- }
- objc = listRepPtr->elemCount;
- objv = &listRepPtr->elements;
-
- /*
- * Fix for [Bug 2102930]
- */
-
- iPtr->numLevels++;
- Tcl_NRAddCallback(interp, NRCommand, NULL,NULL,NULL,NULL);
- goto doInvocationFromEval;
- }
- }
-
- /*
- * Run the bytecode in this same TEBC instance!
- *
- * TIP #280: The invoking context is left NULL for a dynamically
- * constructed command. We cannot match its lines to the outer
- * context.
- */
-
- {
- ByteCode *newCodePtr;
-
- DECACHE_STACK_INFO();
- newCodePtr = TclCompileObj(interp, objPtr, NULL, 0);
- bcFramePtr->data.tebc.pc = (char *) pc;
- iPtr->cmdFramePtr = bcFramePtr;
- pc++;
- NR_DATA_BURY();
- codePtr = newCodePtr;
- goto nonRecursiveCallStart;
- }
+ pc += 1;
+ NR_YIELD(1);
+ return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);
case INST_INVOKE_EXPANDED:
CLANG_ASSERT(auxObjList);
objc = CURR_DEPTH
- (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr1;
@@ -2769,17 +2721,16 @@
pcAdjustment = 2;
doInvocation:
objv = &OBJ_AT_DEPTH(objc-1);
cleanup = objc;
- doInvocationFromEval:
#ifdef TCL_COMPILE_DEBUG
if (tclTraceExec >= 2) {
int i;
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
TRACE(("%u => call ", objc));
} else {
fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
(unsigned)(pc - codePtr->codeStart));
@@ -2801,152 +2752,19 @@
*/
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
- /*
- * Reset the instructionCount variable, since we're about to check for
- * async stuff anyway while processing TclEvalObjv
- */
-
- TAUX.instructionCount = 1;
-
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
codePtr, bcFramePtr, pc - codePtr->codeStart);
DECACHE_STACK_INFO();
- TRESULT = TclNREvalObjv(interp, objc, objv,
- (*pc == INST_EVAL_STK) ? 0 : TCL_EVAL_NOERR, NULL);
- TRESULT = TclNRRunCallbacks(interp, TRESULT, BP->rootPtr, 1);
- CACHE_STACK_INFO();
-
- if (TOP_CB(interp) != BP->rootPtr) {
- TEOV_callback *callbackPtr;
- int type;
- ClientData param;
-
- NRE_ASSERT(TRESULT == TCL_OK);
- pc += pcAdjustment;
-
- nonRecursiveCallSetup:
- callbackPtr = TOP_CB(interp);
- type = PTR2INT(callbackPtr->data[0]);
- param = callbackPtr->data[1];
-
- pcAdjustment = 0; /* silence warning */
-
- NRE_ASSERT(callbackPtr != BP->rootPtr);
- NRE_ASSERT(callbackPtr->procPtr == NRCallTEBC);
-
- TOP_CB(interp) = callbackPtr->nextPtr;
- TCLNR_FREE(interp, callbackPtr);
-
- NR_DATA_BURY();
- switch (type) {
- case TCL_NR_BC_TYPE:
- if (param) {
- codePtr = param;
- goto nonRecursiveCallStart;
- } else {
- OBP = BP;
- goto resumeCoroutine;
- }
- case TCL_NR_YIELD_TYPE: { /* [yield] */
- CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-
- if (!corPtr) {
- Tcl_SetResult(interp,
- "yield can only be called in a coroutine",
- TCL_STATIC);
- DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE",
- "ILLEGAL_YIELD", NULL);
- CACHE_STACK_INFO();
- pc--;
- goto gotError;
- }
-
- NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
- NRE_ASSERT(corPtr->stackLevel != NULL);
- if (corPtr->stackLevel != &TAUX) {
- Tcl_SetResult(interp, "cannot yield: C stack busy",
- TCL_STATIC);
- DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
- NULL);
- CACHE_STACK_INFO();
- pc--;
- goto gotError;
- }
-
- /*
- * Mark suspended, save our state and return
- */
-
- DECACHE_STACK_INFO();
- corPtr->stackLevel = NULL;
- iPtr->execEnvPtr = corPtr->callerEEPtr;
- OBP = *corPtr->callerBPPtr;
- goto returnToCaller;
- }
- default:
- Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
- }
- }
-
pc += pcAdjustment;
-
- nonRecursiveCallReturn:
- if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
- iPtr->flags |= ERR_ALREADY_LOGGED;
- codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
- }
- NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
- iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
-
- if (iPtr->execEnvPtr->rewind) {
- TRESULT = TCL_ERROR;
- goto abnormalReturn;
- }
-
- if (TRESULT != TCL_OK) {
- pc--;
- goto processExceptionReturn;
- }
-
-#ifndef TCL_COMPILE_DEBUG
- if (*pc == INST_POP) {
- NEXT_INST_V(1, cleanup, 0);
- }
-#endif
- /*
- * Push the call's object result and continue execution with the next
- * instruction.
- */
-
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
-
- objResultPtr = Tcl_GetObjResult(interp);
-
- /*
- * Reset the interp's result to avoid possible duplications of large
- * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
- * side effects caused by the resetting of errorInfo and errorCode
- * [Bug 804681], which are not needed here. We chose instead to
- * manipulate the interp's object result directly.
- *
- * Note that the result object is now in objResultPtr, it keeps the
- * refCount it had in its role of iPtr->objResultPtr.
- */
-
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr);
- iPtr->objResultPtr = objPtr;
- NEXT_INST_V(0, cleanup, -1);
+ NR_YIELD(1);
+ return TclNREvalObjv(interp, objc, objv,
+ TCL_EVAL_NOERR, NULL);
#if TCL_SUPPORT_84_BYTECODE
case INST_CALL_BUILTIN_FUNC1:
/*
* Call one of the built-in pre-8.5 Tcl math functions. This
@@ -2956,11 +2774,11 @@
*/
opnd = TclGetUInt1AtPtr(pc+1);
if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
- Tcl_Panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
+ Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
}
TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
@@ -3024,13 +2842,13 @@
* changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
* remains for existing bytecode precompiled files.
*/
case INST_CALL_BUILTIN_FUNC1:
- Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
+ Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
case INST_CALL_FUNC1:
- Tcl_Panic("TclExecuteByteCode: obsolete INST_CALL_FUNC1 found");
+ Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
#endif
/*
* -----------------------------------------------------------------
* Start of INST_LOAD instructions.
@@ -5507,21 +5325,21 @@
/*
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
*/
- TRESULT = TCL_BREAK;
+ result = TCL_BREAK;
cleanup = 0;
goto processExceptionReturn;
case INST_CONTINUE:
/*
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
*/
- TRESULT = TCL_CONTINUE;
+ result = TCL_CONTINUE;
cleanup = 0;
goto processExceptionReturn;
{
ForeachInfo *infoPtr;
@@ -5701,11 +5519,11 @@
case INST_END_CATCH:
catchTop--;
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
- TRESULT = TCL_OK;
+ result = TCL_OK;
TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
NEXT_INST_F(1, 0, 0);
case INST_PUSH_RESULT:
objResultPtr = Tcl_GetObjResult(interp);
@@ -5719,16 +5537,18 @@
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
NEXT_INST_F(1, 0, -1);
case INST_PUSH_RETURN_CODE:
- TclNewIntObj(objResultPtr, TRESULT);
- TRACE(("=> %u\n", TRESULT));
+ TclNewIntObj(objResultPtr, result);
+ TRACE(("=> %u\n", result));
NEXT_INST_F(1, 0, 1);
case INST_PUSH_RETURN_OPTIONS:
- objResultPtr = Tcl_GetReturnOptions(interp, TRESULT);
+ DECACHE_STACK_INFO();
+ objResultPtr = Tcl_GetReturnOptions(interp, result);
+ CACHE_STACK_INFO();
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
case INST_RETURN_CODE_BRANCH: {
int code;
@@ -5822,18 +5642,18 @@
}
switch (*pc) {
case INST_DICT_SET:
cleanup = opnd + 1;
- TRESULT = Tcl_DictObjPutKeyList(interp, dictPtr, opnd,
+ result = Tcl_DictObjPutKeyList(interp, dictPtr, opnd,
&OBJ_AT_DEPTH(opnd), OBJ_AT_TOS);
break;
case INST_DICT_INCR_IMM:
cleanup = 1;
opnd = TclGetInt4AtPtr(pc+1);
- TRESULT = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valuePtr);
- if (TRESULT != TCL_OK) {
+ result = Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS, &valuePtr);
+ if (result != TCL_OK) {
break;
}
if (valuePtr == NULL) {
Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
} else {
@@ -5841,28 +5661,28 @@
Tcl_IncrRefCount(value2Ptr);
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valuePtr);
}
- TRESULT = TclIncrObj(interp, valuePtr, value2Ptr);
- if (TRESULT == TCL_OK) {
+ result = TclIncrObj(interp, valuePtr, value2Ptr);
+ if (result == TCL_OK) {
Tcl_InvalidateStringRep(dictPtr);
}
TclDecrRefCount(value2Ptr);
}
break;
case INST_DICT_UNSET:
cleanup = opnd;
- TRESULT = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,
+ result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,
&OBJ_AT_DEPTH(opnd-1));
break;
default:
cleanup = 0; /* stop compiler warning */
Tcl_Panic("Should not happen!");
}
- if (TRESULT != TCL_OK) {
+ if (result != TCL_OK) {
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
opnd, opnd2), Tcl_GetObjResult(interp));
@@ -6248,11 +6068,11 @@
* End of dictionary-related instructions.
* -----------------------------------------------------------------
*/
default:
- Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
+ Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
} /* end of switch on opCode */
/*
* Block for variables needed to process exception returns.
*/
@@ -6292,54 +6112,54 @@
break;
default:
TRACE(("=> "));
}
#endif
- if ((TRESULT == TCL_CONTINUE) || (TRESULT == TCL_BREAK)) {
+ if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
if (rangePtr == NULL) {
TRACE_APPEND(("no encl. loop or catch, returning %s\n",
- StringForResultCode(TRESULT)));
+ StringForResultCode(result)));
goto abnormalReturn;
}
if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
- TRACE_APPEND(("%s ...\n", StringForResultCode(TRESULT)));
+ TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
goto processCatch;
}
while (cleanup--) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
- if (TRESULT == TCL_BREAK) {
- TRESULT = TCL_OK;
+ if (result == TCL_BREAK) {
+ result = TCL_OK;
pc = (codePtr->codeStart + rangePtr->breakOffset);
TRACE_APPEND(("%s, range at %d, new pc %d\n",
- StringForResultCode(TRESULT),
+ StringForResultCode(result),
rangePtr->codeOffset, rangePtr->breakOffset));
NEXT_INST_F(0, 0, 0);
}
if (rangePtr->continueOffset == -1) {
TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
- StringForResultCode(TRESULT)));
+ StringForResultCode(result)));
goto checkForCatch;
}
- TRESULT = TCL_OK;
+ result = TCL_OK;
pc = (codePtr->codeStart + rangePtr->continueOffset);
TRACE_APPEND(("%s, range at %d, new pc %d\n",
- StringForResultCode(TRESULT),
+ StringForResultCode(result),
rangePtr->codeOffset, rangePtr->continueOffset));
NEXT_INST_F(0, 0, 0);
}
#if TCL_COMPILE_DEBUG
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
objPtr = Tcl_GetObjResult(interp);
- if ((TRESULT != TCL_ERROR) && (TRESULT != TCL_RETURN)) {
+ if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
- TRESULT, O2S(objPtr)));
+ result, O2S(objPtr)));
} else {
TRACE_APPEND(("%s, result= \"%s\"\n",
- StringForResultCode(TRESULT), O2S(objPtr)));
+ StringForResultCode(result), O2S(objPtr)));
}
}
#endif
goto checkForCatch;
@@ -6368,15 +6188,15 @@
"exponentiation of zero by negative power", NULL);
CACHE_STACK_INFO();
/*
* Almost all error paths feed through here rather than assigning to
- * TRESULT themselves (for a small but consistent saving).
+ * result themselves (for a small but consistent saving).
*/
gotError:
- TRESULT = TCL_ERROR;
+ result = TCL_ERROR;
/*
* Execution has generated an "exception" such as TCL_ERROR. If the
* exception is an error, record information about what was being
* executed when the error occurred. Find the closest enclosing catch
@@ -6386,11 +6206,11 @@
checkForCatch:
if (iPtr->execEnvPtr->rewind) {
goto abnormalReturn;
}
- if ((TRESULT == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
bytes = GetSrcInfoForPc(pc, codePtr, &length);
DECACHE_STACK_INFO();
Tcl_LogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0);
CACHE_STACK_INFO();
}
@@ -6418,13 +6238,13 @@
* already be set prior to vectoring down to this point in the code.
*/
if (Tcl_Canceled(interp, 0) == TCL_ERROR) {
#ifdef TCL_COMPILE_DEBUG
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, " ... cancel with unwind, returning %s\n",
- StringForResultCode(TRESULT));
+ StringForResultCode(result));
}
#endif
goto abnormalReturn;
}
@@ -6434,22 +6254,22 @@
* is not exceeded) or we get to the top-level.
*/
if (TclLimitExceeded(iPtr->limit)) {
#ifdef TCL_COMPILE_DEBUG
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, " ... limit exceeded, returning %s\n",
- StringForResultCode(TRESULT));
+ StringForResultCode(result));
}
#endif
goto abnormalReturn;
}
if (catchTop == initCatchTop) {
#ifdef TCL_COMPILE_DEBUG
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, " ... no enclosing catch, returning %s\n",
- StringForResultCode(TRESULT));
+ StringForResultCode(result));
}
#endif
goto abnormalReturn;
}
rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
@@ -6459,13 +6279,13 @@
* script to INST_EVAL. Cannot correct the compiler without
* breaking compat with previous .tbc compiled scripts.
*/
#ifdef TCL_COMPILE_DEBUG
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, " ... no enclosing catch, returning %s\n",
- StringForResultCode(TRESULT));
+ StringForResultCode(result));
}
#endif
goto abnormalReturn;
}
@@ -6481,11 +6301,11 @@
while (CURR_DEPTH > *catchTop) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
#ifdef TCL_COMPILE_DEBUG
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, " ... found catch at %d, catchTop=%d, "
"unwound to %ld, new pc %u\n",
rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
(long) *catchTop, (unsigned) rangePtr->catchOffset);
}
@@ -6505,22 +6325,10 @@
abnormalReturn:
TCL_DTRACE_INST_LAST();
/*
- * Winding down: insure that all pending cleanups are done before
- * dropping out of this bytecode.
- */
- if (TOP_CB(interp) != BP->rootPtr) {
- TRESULT = TclNRRunCallbacks(interp, TRESULT, BP->rootPtr, 1);
-
- if (TOP_CB(interp) != BP->rootPtr) {
- Tcl_Panic("Abnormal return with busy callback stack");
- }
- }
-
- /*
* Clear all expansions and same-level NR calls.
*
* Note that expansion markers have a NULL type; avoid removing other
* markers.
*/
@@ -6533,15 +6341,15 @@
Tcl_DecrRefCount(objPtr);
}
if (tosPtr < initTosPtr) {
fprintf(stderr,
- "\nTclExecuteByteCode: abnormal return at pc %u: "
+ "\nTclNRExecuteByteCode: abnormal return at pc %u: "
"stack top %d < entry stack top %d\n",
(unsigned)(pc - codePtr->codeStart),
(unsigned) CURR_DEPTH, (unsigned) 0);
- Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top");
+ Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
}
CLANG_ASSERT(bcFramePtr);
}
/*
@@ -6548,55 +6356,14 @@
* Store the previous bottomPtr for returning to it, then free all
* resources used by this bytecode and process callbacks until you return
* to the previous bytecode (if any).
*/
- OBP = BP->prevBottomPtr;
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- TclStackFree(interp, BP); /* free my stack */
-
- if (--codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
- }
-
- returnToCaller:
- if (OBP) {
- BP = OBP; /* back to old bc */
- TRESULT = TclNRRunCallbacks(interp, TRESULT, BP->rootPtr, 1);
-
- NR_DATA_DIG();
- if (TOP_CB(interp) == BP->rootPtr) {
- /*
- * The bytecode is returning, all callbacks were run: keep
- * processing the caller.
- */
-
- goto nonRecursiveCallReturn;
- } else {
- TEOV_callback *callbackPtr = TOP_CB(iPtr);
- int type = PTR2INT(callbackPtr->data[0]);
-
- NRE_ASSERT(TOP_CB(interp)->procPtr == NRCallTEBC);
- NRE_ASSERT(TRESULT == TCL_OK);
-
- switch (type) {
- case TCL_NR_BC_TYPE:
- /*
- * One of the callbacks requested a new execution: a tailcall!
- * Start the new bytecode.
- */
-
- goto nonRecursiveCallSetup;
- default:
- Tcl_Panic("TEBC: TRCB sent us a callback we cannot handle!");
- }
- }
- }
-
- iPtr->execEnvPtr->bottomPtr = NULL;
- return TRESULT;
-}
+ return result;
+}
+#undef codePtr
#undef iPtr
#undef bcFramePtr
#undef initCatchTop
#undef initTosPtr
#undef auxObjList
@@ -7965,11 +7732,11 @@
*----------------------------------------------------------------------
*
* PrintByteCodeInfo --
*
* This procedure prints a summary about a bytecode object to stdout. It
- * is called by TclExecuteByteCode when starting to execute the bytecode
+ * is called by TclNRExecuteByteCode when starting to execute the bytecode
* object if tclTraceExec has the value 2 or more.
*
* Results:
* None.
*
@@ -8026,11 +7793,11 @@
/*
*----------------------------------------------------------------------
*
* ValidatePcAndStackTop --
*
- * This procedure is called by TclExecuteByteCode when debugging to
+ * This procedure is called by TclNRExecuteByteCode when debugging to
* verify that the program counter and stack top are valid during
* execution.
*
* Results:
* None.
@@ -8063,25 +7830,25 @@
unsigned long codeEnd = (unsigned long)
(codePtr->codeStart + codePtr->numCodeBytes);
unsigned char opCode = *pc;
if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) {
- fprintf(stderr, "\nBad instruction pc 0x%p in TclExecuteByteCode\n",
+ fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
pc);
- Tcl_Panic("TclExecuteByteCode execution failure: bad pc");
+ Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
}
if ((unsigned) opCode > LAST_INST_OPCODE) {
- fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
+ fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n",
(unsigned) opCode, relativePc);
- Tcl_Panic("TclExecuteByteCode execution failure: bad opcode");
+ Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
if (checkStack &&
((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
int numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
- fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
+ fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min %i, max %i)",
stackTop, relativePc, stackLowerBound, stackUpperBound);
if (cmd != NULL) {
Tcl_Obj *message;
TclNewLiteralStringObj(message, "\n executing ");
@@ -8090,21 +7857,21 @@
fprintf(stderr,"%s\n", Tcl_GetString(message));
Tcl_DecrRefCount(message);
} else {
fprintf(stderr, "\n");
}
- Tcl_Panic("TclExecuteByteCode execution failure: bad stack top");
+ Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
}
}
#endif /* TCL_COMPILE_DEBUG */
/*
*----------------------------------------------------------------------
*
* IllegalExprOperandType --
*
- * Used by TclExecuteByteCode to append an error message to the interp
+ * Used by TclNRExecuteByteCode to append an error message to the interp
* result when an illegal operand type is detected by an expression
* instruction. The argument opndPtr holds the operand object in error.
*
* Results:
* None.
@@ -8424,11 +8191,11 @@
*----------------------------------------------------------------------
*
* GetOpcodeName --
*
* This procedure is called by the TRACE and TRACE_WITH_OBJ macros used
- * in TclExecuteByteCode when debugging. It returns the name of the
+ * in TclNRExecuteByteCode when debugging. It returns the name of the
* bytecode instruction at a specified instruction pc.
*
* Results:
* A character string for the instruction.
*
Index: generic/tclInt.decls
===================================================================
--- generic/tclInt.decls
+++ generic/tclInt.decls
@@ -959,11 +959,11 @@
int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
int skip, ProcErrorProc *errorProc)
}
declare 240 {
int TclNRRunCallbacks(Tcl_Interp *interp, int result,
- struct TEOV_callback *rootPtr, int tebcCall)
+ struct TEOV_callback *rootPtr)
}
declare 241 {
int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
const CmdFrame *invoker, int word)
}
Index: generic/tclInt.h
===================================================================
--- generic/tclInt.h
+++ generic/tclInt.h
@@ -1475,20 +1475,16 @@
* the coroutine, which might be the
* interpreter global environment or another
* coroutine. */
CorContext caller;
CorContext running;
- CorContext base;
+ Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */
void *stackLevel;
int auxNumLevels; /* While the coroutine is running the
* numLevels of the create/resume command is
* stored here; for suspended coroutines it
* holds the nesting numLevels at yield. */
- struct BottomData **callerBPPtr;
- /* Where to stash the caller's bottomPointer,
- * if the coro is running in the caller's TEBC
- * instance. Put a NULL in there otherwise. */
int nargs; /* Number of args required for resuming this
* coroutine; -2 means "0 or 1" (default), -1
* means "any" */
} CoroutineData;
@@ -1498,11 +1494,10 @@
Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */
struct Tcl_Interp *interp;
struct TEOV_callback *callbackPtr;
/* Top callback in TEOV's stack. */
struct CoroutineData *corPtr;
- struct BottomData *bottomPtr;
int rewind;
} ExecEnv;
#define COR_IS_SUSPENDED(corPtr) \
((corPtr)->stackLevel == NULL)
Index: generic/tclIntDecls.h
===================================================================
--- generic/tclIntDecls.h
+++ generic/tclIntDecls.h
@@ -569,11 +569,11 @@
EXTERN int TclNRInterpProcCore(Tcl_Interp *interp,
Tcl_Obj *procNameObj, int skip,
ProcErrorProc *errorProc);
/* 240 */
EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result,
- struct TEOV_callback *rootPtr, int tebcCall);
+ struct TEOV_callback *rootPtr);
/* 241 */
EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags, const CmdFrame *invoker, int word);
/* 242 */
EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc,
@@ -839,11 +839,11 @@
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
- int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct TEOV_callback *rootPtr, int tebcCall); /* 240 */
+ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct TEOV_callback *rootPtr); /* 240 */
int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
Index: generic/tclObj.c
===================================================================
--- generic/tclObj.c
+++ generic/tclObj.c
@@ -4178,11 +4178,11 @@
*
* Side effects:
* The object's old internal rep is freed. It's string rep is not
* changed. The refcount in the Command structure is incremented to keep
* it from being freed if the command is later deleted until
- * TclExecuteByteCode has a chance to recognize that it was deleted.
+ * TclNRExecuteByteCode has a chance to recognize that it was deleted.
*
*----------------------------------------------------------------------
*/
void
Index: generic/tclProc.c
===================================================================
--- generic/tclProc.c
+++ generic/tclProc.c
@@ -1809,13 +1809,11 @@
procPtr->refCount++;
codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
NULL, NULL);
- TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
- NULL, NULL);
- return TCL_OK;
+ return TclNRExecuteByteCode(interp, codePtr);
}
static int
InterpProcNR2(
ClientData data[],
Index: generic/tclTest.c
===================================================================
--- generic/tclTest.c
+++ generic/tclTest.c
@@ -1180,11 +1180,11 @@
} else if (strcmp(argv[1], "deletetest") == 0) {
/*
* Create a command trace then eval a script to check whether it is
* called. Note that this trace procedure removes itself as a further
* check of the robustness of the trace proc calling code in
- * TclExecuteByteCode.
+ * TclNRExecuteByteCode.
*/
cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
Tcl_Eval(interp, argv[2]);
} else if (strcmp(argv[1], "leveltest") == 0) {
@@ -1280,11 +1280,11 @@
int argc, /* Number of arguments. */
const char *argv[]) /* Argument strings. */
{
/*
* Remove ourselves to test whether calling Tcl_DeleteTrace within a trace
- * callback causes the for loop in TclExecuteByteCode that calls traces to
+ * callback causes the for loop in TclNRExecuteByteCode that calls traces to
* reference freed memory.
*/
Tcl_DeleteTrace(interp, cmdTrace);
}
Index: pkgs/itcl/generic/itcl2TclOO.c
===================================================================
--- pkgs/itcl/generic/itcl2TclOO.c
+++ pkgs/itcl/generic/itcl2TclOO.c
@@ -50,11 +50,11 @@
int
Itcl_NRRunCallbacks(
Tcl_Interp *interp,
void *rootPtr)
{
- return TclNRRunCallbacks(interp, TCL_OK, rootPtr, 0);
+ return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
static int
CallFinalizePMCall(
ClientData data[],
