summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2009-12-09 17:55:00 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2009-12-09 17:55:00 (GMT)
commite699453c93c0d61c1571e533dd550088858bd10f (patch)
tree60dc975989dfb52bbb5f88537ac8cd427a8e4d6c
parent284f9241b726a8693f5915c2e37abac122cc1a8a (diff)
downloadtcl-e699453c93c0d61c1571e533dd550088858bd10f.zip
tcl-e699453c93c0d61c1571e533dd550088858bd10f.tar.gz
tcl-e699453c93c0d61c1571e533dd550088858bd10f.tar.bz2
* generic/tclBasic.c: Insure correct lifetime of varFrame's
(objc,objv)for coroutines. * generic/tclExecute.c: Code regrouping
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclBasic.c22
-rw-r--r--generic/tclExecute.c27
3 files changed, 37 insertions, 19 deletions
diff --git a/ChangeLog b/ChangeLog
index 4946c89..46b7254 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2009-12-09 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Insure correct lifetime of varFrame's
+ (objc,objv)for coroutines.
+
+ * generic/tclExecute.c: Code regrouping
+
2009-12-09 Donal K. Fellows <dkf@users.sf.net>
* generic/tclBasic.c: Added some of the missing setting of errorcode
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9839935..d427a3a 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.422 2009/12/09 16:41:19 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.423 2009/12/09 17:55:01 msofer Exp $
*/
#include "tclInt.h"
@@ -8651,8 +8651,9 @@ NRCoroutineExitCallback(
int result)
{
CoroutineData *corPtr = data[0];
+ Tcl_Obj *arglistPtr = data[1];
Command *cmdPtr = corPtr->cmdPtr;
-
+
/*
* This runs at the bottom of the Coroutine's execEnv: it will be executed
* when the coroutine returns or is wound down, but not when it yields. It
@@ -8667,7 +8668,8 @@ NRCoroutineExitCallback(
NRE_ASSERT(iPtr->framePtr->compiledLocals == NULL);
TclPopStackFrame(interp);
-
+ Tcl_DecrRefCount(arglistPtr);
+
cmdPtr->deleteProc = NULL;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
TclCleanupCommandMacro(cmdPtr);
@@ -8768,7 +8770,8 @@ TclNRCoroutineObjCmd(
const char *procName;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_DString ds;
-
+ Tcl_Obj *arglistPtr;
+
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
return TCL_ERROR;
@@ -8853,8 +8856,12 @@ TclNRCoroutineObjCmd(
ckfree((char *) corPtr);
return TCL_ERROR;
}
- framePtr->objc = objc-2;
- framePtr->objv = &objv[2];
+ arglistPtr = Tcl_NewListObj(objc-2, &objv[2]);
+ Tcl_IncrRefCount(arglistPtr);
+ Tcl_ListObjGetElements(interp, arglistPtr, &framePtr->objc,
+ &framePtr->objv);
+ //framePtr->objc = objc-2;
+ //framePtr->objv = &objv[2];
/*
* Save the base context. The base cmdFramePtr is unknown at this time: it
@@ -8920,7 +8927,8 @@ TclNRCoroutineObjCmd(
iPtr->lookupNsPtr = iPtr->framePtr->nsPtr;
corPtr->auxNumLevels = iPtr->numLevels;
- TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, NULL,NULL,NULL);
+ TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr, arglistPtr,
+ NULL,NULL);
iPtr->evalFlags |= TCL_EVAL_REDIRECT;
TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 831b7c3..3fac4ea 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.457 2009/12/09 12:16:46 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.458 2009/12/09 17:55:01 msofer Exp $
*/
#include "tclInt.h"
@@ -2001,10 +2001,6 @@ TclExecuteByteCode(
auxObjList = NULL;
NR_DATA_INIT(); /* record this level's data */
- if (iPtr->execEnvPtr->corPtr && !iPtr->execEnvPtr->corPtr->stackLevel) {
- iPtr->execEnvPtr->corPtr->stackLevel = &TAUX;
- }
-
iPtr->execEnvPtr->bottomPtr = BP;
TAUX.esPtr = iPtr->execEnvPtr->execStackPtr;
@@ -2033,14 +2029,22 @@ TclExecuteByteCode(
bcFramePtr->cmd.str.len = 0;
if (iPtr->execEnvPtr->corPtr) {
- if (!iPtr->execEnvPtr->corPtr->base.cmdFramePtr) {
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+ if (!corPtr->base.cmdFramePtr) {
/*
- * First coroutine run, the base cmdFramePtr has not yet been
- * initialized. Do it now.
+ * First coroutine run, incomplete init:
+ * - base.cmdFramePtr not set
+ * - need to break the BP chain
*/
- iPtr->execEnvPtr->corPtr->base.cmdFramePtr = bcFramePtr;
+ corPtr->base.cmdFramePtr = bcFramePtr;
+ BP->prevBottomPtr = NULL;
}
+
+ if (!corPtr->stackLevel) {
+ corPtr->stackLevel = &TAUX;
+ }
+
if (iPtr->execEnvPtr->rewind) {
TRESULT = TCL_ERROR;
goto abnormalReturn;
@@ -2888,11 +2892,10 @@ TclExecuteByteCode(
}
/*
- * Save our state and return
+ * Mark suspended, save our state and return
*/
- corPtr->stackLevel = NULL; /* mark suspended */
-
+ corPtr->stackLevel = NULL;
iPtr->execEnvPtr = corPtr->callerEEPtr;
OBP = corPtr->callerBP;
goto returnToCaller;