summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2009-03-19 23:31:36 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2009-03-19 23:31:36 (GMT)
commite6e54e79e2d7333a81f91a9525ed518f9d96a0cd (patch)
tree72f27d85c68739eb5710cc682cb2fd79c500452f /generic/tclBasic.c
parente77ab61acdd95f64d2222c71c72f2b2db1a39f65 (diff)
downloadtcl-e6e54e79e2d7333a81f91a9525ed518f9d96a0cd.zip
tcl-e6e54e79e2d7333a81f91a9525ed518f9d96a0cd.tar.gz
tcl-e6e54e79e2d7333a81f91a9525ed518f9d96a0cd.tar.bz2
* generic/tcl.h:
* generic/tclInt.h: * generic/tclBasic.c: * generic/tclExecute.c: * generic/tclNamesp.c (Tcl_PopCallFrame): Rewritten tailcall implementation, ::unsupported::atProcExit is (temporarily?) gone. The new approach is much simpler, and also closer to being correct. This commit fixes [Bug 2649975] and [Bug 2695587]. * tests/coroutine.test: Moved the tests to their own files, * tests/tailcall.test: removed the unsupported.test. Added * tests/unsupported.test: tests for the fixed bugs.
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c102
1 files changed, 49 insertions, 53 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 50230ba..739732f 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.387 2009/03/11 10:44:20 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.388 2009/03/19 23:31:37 msofer Exp $
*/
#include "tclInt.h"
@@ -136,8 +136,8 @@ static Tcl_NRPostProc TEOEx_ByteCodeCallback;
static Tcl_NRPostProc NRRunObjProc;
-static Tcl_NRPostProc AtProcExitCleanup;
-static Tcl_NRPostProc NRAtProcExitEval;
+static Tcl_NRPostProc TailcallCleanup;
+static Tcl_NRPostProc NRTailcallEval;
/*
* The following structure define the commands in the Tcl core.
@@ -698,7 +698,7 @@ Tcl_CreateInterp(void)
#endif
iPtr->pendingObjDataPtr = NULL;
iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
- iPtr->atExitPtr = NULL;
+ iPtr->deferredCallbacks = NULL;
/*
* Create the core commands. Do it here, rather than calling
@@ -782,14 +782,11 @@ Tcl_CreateInterp(void)
Tcl_DisassembleObjCmd, NULL, NULL);
/*
- * Create the 'tailcall' command an unsupported command for 'atProcExit'
+ * Create the 'tailcall' command
*/
- Tcl_NRCreateCommand(interp, "tailcall", NULL, TclNRAtProcExitObjCmd,
- INT2PTR(TCL_NR_TAILCALL_TYPE), NULL);
-
- Tcl_NRCreateCommand(interp, "::tcl::unsupported::atProcExit", NULL,
- TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_ATEXIT_TYPE), NULL);
+ Tcl_NRCreateCommand(interp, "tailcall", NULL, TclNRTailcallObjCmd,
+ NULL, NULL);
#ifdef USE_DTRACE
/*
@@ -4056,7 +4053,7 @@ TclNREvalObjv(
* will be filled later when the command is found: save its address at
* objProcPtr.
*
- * data[1] stores a marker for use by tailcalls; it will be reset to 0 by
+ * data[1] stores a marker for use by tailcalls; it will be set to 1 by
* command redirectors (imports, alias, ensembles) so that tailcalls
* finishes the source command and not just the target.
*/
@@ -4064,6 +4061,8 @@ TclNREvalObjv(
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
+ TclNRSpliceDeferred(interp);
+
iPtr->numLevels++;
result = TclInterpReady(interp);
@@ -4220,7 +4219,6 @@ TclNRRunCallbacks(
(void) Tcl_GetObjResult(interp);
}
- restart:
while (TOP_CB(interp) != rootPtr) {
callbackPtr = TOP_CB(interp);
@@ -4244,16 +4242,6 @@ TclNRRunCallbacks(
result = procPtr(callbackPtr->data, interp, result);
TCLNR_FREE(interp, callbackPtr);
}
- if (iPtr->atExitPtr) {
- callbackPtr = iPtr->atExitPtr;
- while (callbackPtr->nextPtr) {
- callbackPtr = callbackPtr->nextPtr;
- }
- callbackPtr->nextPtr = rootPtr;
- TOP_CB(iPtr) = iPtr->atExitPtr;
- iPtr->atExitPtr = NULL;
- goto restart;
- }
return result;
}
@@ -4286,6 +4274,7 @@ NRCommand(
if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
result = Tcl_LimitCheck(interp);
}
+
return result;
}
@@ -4327,11 +4316,10 @@ NRCallTEBC(
switch (type) {
case TCL_NR_BC_TYPE:
return TclExecuteByteCode(interp, data[1]);
- case TCL_NR_ATEXIT_TYPE:
case TCL_NR_TAILCALL_TYPE:
- /* For atProcExit and tailcalls */
+ /* For tailcalls */
Tcl_SetResult(interp,
- "atProcExit/tailcall can only be called from a proc or lambda",
+ "tailcall can only be called from a proc or lambda",
TCL_STATIC);
return TCL_ERROR;
case TCL_NR_YIELD_TYPE:
@@ -5767,6 +5755,20 @@ TclNREvalObjEx(
* UpdateStringOfList from the internal rep).
*/
+ /*
+ * Shimmer protection! Always pass an unshared obj. The caller could
+ * incr the refCount of objPtr AFTER calling us! To be completely safe
+ * we always make a copy. The callback takes care od the refCounts for
+ * both listPtr and objPtr.
+ *
+ * FIXME OPT: preserve just the internal rep?
+ */
+
+ Tcl_IncrRefCount(objPtr);
+ listPtr = TclListObjCopy(interp, objPtr);
+ Tcl_IncrRefCount(listPtr);
+ TclDecrRefCount(objPtr);
+
if (word != INT_MIN) {
/*
* TIP #280 Structures for tracking lines. As we know that this is
@@ -5795,26 +5797,14 @@ TclNREvalObjEx(
eoFramePtr->framePtr = iPtr->framePtr;
eoFramePtr->nextPtr = iPtr->cmdFramePtr;
- eoFramePtr->cmd.listPtr = objPtr;
+ eoFramePtr->cmd.listPtr = listPtr;
eoFramePtr->data.eval.path = NULL;
iPtr->cmdFramePtr = eoFramePtr;
}
- /*
- * Shimmer protection! Always pass an unshared obj. The caller could
- * incr the refCount of objPtr AFTER calling us! To be completely safe
- * we always make a copy. The callback takes care od the refCounts for
- * both listPtr and objPtr.
- *
- * FIXME OPT: preserve just the internal rep?
- */
-
- Tcl_IncrRefCount(objPtr);
- listPtr = TclListObjCopy(interp, objPtr);
- Tcl_IncrRefCount(listPtr);
- TclNRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr,
- listPtr, NULL);
+ TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+ NULL, NULL);
ListObjGetElements(listPtr, objc, objv);
return TclNREvalObjv(interp, objc, objv, flags, NULL);
@@ -5991,9 +5981,8 @@ TEOEx_ListCallback(
int result)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *objPtr = data[0];
+ Tcl_Obj *listPtr = data[0];
CmdFrame *eoFramePtr = data[1];
- Tcl_Obj *listPtr = data[2];
/*
* Remove the cmdFrame
@@ -6003,7 +5992,6 @@ TEOEx_ListCallback(
iPtr->cmdFramePtr = eoFramePtr->nextPtr;
TclStackFree(interp, eoFramePtr);
}
- TclDecrRefCount(objPtr);
TclDecrRefCount(listPtr);
return result;
@@ -7992,25 +7980,26 @@ Tcl_NRCmdSwap(
*/
int
-TclNRAtProcExitObjCmd(
+TclNRTailcallObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Interp *iPtr = (Interp *) interp;
+ TEOV_callback *tailcallPtr;
Tcl_Obj *listPtr;
Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
-
+
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 */
Tcl_SetResult(interp,
- "atProcExit/tailcall can only be called from a proc or lambda",
+ "tailcall can only be called from a proc or lambda",
TCL_STATIC);
return TCL_ERROR;
}
@@ -8023,15 +8012,21 @@ TclNRAtProcExitObjCmd(
* Add two callbacks: first the one to actually evaluate the tailcalled
* command, then the one that signals TEBC to stash the first at its
* proper place.
+ *
+ * Being lazy: add the callback, then remove it (to exploit the
+ * TclNRAddCallBack macro to build the callback)
*/
- TclNRAddCallback(interp, NRAtProcExitEval, listPtr, nsPtr, NULL, NULL);
- TclNRAddCallback(interp, NRCallTEBC, clientData, NULL, NULL, NULL);
+ TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL);
+ tailcallPtr = TOP_CB(interp);
+ TOP_CB(interp) = tailcallPtr->nextPtr;
+
+ TclNRAddCallback(interp, NRCallTEBC, INT2PTR(TCL_NR_TAILCALL_TYPE), tailcallPtr, NULL, NULL);
return TCL_OK;
}
int
-NRAtProcExitEval(
+NRTailcallEval(
ClientData data[],
Tcl_Interp *interp,
int result)
@@ -8039,11 +8034,12 @@ NRAtProcExitEval(
Interp *iPtr = (Interp *) interp;
Tcl_Obj *listPtr = data[0];
Namespace *nsPtr = data[1];
+ int omit = PTR2INT(data[2]);
int objc;
Tcl_Obj **objv;
- TclNRAddCallback(interp, AtProcExitCleanup, listPtr, NULL, NULL, NULL);
- if (result == TCL_OK) {
+ TclNRDeferCallback(interp, TailcallCleanup, listPtr, NULL, NULL, NULL);
+ if (!omit && (result == TCL_OK)) {
iPtr->lookupNsPtr = nsPtr;
ListObjGetElements(listPtr, objc, objv);
result = TclNREvalObjv(interp, objc, objv, 0, NULL);
@@ -8063,7 +8059,7 @@ NRAtProcExitEval(
}
static int
-AtProcExitCleanup(
+TailcallCleanup(
ClientData data[],
Tcl_Interp *interp,
int result)