Attachment "newTailcall.patch" to
ticket [3048771fff]
added by
msofer
2010-08-21 21:12:53.
diff -ur ./generic/tclBasic.c ./generic/tclBasic.c
--- ./generic/tclBasic.c 2010-08-21 11:07:22.367173149 -0300
+++ ./generic/tclBasic.c 2010-08-20 20:11:12.105882211 -0300
@@ -167,10 +167,6 @@
static void ClearTailcall(Tcl_Interp *interp,
struct TEOV_callback *tailcallPtr);
-static int SpliceTailcall(Tcl_Interp *interp,
- struct TEOV_callback *tailcallPtr,
- int skip);
-
MODULE_SCOPE const TclStubs tclStubs;
@@ -8291,30 +8287,10 @@
* FIXME NRE!
*/
-void TclRemoveTailcall(
- Tcl_Interp *interp)
-{
- TEOV_callback *runPtr, *tailcallPtr;
-
- for (runPtr = TOP_CB(interp); runPtr->nextPtr; runPtr = runPtr->nextPtr) {
- if (runPtr->nextPtr->procPtr == NRTailcallEval) {
- break;
- }
- }
- if (!runPtr->nextPtr) {
- Tcl_Panic("TclRemoveTailcall did not find a tailcall");
- }
-
- tailcallPtr = runPtr->nextPtr;
- runPtr->nextPtr = tailcallPtr->nextPtr;
- ClearTailcall(interp, tailcallPtr);
-}
-
-static int
-SpliceTailcall(
+void
+TclSpliceTailcall(
Tcl_Interp *interp,
- TEOV_callback *tailcallPtr,
- int skip)
+ TEOV_callback *tailcallPtr)
{
/*
* Find the splicing spot: right before the NRCommand of the thing
@@ -8322,53 +8298,19 @@
* (used by command redirectors).
*/
- Interp *iPtr = (Interp *) interp;
TEOV_callback *runPtr;
- runPtr = TOP_CB(interp);
- if (skip) {
- while (runPtr && (runPtr != iPtr->varFramePtr->wherePtr)) {
- if ((runPtr->procPtr) == TclNRBlockTailcall) {
- ClearTailcall(interp, tailcallPtr);
- Tcl_SetResult(interp,"tailcall called from within a catch environment",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
- NULL);
- return TCL_ERROR;
- }
- runPtr = runPtr->nextPtr;
- }
- }
-
- restart:
- for (; runPtr; runPtr = runPtr->nextPtr) {
+ for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
break;
}
}
if (!runPtr) {
- /*
- * If we are tailcalling out of a coroutine, the splicing spot is in
- * the caller's execEnv: go find it!
- */
-
- CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-
- if (corPtr) {
- runPtr = corPtr->callerEEPtr->callbackPtr;
- goto restart;
- }
-
- Tcl_SetResult(interp,
- "tailcall cannot find the right splicing spot: should not happen!",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "UNKNOWN", NULL);
- return TCL_ERROR;
+ Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
}
tailcallPtr->nextPtr = runPtr->nextPtr;
runPtr->nextPtr = tailcallPtr;
- return TCL_OK;
}
int
@@ -8379,18 +8321,13 @@
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *listPtr, *nsObjPtr;
- Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
- Tcl_Namespace *ns1Ptr;
- TEOV_callback *tailcallPtr;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
return TCL_ERROR;
}
- if (!iPtr->varFramePtr->isProcCallFrame || /* is not a body */
- (iPtr->framePtr != iPtr->varFramePtr)) { /* or is upleveled */
+ if (!iPtr->varFramePtr->isProcCallFrame) { /* or is upleveled */
Tcl_SetResult(interp,
"tailcall can only be called from a proc or lambda",
TCL_STATIC);
@@ -8398,33 +8335,45 @@
return TCL_ERROR;
}
- listPtr = Tcl_NewListObj(objc-1, objv+1);
- Tcl_IncrRefCount(listPtr);
+ /*
+ * Invocation without args just clears a scheduled tailcall; invocation
+ * with an argument replaces any previously scheduled tailcall.
+ */
- nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
- if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
- || (nsPtr != ns1Ptr)) {
- Tcl_Panic("Tailcall failed to find the proper namespace");
+ if (iPtr->varFramePtr->tailcallPtr) {
+ ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
+ iPtr->varFramePtr->tailcallPtr = NULL;
}
- Tcl_IncrRefCount(nsObjPtr);
-
+
/*
* Create the callback to actually evaluate the tailcalled
- * command, then pass it to tebc so that it is stashed at the proper
- * place. Being lazy: exploit the TclNRAddCallBack macro to build the
- * callback.
+ * command, then set it in the varFrame so that PopCallFrame can use it
+ * at the proper time. Being lazy: exploit the TclNRAddCallBack macro to
+ * build the callback.
*/
- TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
- tailcallPtr = TOP_CB(interp);
- TOP_CB(interp) = tailcallPtr->nextPtr;
+ if (objc > 1) {
+ Tcl_Obj *listPtr, *nsObjPtr;
+ Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+ Tcl_Namespace *ns1Ptr;
+ TEOV_callback *tailcallPtr;
+
+ listPtr = Tcl_NewListObj(objc-1, objv+1);
+ Tcl_IncrRefCount(listPtr);
+
+ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+ if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
+ || (nsPtr != ns1Ptr)) {
+ Tcl_Panic("Tailcall failed to find the proper namespace");
+ }
+ Tcl_IncrRefCount(nsObjPtr);
- if (SpliceTailcall(interp, tailcallPtr, 1) == TCL_ERROR) {
- return TCL_ERROR;
+ TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
+ tailcallPtr = TOP_CB(interp);
+ TOP_CB(interp) = tailcallPtr->nextPtr;
+ iPtr->varFramePtr->tailcallPtr = tailcallPtr;
}
-
- iPtr->varFramePtr->isProcCallFrame |= FRAME_TAILCALLING;
- return TCL_OK;
+ return TCL_RETURN;
}
int
@@ -8484,15 +8433,6 @@
TCLNR_FREE(interp, tailcallPtr);
}
-int
-TclNRBlockTailcall(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- return result;
-}
-
void
Tcl_NRAddCallback(
@@ -8661,7 +8601,7 @@
cbPtr = TOP_CB(interp);
TOP_CB(interp) = cbPtr->nextPtr;
- SpliceTailcall(interp, cbPtr, 0);
+ TclSpliceTailcall(interp, cbPtr);
return TCL_OK;
}
@@ -9042,7 +8982,6 @@
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
- iPtr->evalFlags |= TCL_EVAL_REDIRECT;
iPtr->lookupNsPtr = nsPtr;
TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
diff -ur ./generic/tclBasic.c.orig ./generic/tclBasic.c.orig
--- ./generic/tclBasic.c.orig 2010-08-21 11:02:38.274171879 -0300
+++ ./generic/tclBasic.c.orig 2010-08-20 20:11:06.966884309 -0300
@@ -167,6 +167,10 @@
static void ClearTailcall(Tcl_Interp *interp,
struct TEOV_callback *tailcallPtr);
+static int SpliceTailcall(Tcl_Interp *interp,
+ struct TEOV_callback *tailcallPtr,
+ int skip);
+
MODULE_SCOPE const TclStubs tclStubs;
@@ -8287,10 +8291,30 @@
* FIXME NRE!
*/
-void
-TclSpliceTailcall(
+void TclRemoveTailcall(
+ Tcl_Interp *interp)
+{
+ TEOV_callback *runPtr, *tailcallPtr;
+
+ for (runPtr = TOP_CB(interp); runPtr->nextPtr; runPtr = runPtr->nextPtr) {
+ if (runPtr->nextPtr->procPtr == NRTailcallEval) {
+ break;
+ }
+ }
+ if (!runPtr->nextPtr) {
+ Tcl_Panic("TclRemoveTailcall did not find a tailcall");
+ }
+
+ tailcallPtr = runPtr->nextPtr;
+ runPtr->nextPtr = tailcallPtr->nextPtr;
+ ClearTailcall(interp, tailcallPtr);
+}
+
+static int
+SpliceTailcall(
Tcl_Interp *interp,
- TEOV_callback *tailcallPtr)
+ TEOV_callback *tailcallPtr,
+ int skip)
{
/*
* Find the splicing spot: right before the NRCommand of the thing
@@ -8298,19 +8322,53 @@
* (used by command redirectors).
*/
+ Interp *iPtr = (Interp *) interp;
TEOV_callback *runPtr;
- for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
+ runPtr = TOP_CB(interp);
+ if (skip) {
+ while (runPtr && (runPtr != iPtr->varFramePtr->wherePtr)) {
+ if ((runPtr->procPtr) == TclNRBlockTailcall) {
+ ClearTailcall(interp, tailcallPtr);
+ Tcl_SetResult(interp,"tailcall called from within a catch environment",
+ TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
+ NULL);
+ return TCL_ERROR;
+ }
+ runPtr = runPtr->nextPtr;
+ }
+ }
+
+ restart:
+ for (; runPtr; runPtr = runPtr->nextPtr) {
if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
break;
}
}
if (!runPtr) {
- Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
+ /*
+ * If we are tailcalling out of a coroutine, the splicing spot is in
+ * the caller's execEnv: go find it!
+ */
+
+ CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+
+ if (corPtr) {
+ runPtr = corPtr->callerEEPtr->callbackPtr;
+ goto restart;
+ }
+
+ Tcl_SetResult(interp,
+ "tailcall cannot find the right splicing spot: should not happen!",
+ TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "UNKNOWN", NULL);
+ return TCL_ERROR;
}
tailcallPtr->nextPtr = runPtr->nextPtr;
runPtr->nextPtr = tailcallPtr;
+ return TCL_OK;
}
int
@@ -8344,7 +8402,7 @@
ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
iPtr->varFramePtr->tailcallPtr = NULL;
}
-
+
/*
* Create the callback to actually evaluate the tailcalled
* command, then set it in the varFrame so that PopCallFrame can use it
@@ -8357,7 +8415,7 @@
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
Tcl_Namespace *ns1Ptr;
TEOV_callback *tailcallPtr;
-
+
listPtr = Tcl_NewListObj(objc-1, objv+1);
Tcl_IncrRefCount(listPtr);
@@ -8982,6 +9040,7 @@
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
+ iPtr->evalFlags |= TCL_EVAL_REDIRECT;
iPtr->lookupNsPtr = nsPtr;
TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
diff -ur ./generic/tclBasic.c.rej ./generic/tclBasic.c.rej
--- ./generic/tclBasic.c.rej 2010-08-21 11:02:31.871189303 -0300
+++ ./generic/tclBasic.c.rej 2010-08-20 20:11:12.105882211 -0300
@@ -1,33 +1,133 @@
--- generic/tclBasic.c
+++ generic/tclBasic.c
-@@ -8476,10 +8523,19 @@
+@@ -8319,56 +8261,63 @@
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+ {
+ Interp *iPtr = (Interp *) interp;
+- Tcl_Obj *listPtr, *nsObjPtr;
+- Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+- Tcl_Namespace *ns1Ptr;
+- TEOV_callback *tailcallPtr;
+-
+- if (objc < 2) {
+- Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
+- return TCL_ERROR;
+- }
+-
+- if (!iPtr->varFramePtr->isProcCallFrame || /* is not a body */
+- (iPtr->framePtr != iPtr->varFramePtr)) { /* or is upleveled */
++
++ if (objc < 1) {
++ Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
++ return TCL_ERROR;
++ }
++
++ if (!iPtr->varFramePtr->isProcCallFrame) { /* or is upleveled */
+ Tcl_SetResult(interp,
+ "tailcall can only be called from a proc or lambda",
+ TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ return TCL_ERROR;
+ }
+
+- listPtr = Tcl_NewListObj(objc-1, objv+1);
+- Tcl_IncrRefCount(listPtr);
+-
+- nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+- if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
+- || (nsPtr != ns1Ptr)) {
+- Tcl_Panic("Tailcall failed to find the proper namespace");
+- }
+- Tcl_IncrRefCount(nsObjPtr);
++ /*
++ * Invocation without args just clears a scheduled tailcall; invocation
++ * with an argument replaces any previously scheduled tailcall.
++ */
++
++ if (iPtr->varFramePtr->tailcallPtr) {
++ ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
++ iPtr->varFramePtr->tailcallPtr = NULL;
++ }
+
+ /*
+ * Create the callback to actually evaluate the tailcalled
+- * command, then pass it to tebc so that it is stashed at the proper
+- * place. Being lazy: exploit the TclNRAddCallBack macro to build the
+- * callback.
+- */
+-
+- TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
+- tailcallPtr = TOP_CB(interp);
+- TOP_CB(interp) = tailcallPtr->nextPtr;
+-
+- if (SpliceTailcall(interp, tailcallPtr, 1) == TCL_ERROR) {
+- return TCL_ERROR;
+- }
+-
+- iPtr->varFramePtr->isProcCallFrame |= FRAME_TAILCALLING;
+- return TCL_OK;
++ * command, then set it in the varFrame so that PopCallFrame can use it
++ * at the proper time. Being lazy: exploit the TclNRAddCallBack macro to
++ * build the callback.
++ */
++
++ if (objc > 1) {
++ Tcl_Obj *listPtr, *nsObjPtr;
++ Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
++ Tcl_Namespace *ns1Ptr;
++ TEOV_callback *tailcallPtr;
++
++ listPtr = Tcl_NewListObj(objc-1, objv+1);
++ Tcl_IncrRefCount(listPtr);
++
++ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
++ if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
++ || (nsPtr != ns1Ptr)) {
++ Tcl_Panic("Tailcall failed to find the proper namespace");
++ }
++ Tcl_IncrRefCount(nsObjPtr);
++
++ TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
++ tailcallPtr = TOP_CB(interp);
++ TOP_CB(interp) = tailcallPtr->nextPtr;
++ iPtr->varFramePtr->tailcallPtr = tailcallPtr;
++ }
++ return TCL_RETURN;
+ }
+
+ int
+ NRTailcallEval(
+ ClientData data[],
+@@ -8422,19 +8371,10 @@
Tcl_Interp *interp,
TEOV_callback *tailcallPtr)
{
TailcallCleanup(tailcallPtr->data, interp, TCL_OK);
TCLNR_FREE(interp, tailcallPtr);
-+}
-+
-+int
-+TclNRBlockTailcall(
-+ ClientData data[],
-+ Tcl_Interp *interp,
-+ int result)
-+{
-+ return result;
+-}
+-
+-int
+-TclNRBlockTailcall(
+- ClientData data[],
+- Tcl_Interp *interp,
+- int result)
+-{
+- return result;
}
void
Tcl_NRAddCallback(
-@@ -8646,11 +8702,11 @@
+@@ -8601,11 +8541,11 @@
TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL);
cbPtr = TOP_CB(interp);
TOP_CB(interp) = cbPtr->nextPtr;
-- TclSpliceTailcall(interp, cbPtr);
-+ SpliceTailcall(interp, cbPtr, 0);
+- SpliceTailcall(interp, cbPtr, 0);
++ TclSpliceTailcall(interp, cbPtr);
return TCL_OK;
}
diff -ur ./generic/tclCmdAH.c ./generic/tclCmdAH.c
--- ./generic/tclCmdAH.c 2010-08-21 11:07:22.379171742 -0300
+++ ./generic/tclCmdAH.c 2010-08-20 20:11:12.113880923 -0300
@@ -292,8 +292,6 @@
TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
varNamePtr, optionVarNamePtr, NULL);
- TclNRAddCallback(interp, TclNRBlockTailcall, NULL, NULL, NULL,
- NULL);
/*
* TIP #280. Make invoking context available to caught script.
diff -ur ./generic/tclCmdMZ.c ./generic/tclCmdMZ.c
--- ./generic/tclCmdMZ.c 2010-08-21 11:07:22.387169406 -0300
+++ ./generic/tclCmdMZ.c 2010-08-20 20:11:12.125885940 -0300
@@ -4274,13 +4274,11 @@
}
/*
- * Execute the body; block tailcalling out of it.
+ * Execute the body.
*/
Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
(ClientData)objv, INT2PTR(objc));
- TclNRAddCallback(interp, TclNRBlockTailcall, NULL, NULL, NULL,
- NULL);
return TclNREvalObjEx(interp, bodyObj, 0,
((Interp *) interp)->cmdFramePtr, 1);
}
diff -ur ./generic/tclCmdMZ.c.orig ./generic/tclCmdMZ.c.orig
--- ./generic/tclCmdMZ.c.orig 2010-08-21 11:02:38.290170140 -0300
+++ ./generic/tclCmdMZ.c.orig 2010-08-20 20:11:06.990884428 -0300
@@ -4274,11 +4274,13 @@
}
/*
- * Execute the body.
+ * Execute the body; block tailcalling out of it.
*/
Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
(ClientData)objv, INT2PTR(objc));
+ TclNRAddCallback(interp, TclNRBlockTailcall, NULL, NULL, NULL,
+ NULL);
return TclNREvalObjEx(interp, bodyObj, 0,
((Interp *) interp)->cmdFramePtr, 1);
}
diff -ur ./generic/tclExecute.c ./generic/tclExecute.c
--- ./generic/tclExecute.c 2010-08-21 11:07:22.439170361 -0300
+++ ./generic/tclExecute.c 2010-08-20 20:11:12.145882823 -0300
@@ -2901,25 +2901,6 @@
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
- /*
- * If the CallFrame is marked as tailcalling, keep tailcalling
- */
-
- if (iPtr->varFramePtr->isProcCallFrame & FRAME_TAILCALLING) {
- if (catchTop == initCatchTop) {
- goto abnormalReturn;
- }
-
- iPtr->varFramePtr->isProcCallFrame &= ~FRAME_TAILCALLING;
- TclRemoveTailcall(interp);
- Tcl_SetResult(interp,
- "tailcall called from within a catch environment",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
- pc--;
- goto gotError;
- }
-
if (iPtr->execEnvPtr->rewind) {
TRESULT = TCL_ERROR;
goto abnormalReturn;
diff -ur ./generic/tclInt.h ./generic/tclInt.h
--- ./generic/tclInt.h 2010-08-21 11:07:22.487175765 -0300
+++ ./generic/tclInt.h 2010-08-20 20:11:12.153878950 -0300
@@ -1152,10 +1152,8 @@
* meaning of the value is, which we do not
* specify. */
LocalCache *localCachePtr;
- struct TEOV_callback *wherePtr;
- /* The top of the callback stack when this
- * frame was pushed; used to find the spot
- * where to tailcall to. */
+ struct TEOV_callback *tailcallPtr;
+ /* NULL if no tailcall is scheduled */
} CallFrame;
#define FRAME_IS_PROC 0x1
@@ -1168,8 +1166,6 @@
* field contains an Object reference that has
* been confirmed to refer to a class. Part of
* TIP#257. */
-#define FRAME_TAILCALLING 0x10 /* Flag is set while the CallFrame is winding
- * down to process a tailcall */
/*
* TIP #280
@@ -2758,10 +2754,8 @@
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
-MODULE_SCOPE void TclRemoveTailcall(Tcl_Interp *interp);
-
-MODULE_SCOPE Tcl_NRPostProc TclNRBlockTailcall;
-
+MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp,
+ struct TEOV_callback *tailcallPtr);
/*
* This structure holds the data for the various iteration callbacks used to
diff -ur ./generic/tclNamesp.c ./generic/tclNamesp.c
--- ./generic/tclNamesp.c 2010-08-21 11:07:22.511173997 -0300
+++ ./generic/tclNamesp.c 2010-08-19 21:24:56.464581828 -0300
@@ -313,18 +313,7 @@
framePtr->compiledLocals = NULL;
framePtr->clientData = NULL;
framePtr->localCachePtr = NULL;
-
- /*
- * Record the top of the callback stack, so that tailcall can identify
- * the spot where to splice the new command.
- */
-
- if (iPtr->execEnvPtr) {
- framePtr->wherePtr = TOP_CB(interp);
- } else {
- framePtr->wherePtr = NULL;
- }
-
+ framePtr->tailcallPtr = NULL;
/*
* Push the new call frame onto the interpreter's stack of procedure call
@@ -403,6 +392,10 @@
Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
}
framePtr->nsPtr = NULL;
+
+ if (framePtr->tailcallPtr) {
+ TclSpliceTailcall(interp, framePtr->tailcallPtr);
+ }
}
/*
diff -ur ./generic/tclNamesp.c.rej ./generic/tclNamesp.c.rej
--- ./generic/tclNamesp.c.rej 2010-08-21 11:02:31.906173360 -0300
+++ ./generic/tclNamesp.c.rej 2010-08-20 20:11:12.181880341 -0300
@@ -1,15 +1,39 @@
--- generic/tclNamesp.c
+++ generic/tclNamesp.c
-@@ -401,14 +412,10 @@
+@@ -311,22 +311,11 @@
+ framePtr->varTablePtr = NULL; /* and no local variables */
+ framePtr->numCompiledLocals = 0;
+ framePtr->compiledLocals = NULL;
+ framePtr->clientData = NULL;
+ framePtr->localCachePtr = NULL;
+-
+- /*
+- * Record the top of the callback stack, so that tailcall can identify
+- * the spot where to splice the new command.
+- */
+-
+- if (iPtr->execEnvPtr) {
+- framePtr->wherePtr = TOP_CB(interp);
+- } else {
+- framePtr->wherePtr = NULL;
+- }
+-
++ framePtr->tailcallPtr = NULL;
+
+ /*
+ * Push the new call frame onto the interpreter's stack of procedure call
+ * frames making it the current frame.
+ */
+@@ -401,10 +390,14 @@
if ((nsPtr->flags & NS_DYING)
&& (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
}
framePtr->nsPtr = NULL;
--
-- if (framePtr->tailcallPtr) {
-- TclSpliceTailcall(interp, framePtr->tailcallPtr);
-- }
++
++ if (framePtr->tailcallPtr) {
++ TclSpliceTailcall(interp, framePtr->tailcallPtr);
++ }
}
/*
diff -ur ./manifest ./manifest
--- ./manifest 2010-08-21 11:07:24.814170394 -0300
+++ ./manifest 2010-08-20 18:35:12.913880290 -0300
@@ -1,5 +1,5 @@
-C cvs\sup
-D 2010-08-19T16:23:14
+C fix\stailcall/coroutine\sinteraction
+D 2010-08-20T21:18:04
F CVS/Entries 597b70c680e553eccfb15eb474e405f9e8a4556c
F CVS/Repository eb85e7cec80466bd7ab394699b847104d772ceef
F CVS/Root cae9b1a9e5129ffcc3247889f1eed9a98d1df4a7
@@ -334,13 +334,13 @@
F generic/tcl.h ccede7be24ce976e22f8b72f4092353a8750bf84
F generic/tclAlloc.c 626b42befebd88ba8c89d6c1ab3159bd81088c83
F generic/tclAsync.c 515bda8c56e140d4fb91a322005a8a9570c2937d
-F generic/tclBasic.c a78e5c123fa673402c4e00e48f05336d885f2c5d
+F generic/tclBasic.c b4becfa98922576fc4f7de418c835bb916cbcf02
F generic/tclBinary.c aa87910a0bcc20dec630eb821bc5570348ed1ade
F generic/tclCkalloc.c d67ae01c9bb387faacaa92453c2896512cdea29b
F generic/tclClock.c 17d98509d104ecd6b46fc3a358f1e68e6a25fa67
-F generic/tclCmdAH.c fc993681108128276d828b51ec1b97f74f843ef8
+F generic/tclCmdAH.c 8356cd0548b0bf131376f6b8c31f65a34bfb7d96
F generic/tclCmdIL.c ebe1a0be188c5e9faeab2c335f53f031162a1c84
-F generic/tclCmdMZ.c dafd4c6e7e97af79179b9b560c2cd61c2dcdb52e
+F generic/tclCmdMZ.c 0b825b9641fd366852627bc17d4c603b477f84f2
F generic/tclCompCmds.c 14c3400c39ef05aabf08962b4025f30470386702
F generic/tclCompCmdsSZ.c 1911404dd005784ac681fcb7a93560982833b2d4
F generic/tclCompExpr.c 0dc5352389d0a4f52f20458c7a1f54379d495182
@@ -355,7 +355,7 @@
F generic/tclEnsemble.c 3e40b3e2411e3bec988c48018ab009ca24773a70
F generic/tclEnv.c 3dc53ec308081ecb7c95f54599b992a748d60adc
F generic/tclEvent.c 45cc17789dc0788473395e08837861025c787526
-F generic/tclExecute.c 090893fc456293f58cae044781ab1b85b2ea29fe
+F generic/tclExecute.c 460aac699bcb596d6eb02633b958063f680ef91c
F generic/tclFCmd.c 9c00cb49faa05999a7feca4650fe620939281abc
F generic/tclFileName.c da7c1c5e45670b8b37f007984832048d2f28a359
F generic/tclFileSystem.h d4f216a9e2730002fd1af099a65e73ed916ccc2d
@@ -373,7 +373,7 @@
F generic/tclIOUtil.c cd73741dbef929e1331cef3ff2a7b400dc0c619b
F generic/tclIndexObj.c f928158016b735c3c315acb339600ce1e7d15536
F generic/tclInt.decls 2ac6a7a2c31ddad7f4f8891e6f137aa7a93d55fc
-F generic/tclInt.h d39d56aeaa3596e890c85c7040f6e3c994176c02
+F generic/tclInt.h 6b4ab99d66a6b8b8c99b7327a908067f4d6aacaf
F generic/tclIntDecls.h 1753341b9a7a5962461c8c19e8a1cfd2edc55ab9
F generic/tclIntPlatDecls.h 457725d51c64ed8d75605e72c6594f44cadcc207
F generic/tclInterp.c 347cfb4a96cd2d5937d51285181b42d1c3086176
@@ -383,7 +383,7 @@
F generic/tclLoad.c 274f42b159e4786b5271029326ae24cb0debc3ba
F generic/tclLoadNone.c 2a48baef148baacc62b4180783feeaf667075111
F generic/tclMain.c b0385368173adda1780a817f4a0fa0219bb1b3a4
-F generic/tclNamesp.c 0e3bcd3989ff163262109abb827e6b6c63921936
+F generic/tclNamesp.c 7f47af2dbd8178f64e1796ce18092e161b27604c
F generic/tclNotify.c 7dedac02ab69206020503dd391fc8f0e67f3f3de
F generic/tclOO.c 9104b7e12b2ac5a167550d835c0ccb84b3dcbdff
F generic/tclOO.decls 0ab615db563412d6f6fa786debee9a2a856671a8
@@ -1771,7 +1771,7 @@
F tests/stringObj.test e19f96b35493c731ce128e268c0424536af81af5
F tests/subst.test 3737c54505570471e016e6ca24bff21bff9f5e6c
F tests/switch.test d174239e10e1bd4ef7500ef57227fba695e354de
-F tests/tailcall.test 610ade339213c979802d99f758facfbcf755a8d9
+F tests/tailcall.test b4746ce50429a219a06fb646b3ffac0979493ac4
F tests/tcltest.test 509db07b117b7d51162550e3ef7fc2e82cfcbd7e x
F tests/thread.test 6aae18f9c7387c3864850af6a5a73caaf730679a
F tests/timer.test 015b0cc07940d0120e23f2e2e80306ff454a25bb
@@ -2022,7 +2022,7 @@
F win/tclooConfig.sh ba4b58a2db009475f7cc5a6b985ab0af0febbd2d
F win/tclsh.ico 54ce97ad2c00398e7e4bfb15a8f6aea3a2e7a7de
F win/tclsh.rc 25bfab3c518f473f96a7d399d1f68d8778c4dce9
-P 3c5081d4e83f5b7db134a6675ec2731acc41e132
-R 6f9f04568599c84fc137257c51a64bdf
+P 5b5c0416869447440291e2f9642a84b27d0ca49e
+R 5bfca76d9dd99f75e4a51b8a2c5c357c
U mig
-Z df5b9d23d77d28637145160871e27b55
+Z adc58f841c8f12211aa66628bec88d76
diff -ur ./manifest.uuid ./manifest.uuid
--- ./manifest.uuid 2010-08-21 11:07:24.818167340 -0300
+++ ./manifest.uuid 2010-08-20 18:35:12.921878445 -0300
@@ -1 +1 @@
-17ac7d08a76ec30730903eeabb454aa69032979d
+af27f155bafb13628c80786c0964a7f5cc73b1ec
diff -ur ./tests/tailcall.test ./tests/tailcall.test
--- ./tests/tailcall.test 2010-08-21 11:07:24.318177537 -0300
+++ ./tests/tailcall.test 2010-08-20 20:11:12.189881636 -0300
@@ -384,6 +384,20 @@
unset -nocomplain ::x
} -match glob -result *tailcall* -returnCodes error
+test tailcall-11c {tailcall and uplevel} -setup {
+ proc a {} {
+ uplevel 1 {tailcall lappend ::x 2}
+ set ::x 1
+ }
+ proc b {} {set ::x 0; a; lappend ::x 3}
+} -body {
+ list [b] $::x
+} -cleanup {
+ rename a {}
+ rename b {}
+ unset -nocomplain ::x
+} -result {{0 3 2} {0 3 2}}
+
test tailcall-12.1 {[Bug 2649975]} -setup {
proc dump {{text {}}} {
set text [uplevel 1 [list subst $text]]
@@ -545,29 +559,75 @@
1: exiting from foo's alpha
}
-test tailcall-12.3a {[Bug 2695587]} {
+test tailcall-12.3a0 {[Bug 2695587]} -body {
+ apply {{} {
+ catch [list tailcall foo]
+ }}
+} -returnCodes 1 -result {invalid command name "foo"}
+
+test tailcall-12.3a1 {[Bug 2695587]} -body {
+ apply {{} {
+ catch [list tailcall foo]
+ tailcall
+ }}
+} -result {}
+
+test tailcall-12.3a2 {[Bug 2695587]} -body {
+ apply {{} {
+ catch [list tailcall foo]
+ tailcall moo
+ }}
+} -returnCodes 1 -result {invalid command name "moo"}
+
+test tailcall-12.3a3 {[Bug 2695587]} -body {
+ set x 0
+ apply {{} {
+ catch [list tailcall foo]
+ tailcall lappend x 1
+ }}
+ set x
+} -cleanup {
+ unset x
+} -result {0 1}
+
+test tailcall-12.3b0 {[Bug 2695587]} -body {
apply {{} {
- list [catch [list tailcall foo] msg opt] $msg [errorcode $opt]
+ set catch catch
+ $catch [list tailcall foo]
}}
-} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
+} -returnCodes 1 -result {invalid command name "foo"}
-test tailcall-12.3b {[Bug 2695587]} {
+test tailcall-12.3b1 {[Bug 2695587]} -body {
apply {{} {
- list [catch {tailcall foo} msg opt] $msg [errorcode $opt]
+ set catch catch
+ $catch [list tailcall foo]
+ tailcall
}}
-} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
+} -result {}
-test tailcall-12.3c {[Bug 3046594]} {
+test tailcall-12.3b2 {[Bug 2695587]} -body {
apply {{} {
- list [[subst catch] {tailcall foo} msg opt] $msg [errorcode $opt]
+ set catch catch
+ $catch [list tailcall foo]
+ tailcall moo
}}
-} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
+} -returnCodes 1 -result {invalid command name "moo"}
-test tailcall-12.3d {[Bug 3046594]} {
+test tailcall-12.3b3 {[Bug 2695587]} -body {
+ set x 0
apply {{} {
- list [[subst catch] [list tailcall foo] msg opt] $msg [errorcode $opt]
+ set catch catch
+ $catch [list tailcall foo]
+ tailcall lappend x 1
}}
-} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
+ set x
+} -cleanup {
+ unset x
+} -result {0 1}
+
+# MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed)
+# catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that
+# standard catch behaviour is required.
test tailcall-13.1 {tailcall and coroutine} -setup {
set lambda {i {
@@ -582,8 +642,8 @@
} -body {
coroutine moo ::apply $::lambda 0
} -cleanup {
- unset lambda
-} -result {0 0 0 0 0 0}
+ unset lambda
+} -result {0 0 0 0 0 0}
test tailcall-14.1 {directly tailcalling the tailcall command is ok} {
list [catch {
