diff options
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 73 |
1 files changed, 51 insertions, 22 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ae65db0..17bd8d5 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -22,10 +22,7 @@ #include "tclCompile.h" #include "tommath.h" #include <math.h> - -#if NRE_ENABLE_ASSERTS -#include <assert.h> -#endif +#include "tclNRE.h" #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 @@ -118,6 +115,10 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); +static int NRRoot(ClientData data[], Tcl_Interp *interp, int result); +#if !NRE_STACK_DEBUG +static Tcl_NRPostProc NRStackBottom; +#endif static Tcl_NRPostProc NRRunObjProc; static void ProcessUnexpectedResult(Tcl_Interp *interp, @@ -3432,10 +3433,10 @@ Tcl_EvalObjv( * TCL_EVAL_NOERR are currently supported. */ { int result; - NRE_callback *rootPtr = TOP_CB(interp); + TclNRSetRoot(interp); result = TclNREvalObjv(interp, objc, objv, flags, NULL); - return TclNRRunCallbacks(interp, result, rootPtr); + return TclNRRunCallbacks(interp, result); } int @@ -3612,20 +3613,48 @@ TclPushTailcallPoint( int TclNRRunCallbacks( Tcl_Interp *interp, - int result, - struct NRE_callback *rootPtr) - /* All callbacks down to rootPtr not inclusive - * are to be run. */ + int result) /* Callbacks are run until the first NRRoot.*/ { NRE_callback *cbPtr; Tcl_NRPostProc *procPtr; - while (TOP_CB(interp) != rootPtr) { + while (TOP_CB(interp) && (TOP_CB(interp)->procPtr != NRRoot)) { POP_CB(interp, cbPtr); procPtr = cbPtr->procPtr; result = procPtr(cbPtr->data, interp, result); FREE_CB(interp, cbPtr); } + if (TOP_CB(interp)) { + POP_CB(interp, cbPtr); + FREE_CB(interp, cbPtr); + } + return result; +} + +void +TclNRSetRoot( + Tcl_Interp *interp) +{ +#if NRE_STACK_DEBUG + int first = (TOP_CB(interp) == NULL); +#else + int first = ((TOP_CB(interp) == NULL) || + ((TOP_CB(interp)->procPtr == NRStackBottom) && + (TOP_CB(interp)->data[0] == NULL))); +#endif + + if (!first) { + TclNRAddCallback(interp, NRRoot, NULL, NULL, NULL, NULL); + } +} + +static int +NRRoot( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + /* NOT CALLED */ return result; } @@ -4454,10 +4483,10 @@ Tcl_EvalObjEx( * are TCL_EVAL_GLOBAL. */ { int result = TCL_OK; - NRE_callback *rootPtr = TOP_CB(interp); + TclNRSetRoot(interp); result = TclNREvalObjEx(interp, objPtr, flags); - return TclNRRunCallbacks(interp, result, rootPtr); + return TclNRRunCallbacks(interp, result); } int @@ -6267,8 +6296,6 @@ Tcl_NRCallObjProc( Tcl_Obj *const objv[]) { int result = TCL_OK; - NRE_callback *rootPtr = TOP_CB(interp); - #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; @@ -6289,8 +6316,10 @@ Tcl_NRCallObjProc( (Tcl_Obj **)(objv + 1)); } #endif /* USE_DTRACE */ + + TclNRSetRoot(interp); result = objProc(clientData, interp, objc, objv); - return TclNRRunCallbacks(interp, result, rootPtr); + return TclNRRunCallbacks(interp, result); } /**************************************************************************** @@ -6369,8 +6398,8 @@ TclDeferCallbacks( } #if !NRE_STACK_DEBUG -int -TclNRStackBottom( +static int +NRStackBottom( ClientData data[], Tcl_Interp *interp, int result) @@ -6437,7 +6466,7 @@ TclNewCallback( } eePtr->NRStack = this; eePtr->callbackPtr = &this->items[-1]; - TclNRAddCallback(interp, TclNRStackBottom, orig, NULL, NULL, NULL); + TclNRAddCallback(interp, NRStackBottom, orig, NULL, NULL, NULL); NRE_ASSERT(eePtr->callbackPtr == &this->items[0]); @@ -6456,7 +6485,7 @@ TclNextCallback( NRE_callback *cbPtr) { - if (cbPtr->procPtr == TclNRStackBottom) { + if (cbPtr->procPtr == NRStackBottom) { NRE_stack *prev = cbPtr->data[0]; if (!prev) { @@ -6773,10 +6802,10 @@ DeleteCoroutine( { CoroutineData *corPtr = clientData; Tcl_Interp *interp = corPtr->eePtr->interp; - NRE_callback *rootPtr = TOP_CB(interp); if (COR_IS_SUSPENDED(corPtr)) { - TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr); + TclNRSetRoot(interp); + TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK)); } } |