diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.h | 3 | ||||
| -rw-r--r-- | generic/tclBasic.c | 102 | ||||
| -rw-r--r-- | generic/tclExecute.c | 145 | ||||
| -rw-r--r-- | generic/tclInt.h | 49 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 31 |
5 files changed, 136 insertions, 194 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 72c4acd..b5bced7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -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: tcl.h,v 1.288 2009/01/16 20:44:24 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.289 2009/03/19 23:31:36 msofer Exp $ */ #ifndef _TCL @@ -887,6 +887,7 @@ typedef struct Tcl_CallFrame { char *dummy10; char *dummy11; char *dummy12; + char *dummy13; } Tcl_CallFrame; /* 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) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index e98545e..49862ae 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.428 2009/02/25 14:56:07 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.429 2009/03/19 23:31:37 msofer Exp $ */ #include "tclInt.h" @@ -177,8 +177,6 @@ typedef struct BottomData { TEOV_callback *rootPtr; /* State when this bytecode execution began: */ ByteCode *codePtr; /* constant until it returns */ /* ------------------------------------------*/ - TEOV_callback *atExitPtr; /* This field is used on return FROM here */ - /* ------------------------------------------*/ 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 execution */ @@ -189,7 +187,6 @@ typedef struct BottomData { bottomPtr->prevBottomPtr = oldBottomPtr; \ bottomPtr->rootPtr = TOP_CB(iPtr); \ bottomPtr->codePtr = codePtr; \ - bottomPtr->atExitPtr = NULL #define NR_DATA_BURY() \ bottomPtr->pc = pc; \ @@ -207,8 +204,6 @@ typedef struct BottomData { esPtr = iPtr->execEnvPtr->execStackPtr; \ tosPtr = esPtr->tosPtr -static Tcl_NRPostProc NRRestoreInterpState; - #define PUSH_AUX_OBJ(objPtr) \ objPtr->internalRep.twoPtrValue.ptr2 = auxObjList; \ auxObjList = objPtr @@ -1722,22 +1717,6 @@ TclIncrObj( *---------------------------------------------------------------------- */ -static int -NRRestoreInterpState( - ClientData data[], - Tcl_Interp *interp, - int result) -{ - /* FIXME - * Save the current state somewhere for instrospection of what happened in - * the atExit handlers? - */ - - Tcl_InterpState state = data[0]; - - return Tcl_RestoreInterpState(interp, state); -} - int TclExecuteByteCode( Tcl_Interp *interp, /* Token for command interpreter. */ @@ -1835,8 +1814,6 @@ TclExecuteByteCode( */ int nested = 0; - TEOV_callback *atExitPtr = NULL; - int isTailcall = 0; if (!codePtr) { /* @@ -1884,65 +1861,28 @@ TclExecuteByteCode( codePtr = param; break; - case TCL_NR_ATEXIT_TYPE: { - /* - * A request to perform a command at exit: put it in the stack - * and continue exec'ing the current bytecode - */ - - TEOV_callback *newPtr = TOP_CB(interp); - - TOP_CB(interp) = newPtr->nextPtr; - -#ifdef TCL_COMPILE_DEBUG - if (traceInstructions) { - fprintf(stdout, " atProcExit request received\n"); - } -#endif - newPtr->nextPtr = bottomPtr->atExitPtr; - bottomPtr->atExitPtr = newPtr; - oldBottomPtr = bottomPtr; - goto returnToCaller; - } case TCL_NR_TAILCALL_TYPE: { /* - * A request to perform a tailcall: put it at the front of the - * atExit stack and abandon the current bytecode. + * A request to perform a tailcall: just drop this bytecode. */ - TEOV_callback *newPtr = TOP_CB(interp); - - TOP_CB(interp) = newPtr->nextPtr; - isTailcall = 1; #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " Tailcall request received\n"); } #endif + TEOV_callback *tailcallPtr = param; + + iPtr->varFramePtr->tailcallPtr = tailcallPtr; + if (catchTop != initCatchTop) { - isTailcall = 0; + tailcallPtr->data[2] = INT2PTR(1); result = TCL_ERROR; Tcl_SetResult(interp,"Tailcall called from within a catch environment", TCL_STATIC); + pc--; goto checkForCatch; } - - newPtr->nextPtr = NULL; - if (!bottomPtr->atExitPtr) { - newPtr->nextPtr = NULL; - bottomPtr->atExitPtr = newPtr; - } else { - /* - * There are already atExit callbacks: run last. - */ - - TEOV_callback *tmpPtr = bottomPtr->atExitPtr; - - while (tmpPtr->nextPtr) { - tmpPtr = tmpPtr->nextPtr; - } - tmpPtr->nextPtr = newPtr; - } goto abnormalReturn; } case TCL_NR_YIELD_TYPE: { /*[yield] */ @@ -1954,6 +1894,7 @@ TclExecuteByteCode( TCL_STATIC); Tcl_SetErrorCode(interp, "COROUTINE_ILLEGAL_YIELD", NULL); result = TCL_ERROR; + pc--; goto checkForCatch; } NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr); @@ -1964,6 +1905,7 @@ TclExecuteByteCode( TCL_STATIC); Tcl_SetErrorCode(interp, "COROUTINE_CANT_YIELD", NULL); result = TCL_ERROR; + pc--; goto checkForCatch; } @@ -7823,7 +7765,6 @@ TclExecuteByteCode( TclArgumentBCRelease((Tcl_Interp*) iPtr,codePtr); oldBottomPtr = bottomPtr->prevBottomPtr; - atExitPtr = bottomPtr->atExitPtr; iPtr->cmdFramePtr = bcFramePtr->nextPtr; TclStackFree(interp, bottomPtr); /* free my stack */ @@ -7835,7 +7776,7 @@ TclExecuteByteCode( if (oldBottomPtr) { /* * Restore the state to what it was previous to this bytecode, deal - * with atExit handlers and tailcalls. + * with tailcalls. */ bottomPtr = oldBottomPtr; /* back to old bc */ @@ -7846,43 +7787,10 @@ TclExecuteByteCode( NR_DATA_DIG(); if (TOP_CB(interp) == bottomPtr->rootPtr) { /* - * The bytecode is returning, all callbacks were run. Run atExit - * handlers, remove the caller's arguments and keep processing the - * caller. + * The bytecode is returning, all callbacks were run. Remove the + * caller's arguments and keep processing the caller. */ - if (atExitPtr) { - /* - * Find the last one - */ - - TEOV_callback *lastPtr = atExitPtr; - while (lastPtr->nextPtr) { - lastPtr = lastPtr->nextPtr; - } - NRE_ASSERT(lastPtr->nextPtr == NULL); - if (!isTailcall) { - /* - * Save the interp state, arrange for restoring it after - * running the callbacks. - */ - - TclNRAddCallback(interp, NRRestoreInterpState, - Tcl_SaveInterpState(interp, result), NULL, - NULL, NULL); - } - - /* - * splice in the atExit callbacks and rerun all callbacks - */ - - lastPtr->nextPtr = TOP_CB(interp); - TOP_CB(interp) = atExitPtr; - isTailcall = 0; - atExitPtr = NULL; - goto rerunCallbacks; - } - while (cleanup--) { Tcl_Obj *objPtr = POP_OBJECT(); Tcl_DecrRefCount(objPtr); @@ -7903,7 +7811,6 @@ TclExecuteByteCode( */ goto nonRecursiveCallStart; - case TCL_NR_ATEXIT_TYPE: case TCL_NR_TAILCALL_TYPE: TOP_CB(iPtr) = callbackPtr->nextPtr; TCLNR_FREE(interp, callbackPtr); @@ -7919,32 +7826,6 @@ TclExecuteByteCode( } } - - if (atExitPtr) { - if (!isTailcall) { - /* - * Save the interp state, arrange for restoring it after running - * the callbacks. Put the callback at the bottom of the atExit - * stack. - */ - - Tcl_InterpState state = Tcl_SaveInterpState(interp, result); - TEOV_callback *lastPtr = atExitPtr; - - while (lastPtr->nextPtr) { - lastPtr = lastPtr->nextPtr; - } - NRE_ASSERT(lastPtr->nextPtr == NULL); - - TclNRAddCallback(interp, NRRestoreInterpState, state, NULL, - NULL, NULL); - lastPtr->nextPtr = TOP_CB(iPtr); - TOP_CB(iPtr) = TOP_CB(iPtr)->nextPtr; - lastPtr->nextPtr->nextPtr = NULL; - } - iPtr->atExitPtr = atExitPtr; - } - iPtr->execEnvPtr->bottomPtr = NULL; return result; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 3f7a2dc..48473bd 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.418 2009/03/09 09:12:39 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.419 2009/03/19 23:31:37 msofer Exp $ */ #ifndef _TCLINT @@ -1056,6 +1056,13 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; + struct TEOV_callback *tailcallPtr; + /* The callback implementing the call to be + * executed by the command that pushed this + * frame. It can be TAILCALL_NONE to signal + * that we are tailcalling a frame further up + * the stack. + */ } CallFrame; #define FRAME_IS_PROC 0x1 @@ -2006,10 +2013,13 @@ typedef struct Interp { * tclOOInt.h and tclOO.c for real definition * and setup. */ - struct TEOV_callback *atExitPtr; - /* Callbacks to be run after a command exited; - * this is only set for atProcExirt or - * tailcalls that fall back out of tebc. */ + struct TEOV_callback *deferredCallbacks; + /* Callbacks that are set previous to a call + * to some Eval function but that actually + * belong to the command that is about to be + * called - ie, they should be run *before* + * any tailcall is invoked. + */ #ifdef TCL_COMPILE_STATS /* @@ -2589,7 +2599,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd; MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback; -MODULE_SCOPE Tcl_ObjCmdProc TclNRAtProcExitObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; @@ -4208,6 +4218,33 @@ typedef struct TEOV_callback { TOP_CB(interp) = callbackPtr; \ } +#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) { \ + TEOV_callback *callbackPtr; \ + TCLNR_ALLOC((interp), (callbackPtr)); \ + callbackPtr->procPtr = (postProcPtr); \ + callbackPtr->data[0] = (ClientData)(data0); \ + callbackPtr->data[1] = (ClientData)(data1); \ + callbackPtr->data[2] = (ClientData)(data2); \ + callbackPtr->data[3] = (ClientData)(data3); \ + callbackPtr->nextPtr = ((Interp *)interp)->deferredCallbacks; \ + ((Interp *)interp)->deferredCallbacks = callbackPtr; \ + } + +#define TclNRSpliceCallbacks(interp,topPtr) { \ + TEOV_callback *bottomPtr = topPtr; \ + while (bottomPtr->nextPtr) { \ + bottomPtr = bottomPtr->nextPtr; \ + } \ + bottomPtr->nextPtr = TOP_CB(interp); \ + TOP_CB(interp) = topPtr; \ + } + +#define TclNRSpliceDeferred(interp) \ + if (((Interp *)interp)->deferredCallbacks) { \ + TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \ + ((Interp *)interp)->deferredCallbacks = NULL; \ + } + #if NRE_USE_SMALL_ALLOC #define TCLNR_ALLOC(interp, ptr) \ TclSmallAllocEx(interp, sizeof(TEOV_callback), (ptr)) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 20b28eb..8caf7db 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -23,10 +23,11 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.189 2009/02/10 22:50:07 nijtmans Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.190 2009/03/19 23:31:37 msofer Exp $ */ #include "tclInt.h" +#include "tclCompile.h" /* just for NRCommand */ /* * Thread-local storage used to avoid having a global lock on data that is not @@ -428,7 +429,8 @@ Tcl_PushCallFrame( framePtr->compiledLocals = NULL; framePtr->clientData = NULL; framePtr->localCachePtr = NULL; - + framePtr->tailcallPtr = NULL; + /* * Push the new call frame onto the interpreter's stack of procedure call * frames making it the current frame. @@ -454,6 +456,7 @@ Tcl_PushCallFrame( * Modifies the call stack of the interpreter. Resets various fields of * the popped call frame. If a namespace has been deleted and has no more * activations on the call stack, the namespace is destroyed. + * Schedules a tailcall if one is present. * *---------------------------------------------------------------------- */ @@ -505,6 +508,30 @@ Tcl_PopCallFrame( Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; + + if (framePtr->tailcallPtr) { + /* + * Find the splicing spot: right before the NRCommand of the thing being + * tailcalled. Note that we skip NRCommands marked in data[1] (used by + * command redirectors) + */ + + TEOV_callback *tailcallPtr, *runPtr; + + for (runPtr = TOP_CB(interp); 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!"); + } + + tailcallPtr = framePtr->tailcallPtr; + + tailcallPtr->nextPtr = runPtr->nextPtr; + runPtr->nextPtr = tailcallPtr; + } } /* |