diff options
author | mig <mig> | 2013-01-10 02:38:55 (GMT) |
---|---|---|
committer | mig <mig> | 2013-01-10 02:38:55 (GMT) |
commit | 924eb49553971988b91d0a9cd73a4203455215e6 (patch) | |
tree | 1a305903e50566b04df9e353a015a10246f2a29d /generic | |
parent | d4ad619c97d45199c5143ca313cf4daffe18653f (diff) | |
parent | e97463a0fb4ada0093dbe69808351b2ccb643c6d (diff) | |
download | tcl-924eb49553971988b91d0a9cd73a4203455215e6.zip tcl-924eb49553971988b91d0a9cd73a4203455215e6.tar.gz tcl-924eb49553971988b91d0a9cd73a4203455215e6.tar.bz2 |
merge mig-nre-mods
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 73 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 28 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 2 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 4 | ||||
-rw-r--r-- | generic/tclCompile.c | 7 | ||||
-rw-r--r-- | generic/tclDictObj.c | 12 | ||||
-rw-r--r-- | generic/tclEnsemble.c | 2 | ||||
-rw-r--r-- | generic/tclExecute.c | 18 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 2 | ||||
-rw-r--r-- | generic/tclInt.decls | 3 | ||||
-rw-r--r-- | generic/tclInt.h | 103 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 5 | ||||
-rw-r--r-- | generic/tclInterp.c | 2 | ||||
-rw-r--r-- | generic/tclNRE.h | 100 | ||||
-rw-r--r-- | generic/tclNamesp.c | 4 | ||||
-rw-r--r-- | generic/tclOO.c | 6 | ||||
-rw-r--r-- | generic/tclOOBasic.c | 16 | ||||
-rw-r--r-- | generic/tclOOCall.c | 6 | ||||
-rw-r--r-- | generic/tclOOMethod.c | 2 | ||||
-rw-r--r-- | generic/tclProc.c | 6 | ||||
-rw-r--r-- | generic/tclTest.c | 1 |
21 files changed, 223 insertions, 179 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)); } } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index f155de9..da4afd4 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -170,7 +170,7 @@ Tcl_CatchObjCmd( optionVarNamePtr = objv[3]; } - TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc), + Tcl_NRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc), varNamePtr, optionVarNamePtr, NULL); return TclNREvalObjEx(interp, objv[1], 0); @@ -615,7 +615,7 @@ Tcl_EvalObjCmd( objPtr = Tcl_ConcatObj(objc-1, objv+1); } - TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0); } @@ -704,10 +704,10 @@ Tcl_ExprObjCmd( Tcl_IncrRefCount(resultPtr); if (objc == 2) { objPtr = objv[1]; - TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL); } else { objPtr = Tcl_ConcatObj(objc-1, objv+1); - TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL); + Tcl_NRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL); } return Tcl_NRExprObj(interp, objPtr, resultPtr); @@ -2226,7 +2226,7 @@ Tcl_ForObjCmd( iterPtr->next = objv[3]; iterPtr->msg = "\n (\"for\" body line %d)"; - TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, objv[1], 0); } @@ -2245,7 +2245,7 @@ ForSetupCallback( TclSmallFree(iterPtr); return result; } - TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return TCL_OK; } @@ -2269,7 +2269,7 @@ TclNRForIterCallback( Tcl_ResetResult(interp); TclNewObj(boolObj); - TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL, + Tcl_NRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL, NULL); return Tcl_NRExprObj(interp, iterPtr->cond, boolObj); case TCL_BREAK: @@ -2307,10 +2307,10 @@ ForCondCallback( if (value) { if (iterPtr->next) { - TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL, + Tcl_NRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL, NULL); } else { - TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, + Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); } return TclNREvalObjEx(interp, iterPtr->body, 0); @@ -2329,12 +2329,12 @@ ForNextCallback( Tcl_Obj *next = iterPtr->next; if ((result == TCL_OK) || (result == TCL_CONTINUE)) { - TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL, + Tcl_NRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, next, 0); } - TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return result; } @@ -2353,7 +2353,7 @@ ForPostNextCallback( } return result; } - TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return result; } @@ -2504,7 +2504,7 @@ EachloopCmd( goto done; } - TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, objv[objc-1], 0); } @@ -2569,7 +2569,7 @@ ForeachLoopStep( goto done; } - TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, statePtr->bodyPtr, 0); } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 4dc7922..5078d43 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4612,7 +4612,7 @@ Tcl_WhileObjCmd( iterPtr->next = NULL; iterPtr->msg = "\n (\"while\" body line %d)"; - TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, + Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return TCL_OK; } diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 3afb3f6..976346f 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2186,7 +2186,6 @@ ExecConstantExprTree( ByteCode *byteCodePtr; int code; Tcl_Obj *byteCodeObj = Tcl_NewObj(); - NRE_callback *rootPtr = TOP_CB(interp); /* * Note we are compiling an expression with literal arguments. This means @@ -2194,6 +2193,7 @@ ExecConstantExprTree( * bytecode, so there's no need to tend to TIP 280 issues. */ + TclNRSetRoot(interp); envPtr = ckalloc(sizeof(CompileEnv)); TclInitCompileEnv(interp, envPtr, NULL, 0); CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, @@ -2205,7 +2205,7 @@ ExecConstantExprTree( ckfree(envPtr); byteCodePtr = byteCodeObj->internalRep.otherValuePtr; TclNRExecuteByteCode(interp, byteCodePtr); - code = TclNRRunCallbacks(interp, TCL_OK, rootPtr); + code = TclNRRunCallbacks(interp, TCL_OK); Tcl_DecrRefCount(byteCodeObj); return code; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 1b9e17e..722ba98 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -985,10 +985,9 @@ Tcl_SubstObj( Tcl_Obj *objPtr, /* The value to be substituted. */ int flags) /* What substitutions to do. */ { - NRE_callback *rootPtr = TOP_CB(interp); - - if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags), - rootPtr) != TCL_OK) { + TclNRSetRoot(interp); + if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags)) + != TCL_OK) { return NULL; } return Tcl_GetObjResult(interp); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index b995d25..9f16f88 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -2444,7 +2444,7 @@ DictForNRCmd( * Run the script. */ - TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, + Tcl_NRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, valueVarObj, scriptObj); return TclNREvalObjEx(interp, scriptObj, 0); @@ -2525,7 +2525,7 @@ DictForLoopCallback( * Run the script. */ - TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, + Tcl_NRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj, valueVarObj, scriptObj); return TclNREvalObjEx(interp, scriptObj, 0); @@ -2644,7 +2644,7 @@ DictMapNRCmd( * Run the script. */ - TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); + Tcl_NRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0); /* @@ -2732,7 +2732,7 @@ DictMapLoopCallback( * Run the script. */ - TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); + Tcl_NRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0); /* @@ -3216,7 +3216,7 @@ DictUpdateCmd( objPtr = Tcl_NewListObj(objc-3, objv+2); Tcl_IncrRefCount(objPtr); Tcl_IncrRefCount(objv[1]); - TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL); + Tcl_NRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL); return TclNREvalObjEx(interp, objv[objc-1], 0); } @@ -3365,7 +3365,7 @@ DictWithCmd( Tcl_IncrRefCount(pathPtr); } Tcl_IncrRefCount(objv[1]); - TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr, + Tcl_NRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr, NULL); return TclNREvalObjEx(interp, objv[objc-1], 0); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index fd6bd87..7b433bc 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1874,7 +1874,7 @@ NsEnsembleImplementationCmd( 2 + ensemblePtr->numParameters; iPtr->ensembleRewrite.numInsertedObjs = prefixObjc + ensemblePtr->numParameters; - TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, + Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } else { register int ni = 2 + ensemblePtr->numParameters diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b7ba6a3..b2a0938 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -21,10 +21,6 @@ #include "tommath.h" #include <math.h> -#if NRE_ENABLE_ASSERTS -#include <assert.h> -#endif - /* * Hack to determine whether we may expect IEEE floating point. The hack is * formally incorrect in that non-IEEE platforms might have the same precision @@ -134,7 +130,7 @@ typedef struct { TD->tosPtr = tosPtr; \ TD->pc = pc; \ TD->cleanup = cleanup; \ - TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \ + Tcl_NRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \ } while (0) #define TEBC_DATA_DIG() \ @@ -932,14 +928,14 @@ Tcl_ExprObj( Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ { - NRE_callback *rootPtr = TOP_CB(interp); Tcl_Obj *resultPtr; + TclNRSetRoot(interp); TclNewObj(resultPtr); - TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr, + Tcl_NRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr, NULL, NULL); Tcl_NRExprObj(interp, objPtr, resultPtr); - return TclNRRunCallbacks(interp, TCL_OK, rootPtr); + return TclNRRunCallbacks(interp, TCL_OK); } static int @@ -1466,7 +1462,7 @@ TclNRExecuteByteCode( * Push the callback for bytecode execution */ - TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0), + Tcl_NRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0), NULL, NULL); return TCL_OK; } @@ -1823,7 +1819,7 @@ TEBCresume( TEBC_YIELD(); Tcl_SetObjResult(interp, OBJ_AT_TOS); - TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, + Tcl_NRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, INT2PTR(0), NULL, NULL); return TCL_OK; @@ -2382,7 +2378,7 @@ TEBCresume( iPtr->ensembleRewrite.numInsertedObjs = 1; pc += 6; TEBC_YIELD(); - TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); + Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); iPtr->evalFlags |= TCL_EVAL_REDIRECT; return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 35fa7d6..5e86713 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1921,7 +1921,7 @@ TclNREvalFile( Tcl_IncrRefCount(iPtr->scriptFile); iPtr->evalFlags |= TCL_EVAL_FILE; - TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr, + Tcl_NRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr, NULL); return TclNREvalObjEx(interp, objPtr, 0); } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index edbd250..81ba868 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -964,8 +964,7 @@ declare 239 { int skip, ProcErrorProc *errorProc) } declare 240 { - int TclNRRunCallbacks(Tcl_Interp *interp, int result, - struct NRE_callback *rootPtr) + int TclNRRunCallbacks(Tcl_Interp *interp, int result) } declare 241 { int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) diff --git a/generic/tclInt.h b/generic/tclInt.h index ee86099..15877f8 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4251,109 +4251,28 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #define NRE_ENABLE_ASSERTS 1 -#define NRE_STACK_DEBUG 0 -#define NRE_STACK_SIZE 100 +#if NRE_ENABLE_ASSERTS +#include <assert.h> +#define NRE_ASSERT(expr) assert((expr)) +#else +#define NRE_ASSERT(expr) +#endif -/* - * This is the main data struct for representing NR commands. It is designed - * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator - * available. - */ - -#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) - -/* - * Inline versions of Tcl_NRAddCallback and friends - */ - -#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \ - do { \ - NRE_callback *cbPtr; \ - ALLOC_CB(interp, cbPtr); \ - INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3); \ - } while (0) - -#define INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3) \ - do { \ - 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 ALLOC_CB(interp, cbPtr) \ - do { \ - cbPtr = ckalloc(sizeof(NRE_callback)); \ - cbPtr->nextPtr = TOP_CB(interp); \ - TOP_CB(interp) = cbPtr; \ - } while (0) - -#define FREE_CB(interp, ptr) \ - ckfree((char *) (ptr)) +void TclNRSetRoot(Tcl_Interp *interp); -#define NEXT_CB(ptr) (ptr)->nextPtr +/* NOTE: this just needed by tclOOBasic.c for a legit operation that deserves + * a better API */ -#else /* not debugging the NRE stack */ +#ifdef USE_TOP_CB +#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) 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; - #endif -#if NRE_ENABLE_ASSERTS -#define NRE_ASSERT(expr) assert((expr)) -#else -#define NRE_ASSERT(expr) -#endif /* GET OUT OF THE ALLOCATOR BIZ! */ #define TclpAlloc(size) malloc(size) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 3ee3ff3..f874ccb 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -535,8 +535,7 @@ TCLAPI int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 240 */ -TCLAPI int TclNRRunCallbacks(Tcl_Interp *interp, int result, - struct NRE_callback *rootPtr); +TCLAPI int TclNRRunCallbacks(Tcl_Interp *interp, int result); /* 241 */ TCLAPI int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); @@ -812,7 +811,7 @@ typedef struct TclIntStubs { int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ void (*reserved238)(void); int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ - int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */ + int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result); /* 240 */ int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 241 */ int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */ void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 1e4da0c..63310f1 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1800,7 +1800,7 @@ AliasNRCmd( if (isRootEnsemble) { TclDeferCallbacks(interp); - TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } iPtr->evalFlags |= TCL_EVAL_REDIRECT; return Tcl_NREvalObj(interp, listPtr, flags); diff --git a/generic/tclNRE.h b/generic/tclNRE.h new file mode 100644 index 0000000..d740105 --- /dev/null +++ b/generic/tclNRE.h @@ -0,0 +1,100 @@ +/* ********************************************** + * NRE internals + * ********************************************** + */ + +#define NRE_STACK_DEBUG 0 +#define NRE_STACK_SIZE 100 + + +/* + * This is the main data struct for representing NR commands. It is designed + * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator + * available. + */ + +/* + * Inline versions of Tcl_NRAddCallback and friends + */ + +#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) + +#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \ + do { \ + NRE_callback *cbPtr; \ + ALLOC_CB(interp, cbPtr); \ + INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3); \ + } while (0) + +#define INIT_CB(cbPtr, postProcPtr,data0,data1,data2,data3) \ + do { \ + 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 ALLOC_CB(interp, cbPtr) \ + do { \ + 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 NEXT_CB(ptr) (ptr)->nextPtr + +#else /* not debugging the NRE stack */ + +typedef struct NRE_callback { + Tcl_NRPostProc *procPtr; + ClientData data[4]; +} 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); + +#endif diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index e39df8a..f07f9b4 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3268,7 +3268,7 @@ NamespaceEvalCmd( objPtr = Tcl_ConcatObj(objc-2, objv+2); } - TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", + Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0); } @@ -3722,7 +3722,7 @@ NamespaceInscopeCmd( Tcl_DecrRefCount(listPtr); /* We're done with the list object. */ } - TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", + Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL, NULL); return TclNREvalObjEx(interp, cmdObjPtr, 0); } diff --git a/generic/tclOO.c b/generic/tclOO.c index 2798419..21ef402 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1768,7 +1768,7 @@ TclNRNewObjectInstance( */ AddRef(oPtr); - TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, + Tcl_NRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state, objectPtr); TclPushTailcallPoint(interp); return TclOOInvokeContext(contextPtr, interp, objc, objv); @@ -2552,7 +2552,7 @@ TclOOObjectCmdCore( * for the duration. */ - TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL); + Tcl_NRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL); return TclOOInvokeContext(contextPtr, interp, objc, objv); } @@ -2705,7 +2705,7 @@ TclNRObjectContextInvokeNext( * all) come through the same code. */ - TclNRAddCallback(interp, FinalizeNext, contextPtr, + Tcl_NRAddCallback(interp, FinalizeNext, contextPtr, INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL); contextPtr->index++; contextPtr->skip = skip; diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index fa4ffce..e79069f 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -13,6 +13,8 @@ #ifdef HAVE_CONFIG_H #include "config.h" #endif + +#define USE_TOP_CB 1 #include "tclInt.h" #include "tclOOInt.h" @@ -33,7 +35,7 @@ static int RestoreFrame(ClientData data[], * * AddCreateCallback, FinalizeConstruction -- * - * Special version of TclNRAddCallback that allows the caller to splice + * Special version of Tcl_NRAddCallback that allows the caller to splice * the object created later on. Always calls FinalizeConstruction, which * converts the object into its name and stores that in the interpreter * result. This is shared by all the construction methods (create, @@ -50,7 +52,7 @@ static inline Tcl_Object * AddConstructionFinalizer( Tcl_Interp *interp) { - TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL); return (Tcl_Object *) &(TOP_CB(interp)->data[0]); } @@ -114,7 +116,7 @@ TclOO_Class_Constructor( Tcl_IncrRefCount(invoke[0]); Tcl_IncrRefCount(invoke[1]); Tcl_IncrRefCount(invoke[2]); - TclNRAddCallback(interp, DecrRefsPostClassConstructor, + Tcl_NRAddCallback(interp, DecrRefsPostClassConstructor, invoke[0], invoke[1], invoke[2], NULL); /* @@ -352,7 +354,7 @@ TclOO_Object_Destroy( if (contextPtr != NULL) { contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; - TclNRAddCallback(interp, AfterNRDestructor, contextPtr, + Tcl_NRAddCallback(interp, AfterNRDestructor, contextPtr, NULL, NULL, NULL); TclPushTailcallPoint(interp); return TclOOInvokeContext(contextPtr, interp, 0, NULL); @@ -447,7 +449,7 @@ TclOO_Object_Eval( * the script completes. */ - TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL); return TclNREvalObjEx(interp, scriptPtr, 0); } @@ -802,7 +804,7 @@ TclOONextObjCmd( * that this is like [uplevel 1] and not [eval]. */ - TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL); iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } @@ -871,7 +873,7 @@ TclOONextToObjCmd( * context. Note that this is like [uplevel 1] and not [eval]. */ - TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr, + Tcl_NRAddCallback(interp, RestoreFrame, framePtr, contextPtr, INT2PTR(contextPtr->index), NULL); contextPtr->index = i-1; iPtr->varFramePtr = framePtr->callerVarPtr; diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index fd751ff..a18b364 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -278,7 +278,7 @@ TclOOInvokeContext( * this call is finished. */ - TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, + Tcl_NRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, NULL); } @@ -287,9 +287,9 @@ TclOOInvokeContext( */ if (contextPtr->oPtr->flags & FILTER_HANDLING) { - TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); + Tcl_NRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); } else { - TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); + Tcl_NRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); } if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { contextPtr->oPtr->flags |= FILTER_HANDLING; diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index aefcf25..45a3ede 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -589,7 +589,7 @@ InvokeProcedureMethod( * Now invoke the body of the method. */ - TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); + Tcl_NRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); return TclNRInterpProcCore(interp, fdPtr->nameObj, Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); } diff --git a/generic/tclProc.c b/generic/tclProc.c index e88e260..27c5262 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -898,7 +898,7 @@ Tcl_UplevelObjCmd( objPtr = Tcl_ConcatObj(objc, objv); } - TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL, + Tcl_NRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0); } @@ -1685,7 +1685,7 @@ TclNRInterpProcCore( procPtr->refCount++; codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; - TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, + Tcl_NRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, NULL, NULL); return TclNRExecuteByteCode(interp, codePtr); } @@ -2475,7 +2475,7 @@ Tcl_ApplyObjCmd( result = PushProcCallFrame(procPtr, interp, objc, objv, 1); if (result == TCL_OK) { - TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL); result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError); } return result; diff --git a/generic/tclTest.c b/generic/tclTest.c index 69461da..8e00b66 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -22,6 +22,7 @@ #include "tclInt.h" #include "tclOO.h" #include <math.h> +#include "tclNRE.h" /* * Required for Testregexp*Cmd |