summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c5
-rw-r--r--generic/tclBasic.c327
-rw-r--r--generic/tclCmdIL.c19
-rw-r--r--generic/tclCompExpr.c6
-rw-r--r--generic/tclCompile.c10
-rw-r--r--generic/tclCompile.h9
-rw-r--r--generic/tclExecute.c847
-rw-r--r--generic/tclInt.decls4
-rw-r--r--generic/tclInt.h9
-rw-r--r--generic/tclIntDecls.h6
-rw-r--r--generic/tclOOMethod.c61
-rw-r--r--generic/tclObj.c4
-rw-r--r--generic/tclProc.c6
-rw-r--r--generic/tclTest.c6
-rw-r--r--generic/tclVar.c7
15 files changed, 499 insertions, 827 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 660f101..4735a59 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -533,10 +533,13 @@ TclNRAssembleObjCmd(
/* Use NRE to evaluate the bytecode from the trampoline */
+ /*
Tcl_NRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_BC_TYPE), codePtr,
NULL, NULL);
-
return TCL_OK;
+ */
+ return TclNRExecuteByteCode(interp, codePtr);
+
}
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1413f66..1937ccc 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.2.1 2010/09/21 19:32:26 kennykb Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.465.2.2 2010/09/27 20:33:37 kennykb 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)
@@ -817,7 +821,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
/*
@@ -3056,7 +3060,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).
*/
@@ -4102,7 +4106,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
@@ -4286,11 +4290,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;
@@ -4312,23 +4314,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);
@@ -4388,41 +4374,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 */
-}
/*
*----------------------------------------------------------------------
@@ -5940,7 +5891,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
@@ -6067,9 +6018,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);
}
{
@@ -8173,7 +8122,7 @@ Tcl_NRCallObjProc(
(Tcl_Obj **)(objv + 1));
}
result = objProc(clientData, interp, objc, objv);
- return TclNRRunCallbacks(interp, result, rootPtr, 0);
+ return TclNRRunCallbacks(interp, result, rootPtr);
}
/*
@@ -8487,8 +8436,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;
@@ -8505,38 +8452,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,
@@ -8630,7 +8552,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;
@@ -8648,7 +8569,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);
}
}
@@ -8684,7 +8605,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
@@ -8724,17 +8645,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.
@@ -8742,13 +8656,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,
@@ -8757,7 +8756,6 @@ NRInterpCoroutine(
Tcl_Obj *const objv[]) /* Argument objects. */
{
CoroutineData *corPtr = clientData;
- int nestNumLevels = corPtr->auxNumLevels;
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_ResetResult(interp);
@@ -8798,26 +8796,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;
}
@@ -8830,11 +8810,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 ...?");
@@ -8873,18 +8851,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) {
@@ -8913,84 +8883,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;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 6c9a623..44a3bf3 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.184 2010/08/22 18:53:26 nijtmans Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.184.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#include "tclInt.h"
@@ -1155,11 +1155,22 @@ InfoFrameCmd(
if (iPtr->execEnvPtr->corPtr) {
/*
- * A coroutine: must fix the level computations
+ * A coroutine: must fix the level computations AND the cmdFrame chain,
+ * which is interrupted at the base.
*/
- topLevel += iPtr->execEnvPtr->corPtr->caller.cmdFramePtr->level -
- iPtr->execEnvPtr->corPtr->base.cmdFramePtr->level;
+ 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) {
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index eb72a45..ead8f51 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.105 2010/04/29 23:39:32 msofer Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.105.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#include "tclInt.h"
@@ -2101,6 +2101,7 @@ ExecConstantExprTree(
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
@@ -2118,7 +2119,8 @@ ExecConstantExprTree(
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;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 0807151..4584d78 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.187 2010/08/22 18:53:26 nijtmans Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.187.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#include "tclInt.h"
@@ -915,7 +915,7 @@ Tcl_SubstObj(
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);
@@ -949,9 +949,7 @@ Tcl_NRSubstObj(
/* 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);
}
/*
@@ -1651,7 +1649,7 @@ TclCompileScript(
* 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
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 686f508..e8a40d7 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.126 2010/08/18 15:44:12 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.126.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#ifndef _TCLCOMPILATION
@@ -863,14 +863,9 @@ typedef struct {
*----------------------------------------------------------------
*/
-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
@@ -923,7 +918,7 @@ MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
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,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2998657..ac11a51 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6,7 +6,7 @@
* 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 <das@users.sourceforge.net>
* Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.494.2.2 2010/09/25 14:51:12 kennykb Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.494.2.3 2010/09/27 20:33:37 kennykb Exp $
*/
#include "tclInt.h"
@@ -171,40 +171,29 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
*/
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 { \
@@ -309,19 +298,16 @@ VarHashCreateVar(
/*
* 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
@@ -353,13 +339,13 @@ VarHashCreateVar(
/*
* 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), \
@@ -368,12 +354,12 @@ VarHashCreateVar(
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), \
@@ -399,13 +385,13 @@ VarHashCreateVar(
#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()) { \
@@ -415,8 +401,8 @@ VarHashCreateVar(
} 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)
@@ -734,6 +720,9 @@ 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.
@@ -793,7 +782,7 @@ InitByteCodeExecution(
* 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:
@@ -802,7 +791,7 @@ InitByteCodeExecution(
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -826,7 +815,6 @@ TclCreateExecEnv(
eePtr->interp = interp;
eePtr->callbackPtr = NULL;
eePtr->corPtr = NULL;
- eePtr->bottomPtr = NULL;
eePtr->rewind = 0;
esPtr->prevPtr = NULL;
@@ -1300,7 +1288,7 @@ Tcl_ExprObj(
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
@@ -1363,9 +1351,7 @@ Tcl_NRExprObj(
/*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
@@ -1870,7 +1856,7 @@ TclIncrObj(
/*
*----------------------------------------------------------------------
*
- * TclExecuteByteCode --
+ * TclNRExecuteByteCode --
*
* This procedure executes the instructions of a ByteCode structure. It
* returns when a "done" instruction is executed or an error occurs.
@@ -1885,12 +1871,113 @@ TclIncrObj(
*
*----------------------------------------------------------------------
*/
+#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_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;
@@ -1915,62 +2002,40 @@ TclExecuteByteCode(
* 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. */
+ const char *curInstName;
#ifdef TCL_COMPILE_DEBUG
- int traceInstructions; /* Whether we are doing instruction-level
+ 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
@@ -1994,120 +2059,80 @@ TclExecuteByteCode(
char cmdNameBuf[21];
#endif
- TAUX.constants = &iPtr->execEnvPtr->constants[0];
- if (!codePtr) {
- CoroutineData *corPtr;
+ NR_DATA_DIG();
- 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));
+#ifdef TCL_COMPILE_DEBUG
+ if (!data[1] && (tclTraceExec >= 2)) {
+ PrintByteCodeInfo(codePtr);
+ fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
+ fflush(stdout);
+ }
+#endif
+ if (data[1] /* resume from invocation */) {
if (iPtr->execEnvPtr->rewind) {
- TRESULT = TCL_ERROR;
+ 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;
}
- 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);
+ CACHE_STACK_INFO();
+ if (result == TCL_OK) {
+#ifndef TCL_COMPILE_DEBUG
+ if (*pc == INST_POP) {
+ NEXT_INST_V(1, cleanup, 0);
+ }
#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
+ * Push the call's object result and continue execution with
+ * the next instruction.
*/
-
- corPtr->base.cmdFramePtr = bcFramePtr;
- corPtr->callerBPPtr = &BP->prevBottomPtr;
- corPtr->stackLevel = &TAUX;
- }
-
- if (iPtr->execEnvPtr->rewind) {
- TRESULT = TCL_ERROR;
- goto abnormalReturn;
+
+ 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
+ */
}
-
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceExec >= 2) {
- PrintByteCodeInfo(codePtr);
- fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
- fflush(stdout);
+
+ if (iPtr->execEnvPtr->rewind) {
+ result = TCL_ERROR;
+ goto abnormalReturn;
}
-#endif
-#ifdef TCL_COMPILE_STATS
- iPtr->stats.numExecutions++;
-#endif
+ if (result != TCL_OK) {
+ pc--;
+ goto processExceptionReturn;
+ }
/*
* Loop executing instructions until a "done" instruction, a TCL_RETURN,
@@ -2181,7 +2206,7 @@ TclExecuteByteCode(
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);
@@ -2197,11 +2222,11 @@ TclExecuteByteCode(
* 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;
}
@@ -2249,9 +2274,9 @@ TclExecuteByteCode(
*/
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);
}
@@ -2266,11 +2291,11 @@ TclExecuteByteCode(
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);
}
@@ -2289,9 +2314,9 @@ TclExecuteByteCode(
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
@@ -2354,12 +2379,12 @@ TclExecuteByteCode(
*/
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 {
@@ -2613,7 +2638,6 @@ TclExecuteByteCode(
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
@@ -2621,8 +2645,9 @@ TclExecuteByteCode(
* 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;
@@ -2642,11 +2667,6 @@ TclExecuteByteCode(
}
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;
@@ -2656,9 +2676,8 @@ TclExecuteByteCode(
CACHE_STACK_INFO();
cleanup = 1;
pc++;
- NR_DATA_BURY();
- codePtr = newCodePtr;
- goto nonRecursiveCallStart;
+ NR_YIELD(1);
+ return TclNRExecuteByteCode(interp, newCodePtr);
}
/*
@@ -2667,80 +2686,13 @@ TclExecuteByteCode(
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).
- */
+ bcFramePtr->data.tebc.pc = (char *) pc;
+ iPtr->cmdFramePtr = bcFramePtr;
- objPtr = OBJ_AT_TOS;
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);
@@ -2771,13 +2723,12 @@ TclExecuteByteCode(
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 {
@@ -2803,148 +2754,15 @@ TclExecuteByteCode(
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:
@@ -2958,7 +2776,7 @@ TclExecuteByteCode(
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::");
@@ -3026,9 +2844,9 @@ TclExecuteByteCode(
*/
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
/*
@@ -5509,7 +5327,7 @@ TclExecuteByteCode(
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
*/
- TRESULT = TCL_BREAK;
+ result = TCL_BREAK;
cleanup = 0;
goto processExceptionReturn;
@@ -5519,7 +5337,7 @@ TclExecuteByteCode(
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
*/
- TRESULT = TCL_CONTINUE;
+ result = TCL_CONTINUE;
cleanup = 0;
goto processExceptionReturn;
@@ -5703,7 +5521,7 @@ TclExecuteByteCode(
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);
@@ -5721,12 +5539,14 @@ TclExecuteByteCode(
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);
@@ -5824,14 +5644,14 @@ TclExecuteByteCode(
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) {
@@ -5843,8 +5663,8 @@ TclExecuteByteCode(
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);
@@ -5852,7 +5672,7 @@ TclExecuteByteCode(
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:
@@ -5860,7 +5680,7 @@ TclExecuteByteCode(
Tcl_Panic("Should not happen!");
}
- if (TRESULT != TCL_OK) {
+ if (result != TCL_OK) {
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
@@ -6250,7 +6070,7 @@ TclExecuteByteCode(
*/
default:
- Tcl_Panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
+ Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
} /* end of switch on opCode */
/*
@@ -6294,50 +6114,50 @@ TclExecuteByteCode(
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
@@ -6370,11 +6190,11 @@ TclExecuteByteCode(
/*
* 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
@@ -6388,7 +6208,7 @@ TclExecuteByteCode(
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);
@@ -6420,9 +6240,9 @@ TclExecuteByteCode(
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;
@@ -6436,18 +6256,18 @@ TclExecuteByteCode(
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;
@@ -6461,9 +6281,9 @@ TclExecuteByteCode(
*/
#ifdef TCL_COMPILE_DEBUG
- if (TAUX.traceInstructions) {
+ if (traceInstructions) {
fprintf(stdout, " ... no enclosing catch, returning %s\n",
- StringForResultCode(TRESULT));
+ StringForResultCode(result));
}
#endif
goto abnormalReturn;
@@ -6483,7 +6303,7 @@ TclExecuteByteCode(
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),
@@ -6507,18 +6327,6 @@ TclExecuteByteCode(
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
@@ -6535,11 +6343,11 @@ TclExecuteByteCode(
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);
}
@@ -6550,51 +6358,10 @@ TclExecuteByteCode(
* 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
@@ -7967,7 +7734,7 @@ TclCompareTwoNumbers(
* 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:
@@ -8028,7 +7795,7 @@ PrintByteCodeInfo(
*
* 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.
*
@@ -8065,21 +7832,21 @@ ValidatePcAndStackTop(
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;
@@ -8092,7 +7859,7 @@ ValidatePcAndStackTop(
} else {
fprintf(stderr, "\n");
}
- Tcl_Panic("TclExecuteByteCode execution failure: bad stack top");
+ Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
}
}
#endif /* TCL_COMPILE_DEBUG */
@@ -8102,7 +7869,7 @@ ValidatePcAndStackTop(
*
* 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.
*
@@ -8426,7 +8193,7 @@ GetExceptRangeForPc(
* 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:
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index b7b23d5..44afe71 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tclInt.decls,v 1.148 2010/09/15 07:33:55 nijtmans Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.148.2.1 2010/09/27 20:33:37 kennykb Exp $
library tcl
@@ -961,7 +961,7 @@ declare 239 {
}
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,
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a2fb49f..644eabc 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.482.2.1 2010/09/21 19:32:26 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.482.2.2 2010/09/27 20:33:37 kennykb Exp $
*/
#ifndef _TCLINT
@@ -1477,16 +1477,12 @@ typedef struct CoroutineData {
* 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" */
@@ -1500,7 +1496,6 @@ typedef struct ExecEnv {
struct TEOV_callback *callbackPtr;
/* Top callback in TEOV's stack. */
struct CoroutineData *corPtr;
- struct BottomData *bottomPtr;
int rewind;
} ExecEnv;
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 6231111..5c21492 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIntDecls.h,v 1.142 2010/08/21 16:30:26 nijtmans Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.142.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#ifndef _TCLINTDECLS
@@ -571,7 +571,7 @@ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp,
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);
@@ -841,7 +841,7 @@ typedef struct TclIntStubs {
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 */
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index fcc0638..20f6ab6 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOMethod.c,v 1.26.2.1 2010/09/22 01:08:49 kennykb Exp $
+ * RCS: @(#) $Id: tclOOMethod.c,v 1.26.2.2 2010/09/27 20:33:37 kennykb Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -928,59 +928,18 @@ ProcedureMethodVarResolver(
int flags,
Tcl_Var *varPtr)
{
- Interp *iPtr = (Interp *) interp;
- CallFrame *framePtr = iPtr->varFramePtr;
- CallContext *contextPtr;
- Tcl_Obj *variableObj;
- Tcl_HashEntry *hPtr;
- int i, isNew;
-
- /*
- * Check that the variable is being requested in a context that is also a
- * method call; if not (i.e. we're evaluating in the object's namespace or
- * in a procedure of that namespace) then we do nothing.
- */
-
- if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
- return TCL_CONTINUE;
- }
- contextPtr = framePtr->clientData;
-
- /*
- * Check if the variable is one we want to resolve at all (i.e. whether it
- * is in the list provided by the user). If not, we mustn't do anything
- * either.
- */
+ int result;
+ Tcl_ResolvedVarInfo *rPtr;
+
+ result = ProcedureMethodCompiledVarResolver(interp, varName,
+ strlen(varName), contextNs, &rPtr);
- if (contextPtr->callPtr->chain[contextPtr->index]
- .mPtr->declaringClassPtr != NULL) {
- FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
- .mPtr->declaringClassPtr->variables) {
- if (!strcmp(Tcl_GetString(variableObj), varName)) {
- goto gotMatch;
- }
- }
- } else {
- FOREACH(variableObj, contextPtr->oPtr->variables) {
- if (!strcmp(Tcl_GetString(variableObj), varName)) {
- goto gotMatch;
- }
- }
+ if (result != TCL_OK) {
+ return result;
}
- return TCL_CONTINUE;
-
- /*
- * It is a variable we want to resolve, so resolve it.
- */
- gotMatch:
- hPtr = Tcl_CreateHashEntry(TclVarTable(contextNs), (char *) variableObj,
- &isNew);
- if (isNew) {
- TclSetVarNamespaceVar((Var *) TclVarHashGetValue(hPtr));
- }
- *varPtr = TclVarHashGetValue(hPtr);
- return TCL_OK;
+ *varPtr = rPtr->fetchProc(interp, rPtr);
+ return (*varPtr? TCL_OK : TCL_CONTINUE);
}
static Tcl_Var
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 842c421..5b8cb89 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.174 2010/08/22 18:53:26 nijtmans Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.174.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#include "tclInt.h"
@@ -4180,7 +4180,7 @@ Tcl_GetCommandFromObj(
* 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.
*
*----------------------------------------------------------------------
*/
diff --git a/generic/tclProc.c b/generic/tclProc.c
index d1a90ad..d0c1ca3 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.181 2010/08/22 18:53:26 nijtmans Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.181.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#include "tclInt.h"
@@ -1811,9 +1811,7 @@ TclNRInterpProcCore(
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
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 036a50c..982bd50 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.153 2010/08/22 18:53:26 nijtmans Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.153.2.1 2010/09/27 20:33:37 kennykb Exp $
*/
#undef STATIC_BUILD
@@ -1182,7 +1182,7 @@ TestcmdtraceCmd(
* 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);
@@ -1282,7 +1282,7 @@ CmdTraceDeleteProc(
{
/*
* 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.
*/
diff --git a/generic/tclVar.c b/generic/tclVar.c
index c36dedf..75363cf 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.203.2.1 2010/09/22 01:08:49 kennykb Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.203.2.2 2010/09/27 20:33:37 kennykb Exp $
*/
#include "tclInt.h"
@@ -5998,8 +5998,7 @@ TclInfoVarsCmd(
listPtr = Tcl_NewListObj(0, NULL);
- if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
- || specificNsInPattern) {
+ if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) {
/*
* There is no frame pointer, the frame pointer was pushed only to
* activate a namespace, or we are in a procedure call frame but a
@@ -6235,7 +6234,7 @@ TclInfoLocalsCmd(
return TCL_ERROR;
}
- if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
+ if (!HasLocalVars(iPtr->varFramePtr)) {
return TCL_OK;
}
generated by cgit v0.12 at 2024-11-19 19:17:39 (GMT)