diff options
author | mig <mig> | 2013-01-08 23:19:27 (GMT) |
---|---|---|
committer | mig <mig> | 2013-01-08 23:19:27 (GMT) |
commit | d4ad619c97d45199c5143ca313cf4daffe18653f (patch) | |
tree | b112d8cb73c46600e27353f4ef2d489bd0dd1c29 /generic | |
parent | 480594229917873c75bd7303053a4bcbac4664dc (diff) | |
parent | bc7433a4ef2444aa066152597a2d1cad34d1ae2a (diff) | |
download | tcl-d4ad619c97d45199c5143ca313cf4daffe18653f.zip tcl-d4ad619c97d45199c5143ca313cf4daffe18653f.tar.gz tcl-d4ad619c97d45199c5143ca313cf4daffe18653f.tar.bz2 |
merge from trunk and mig-nre-mods, via no280
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 263 | ||||
-rw-r--r-- | generic/tclCompCmdsSZ.c | 4 | ||||
-rw-r--r-- | generic/tclExecute.c | 14 | ||||
-rw-r--r-- | generic/tclInt.h | 138 | ||||
-rw-r--r-- | generic/tclInterp.c | 3 | ||||
-rw-r--r-- | generic/tclNamesp.c | 2 | ||||
-rw-r--r-- | generic/tclTest.c | 2 |
7 files changed, 276 insertions, 150 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a117530..ae65db0 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -144,8 +144,6 @@ static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc YieldToCallback; -static void ClearTailcall(Tcl_Interp *interp, - struct NRE_callback *tailcallPtr); static Tcl_ObjCmdProc NRCoroInjectObjCmd; MODULE_SCOPE const TclStubs tclStubs; @@ -3459,6 +3457,7 @@ TclNREvalObjv( int result; Namespace *lookupNsPtr = iPtr->lookupNsPtr; Command **cmdPtrPtr; + NRE_callback *callbackPtr; iPtr->lookupNsPtr = NULL; @@ -3472,15 +3471,22 @@ TclNREvalObjv( * finishes the source command and not just the target. */ - if (iPtr->evalFlags & TCL_EVAL_REDIRECT) { - TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv); - iPtr->evalFlags &= ~TCL_EVAL_REDIRECT; + if (iPtr->deferredCallbacks) { + callbackPtr = iPtr->deferredCallbacks; + iPtr->deferredCallbacks = NULL; } else { - TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv); + TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); + callbackPtr = TOP_CB(interp); } - cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]); + cmdPtrPtr = (Command **) &(callbackPtr->data[0]); + - TclNRSpliceDeferred(interp); + if (iPtr->evalFlags & TCL_EVAL_REDIRECT) { + callbackPtr->data[1] = INT2PTR(1); + iPtr->evalFlags &= ~TCL_EVAL_REDIRECT; + } + callbackPtr->data[2] = INT2PTR(objc); + callbackPtr->data[3] = (ClientData) objv; iPtr->numLevels++; result = TclInterpReady(interp); @@ -3611,15 +3617,14 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { - NRE_callback *callbackPtr; + NRE_callback *cbPtr; Tcl_NRPostProc *procPtr; while (TOP_CB(interp) != rootPtr) { - callbackPtr = TOP_CB(interp); - procPtr = callbackPtr->procPtr; - TOP_CB(interp) = callbackPtr->nextPtr; - result = procPtr(callbackPtr->data, interp, result); - TCLNR_FREE(interp, callbackPtr); + POP_CB(interp, cbPtr); + procPtr = cbPtr->procPtr; + result = procPtr(cbPtr->data, interp, result); + FREE_CB(interp, cbPtr); } return result; } @@ -3632,26 +3637,33 @@ NRCommand( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = data[0]; - /* int cmdStart = PTR2INT(data[1]); NOT USED HERE */ if (cmdPtr) { TclCleanupCommandMacro(cmdPtr); } - ((Interp *)interp)->numLevels--; + iPtr->numLevels--; + + /* + * If there is a tailcall, schedule it + */ + + if (data[1] && (data[1] != INT2PTR(1))) { + TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL); + } /* OPT ?? * Do not interrupt a series of cleanups with async or limit checks: * just check at the end? */ - + if (TclAsyncReady(iPtr)) { - result = Tcl_AsyncInvoke(interp, result); + result = Tcl_AsyncInvoke(interp, result); } if ((result == TCL_OK) && TclCanceled(iPtr)) { - result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG); + result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG); } if (result == TCL_OK && TclLimitReady(iPtr->limit)) { - result = Tcl_LimitCheck(interp); + result = Tcl_LimitCheck(interp); } return result; @@ -3896,7 +3908,8 @@ TEOV_NotFound( savedNsPtr = varFramePtr->nsPtr; varFramePtr->nsPtr = lookupNsPtr; } - TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), + TclDeferCallbacks(interp); + TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), newObjv, savedNsPtr, NULL); iPtr->evalFlags |= TCL_EVAL_REDIRECT; return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL); @@ -4500,8 +4513,9 @@ TclNREvalObjEx( Tcl_IncrRefCount(listPtr); TclDecrRefCount(objPtr); - TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, NULL, - NULL, NULL); + TclDeferCallbacks(interp); + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, NULL, + NULL, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); @@ -6343,9 +6357,121 @@ Tcl_NRCmdSwap( */ void -TclSpliceTailcall( +TclDeferCallbacks( + Tcl_Interp *interp) +{ + Interp *iPtr = (Interp *) interp; + + if (iPtr->deferredCallbacks == NULL) { + TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); + } +} + +#if !NRE_STACK_DEBUG +int +TclNRStackBottom( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *) interp; + ExecEnv *eePtr = iPtr->execEnvPtr; + NRE_stack *this = eePtr->NRStack; + NRE_stack *prev = data[0]; + + if (!prev) { + /* empty stack, free it */ + ckfree(this); + eePtr->NRStack = NULL; + TOP_CB(interp) = NULL; + return result; + } + + /* + * Go back to the previous stack. + */ + + eePtr->NRStack = prev; + eePtr->callbackPtr = &prev->items[NRE_STACK_SIZE-1]; + + /* + * Keep this stack in reserve. If this one had a successor, free that one: + * we always keep just one in reserve. + */ + + if (this->next) { + ckfree (this->next); + this->next = NULL; + } + + return result; +} + +int level = 0; + +NRE_callback * +TclNewCallback( + Tcl_Interp *interp) +{ + Interp *iPtr = (Interp *) interp; + ExecEnv *eePtr = iPtr->execEnvPtr; + NRE_stack *this = eePtr->NRStack, *orig; + + if (eePtr->callbackPtr && + (eePtr->callbackPtr < &this->items[NRE_STACK_SIZE-1])) { + stackReady: + return ++eePtr->callbackPtr; + } + + if (!eePtr->callbackPtr) { + this = NULL; + } + orig = this; + + if (this && this->next) { + this = this->next; + } else { + this = (NRE_stack *) ckalloc(sizeof(NRE_stack)); + this->next = NULL; + } + eePtr->NRStack = this; + eePtr->callbackPtr = &this->items[-1]; + TclNRAddCallback(interp, TclNRStackBottom, orig, NULL, NULL, NULL); + + NRE_ASSERT(eePtr->callbackPtr == &this->items[0]); + + goto stackReady; +} + +NRE_callback * +TclPopCallback( + Tcl_Interp *interp) +{ + return ((Interp *)interp)->execEnvPtr->callbackPtr--; +} + +NRE_callback * +TclNextCallback( + NRE_callback *cbPtr) +{ + + if (cbPtr->procPtr == TclNRStackBottom) { + NRE_stack *prev = cbPtr->data[0]; + + if (!prev) { + return NULL; + } + cbPtr = &prev->items[NRE_STACK_SIZE]; + } + return --cbPtr; +} + +#endif +void +TclSetTailcall( Tcl_Interp *interp, - NRE_callback *tailcallPtr) + Tcl_Obj *listPtr) { /* * Find the splicing spot: right before the NRCommand of the thing @@ -6355,8 +6481,8 @@ TclSpliceTailcall( NRE_callback *runPtr; - for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + for (runPtr = TOP_CB(interp); runPtr; runPtr = NEXT_CB(runPtr)) { + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { break; } } @@ -6364,8 +6490,14 @@ TclSpliceTailcall( Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } - tailcallPtr->nextPtr = runPtr->nextPtr; - runPtr->nextPtr = tailcallPtr; + if (runPtr->data[1]) { + /* + * A tailcall was already scheduled: clear it! + */ + Tcl_Obj *oldPtr = (Tcl_Obj *) runPtr->data[1]; + Tcl_DecrRefCount(oldPtr); + } + runPtr->data[1] = listPtr; } int @@ -6395,7 +6527,7 @@ TclNRTailcallObjCmd( */ if (iPtr->varFramePtr->tailcallPtr) { - ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr); + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); iPtr->varFramePtr->tailcallPtr = NULL; } @@ -6410,23 +6542,20 @@ TclNRTailcallObjCmd( Tcl_Obj *listPtr, *nsObjPtr; Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; Tcl_Namespace *ns1Ptr; - NRE_callback *tailcallPtr; - listPtr = Tcl_NewListObj(objc-1, objv+1); - Tcl_IncrRefCount(listPtr); + /* The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. */ + + listPtr = Tcl_NewListObj(objc, objv); 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, TclNRTailcallEval, listPtr, nsObjPtr, - NULL, NULL); - tailcallPtr = TOP_CB(interp); - TOP_CB(interp) = tailcallPtr->nextPtr; - iPtr->varFramePtr->tailcallPtr = tailcallPtr; + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } @@ -6438,12 +6567,14 @@ TclNRTailcallEval( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = data[0]; - Tcl_Obj *nsObjPtr = data[1]; + Tcl_Obj *listPtr = data[0], *nsObjPtr; Tcl_Namespace *nsPtr; int objc; Tcl_Obj **objv; + Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); + nsObjPtr = objv[0]; + if (result == TCL_OK) { result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); } @@ -6462,10 +6593,10 @@ TclNRTailcallEval( * Perform the tailcall */ - TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL,NULL); + TclDeferCallbacks(interp); + TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - ListObjGetElements(listPtr, objc, objv); - return TclNREvalObjv(interp, objc, objv, 0, NULL); + return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); } static int @@ -6475,19 +6606,8 @@ TailcallCleanup( int result) { Tcl_DecrRefCount((Tcl_Obj *) data[0]); - Tcl_DecrRefCount((Tcl_Obj *) data[1]); return result; } - -static void -ClearTailcall( - Tcl_Interp *interp, - NRE_callback *tailcallPtr) -{ - TailcallCleanup(tailcallPtr->data, interp, TCL_OK); - TCLNR_FREE(interp, tailcallPtr); -} - void Tcl_NRAddCallback( @@ -6589,23 +6709,22 @@ TclNRYieldToObjCmd( * This is essentially code from TclNRTailcallObjCmd */ - listPtr = Tcl_NewListObj(objc-1, objv+1); - Tcl_IncrRefCount(listPtr); + listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) || (nsPtr != ns1Ptr)) { Tcl_Panic("yieldto failed to find the proper namespace"); } - Tcl_IncrRefCount(nsObjPtr); + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + /* * Add the callback in the caller's env, then instruct TEBC to yield. */ iPtr->execEnvPtr = corPtr->callerEEPtr; - TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr, - NULL); + TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, NULL, NULL); iPtr->execEnvPtr = corPtr->eePtr; return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv); @@ -6617,20 +6736,7 @@ YieldToCallback( Tcl_Interp *interp, int result) { - /* CoroutineData *corPtr = data[0];*/ - Tcl_Obj *listPtr = data[1]; - ClientData nsPtr = data[2]; - NRE_callback *cbPtr; - - /* - * yieldTo: invoke the command using tailcall tech. - */ - - TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsPtr, NULL, NULL); - cbPtr = TOP_CB(interp); - TOP_CB(interp) = cbPtr->nextPtr; - - TclSpliceTailcall(interp, cbPtr); + TclSetTailcall(interp, (Tcl_Obj *) data[1]); return TCL_OK; } @@ -6735,11 +6841,16 @@ NRCoroutineExitCallback( */ NRE_ASSERT(interp == corPtr->eePtr->interp); - NRE_ASSERT(TOP_CB(interp) == NULL); NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr); NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); NRE_ASSERT((corPtr->callerEEPtr->callbackPtr->procPtr == NRCoroutineCallerCallback)); + if (TOP_CB(interp) != NULL) { + NRE_callback *cleanPtr = TOP_CB(interp); + TOP_CB(interp) = NULL; + cleanPtr->procPtr(cleanPtr->data, interp, TCL_OK); + } + cmdPtr->deleteProc = NULL; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); TclCleanupCommandMacro(cmdPtr); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 86477d9..3bfb75b 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1845,11 +1845,13 @@ TclCompileTailcallCmd( return TCL_ERROR; } + /* make room for the nsObjPtr */ + CompileWord(envPtr, tokenPtr, interp, 0); for (i=1 ; i<parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } - TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords-1, envPtr); + TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 828903e..b7ba6a3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1831,7 +1831,6 @@ TEBCresume( case INST_TAILCALL: { Tcl_Obj *listPtr, *nsObjPtr; - NRE_callback *tailcallPtr; opnd = TclGetUInt1AtPtr(pc+1); @@ -1865,18 +1864,9 @@ TEBCresume( listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); - Tcl_IncrRefCount(listPtr); - Tcl_IncrRefCount(nsObjPtr); - TclNRAddCallback(interp, TclNRTailcallEval, listPtr, nsObjPtr, - NULL, NULL); + TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + iPtr->varFramePtr->tailcallPtr = listPtr; - /* - * Unstitch ourselves and do a [return]. - */ - - tailcallPtr = TOP_CB(interp); - TOP_CB(interp) = tailcallPtr->nextPtr; - iPtr->varFramePtr->tailcallPtr = tailcallPtr; result = TCL_RETURN; cleanup = opnd; goto processExceptionReturn; diff --git a/generic/tclInt.h b/generic/tclInt.h index 7933ab4..ee86099 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1151,8 +1151,7 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - struct NRE_callback *tailcallPtr; - /* NULL if no tailcall is scheduled */ + Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled for this CF*/ } CallFrame; #define FRAME_IS_PROC 0x1 @@ -1284,6 +1283,7 @@ typedef struct ExecEnv { struct Tcl_Interp *interp; struct NRE_callback *callbackPtr; /* Top callback in NRE's stack. */ + struct NRE_stack *NRStack; struct CoroutineData *corPtr; int rewind; } ExecEnv; @@ -1826,12 +1826,8 @@ typedef struct Interp { * and setup. */ struct NRE_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 - i.e., they should be run *before* - * any tailcall is invoked. */ - + /* First callback deferred for the next + * call to EvalObjv */ /* * TIP #285, Script cancellation support. */ @@ -2451,8 +2447,8 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; -MODULE_SCOPE void TclSpliceTailcall(Tcl_Interp *interp, - struct NRE_callback *tailcallPtr); +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclDeferCallbacks(Tcl_Interp *interp); /* // * This structure holds the data for the various iteration callbacks used to @@ -4254,8 +4250,10 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; *---------------------------------------------------------------- */ -#define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */ #define NRE_ENABLE_ASSERTS 1 +#define NRE_STACK_DEBUG 0 +#define NRE_STACK_SIZE 100 + /* * This is the main data struct for representing NR commands. It is designed @@ -4263,68 +4261,92 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * available. */ -typedef struct NRE_callback { - Tcl_NRPostProc *procPtr; - ClientData data[4]; - struct NRE_callback *nextPtr; -} NRE_callback; - #define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) /* - * Inline version of Tcl_NRAddCallback. + * Inline versions of Tcl_NRAddCallback and friends */ -#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \ +#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \ do { \ - NRE_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 = TOP_CB(interp); \ - TOP_CB(interp) = callbackPtr; \ + NRE_callback *cbPtr; \ + ALLOC_CB(interp, cbPtr); \ + INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3); \ } while (0) -#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) \ +#define INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3) \ do { \ - NRE_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; \ + cbPtr->procPtr = (postProcPtr); \ + cbPtr->data[0] = (ClientData)(data0); \ + cbPtr->data[1] = (ClientData)(data1); \ + cbPtr->data[2] = (ClientData)(data2); \ + cbPtr->data[3] = (ClientData)(data3); \ + } while (0) + +#if NRE_STACK_DEBUG + +typedef struct NRE_callback { + Tcl_NRPostProc *procPtr; + ClientData data[4]; + struct NRE_callback *nextPtr; +} NRE_callback; + +#define POP_CB(interp, cbPtr) \ + do { \ + cbPtr = TOP_CB(interp); \ + TOP_CB(interp) = cbPtr->nextPtr; \ } while (0) -#define TclNRSpliceCallbacks(interp, topPtr) \ +#define ALLOC_CB(interp, cbPtr) \ do { \ - NRE_callback *bottomPtr = topPtr; \ - while (bottomPtr->nextPtr) { \ - bottomPtr = bottomPtr->nextPtr; \ - } \ - bottomPtr->nextPtr = TOP_CB(interp); \ - TOP_CB(interp) = topPtr; \ + cbPtr = ckalloc(sizeof(NRE_callback)); \ + cbPtr->nextPtr = TOP_CB(interp); \ + TOP_CB(interp) = cbPtr; \ } while (0) + +#define FREE_CB(interp, ptr) \ + ckfree((char *) (ptr)) -#define TclNRSpliceDeferred(interp) \ - if (((Interp *)interp)->deferredCallbacks) { \ - TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \ - ((Interp *)interp)->deferredCallbacks = NULL; \ - } +#define NEXT_CB(ptr) (ptr)->nextPtr + +#else /* not debugging the NRE stack */ + +typedef struct NRE_callback { + Tcl_NRPostProc *procPtr; + ClientData data[4]; + struct NRE_callback *nextPtr; +} NRE_callback; + +typedef struct NRE_stack { + struct NRE_callback items[NRE_STACK_SIZE]; + struct NRE_stack *next; +} NRE_stack; + +#define POP_CB(interp, cbPtr) \ + (cbPtr) = TOP_CB(interp)-- + +#define ALLOC_CB(interp, cbPtr) \ + do { \ + ExecEnv *eePtr = ((Interp *) interp)->execEnvPtr; \ + NRE_stack *this = eePtr->NRStack; \ + \ + if (eePtr->callbackPtr && \ + (eePtr->callbackPtr < &this->items[NRE_STACK_SIZE-1])) { \ + (cbPtr) = ++eePtr->callbackPtr; \ + } else { \ + (cbPtr) = TclNewCallback(interp); \ + } \ + } while (0) + +#define FREE_CB(interp, cbPtr) + +#define NEXT_CB(ptr) TclNextCallback(ptr) + +MODULE_SCOPE NRE_callback *TclNewCallback(Tcl_Interp *interp); +MODULE_SCOPE NRE_callback *TclPopCallback(Tcl_Interp *interp); +MODULE_SCOPE NRE_callback *TclNextCallback(NRE_callback *ptr); +MODULE_SCOPE Tcl_NRPostProc TclNRStackBottom; -#if NRE_USE_SMALL_ALLOC -#define TCLNR_ALLOC(interp, ptr) \ - TclCkSmallAlloc(sizeof(NRE_callback), (ptr)) -#define TCLNR_FREE(interp, ptr) TclSmallFree(ptr) -#else -#define TCLNR_ALLOC(interp, ptr) \ - (ptr = ((ClientData) ckalloc(sizeof(NRE_callback)))) -#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr)) #endif #if NRE_ENABLE_ASSERTS diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0b3d9ba..1e4da0c 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1799,7 +1799,8 @@ AliasNRCmd( */ if (isRootEnsemble) { - TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); + TclDeferCallbacks(interp); + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } iPtr->evalFlags |= TCL_EVAL_REDIRECT; return Tcl_NREvalObj(interp, listPtr, flags); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index a0e1643..e39df8a 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -416,7 +416,7 @@ Tcl_PopCallFrame( framePtr->nsPtr = NULL; if (framePtr->tailcallPtr) { - TclSpliceTailcall(interp, framePtr->tailcallPtr); + TclSetTailcall(interp, framePtr->tailcallPtr); } } diff --git a/generic/tclTest.c b/generic/tclTest.c index 02e577d..69461da 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6501,7 +6501,7 @@ TestNRELevels( while (cbPtr) { i++; - cbPtr = cbPtr->nextPtr; + cbPtr = NEXT_CB(cbPtr); } levels[3] = Tcl_NewIntObj(i); |