diff options
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | generic/tclBasic.c | 120 | ||||
-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 | 6 | ||||
-rw-r--r-- | generic/tclExecute.c | 26 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 2 | ||||
-rw-r--r-- | generic/tclInt.decls | 3 | ||||
-rw-r--r-- | generic/tclInt.h | 109 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 5 | ||||
-rw-r--r-- | generic/tclInterp.c | 5 | ||||
-rw-r--r-- | generic/tclNRE.h | 100 | ||||
-rw-r--r-- | generic/tclNamesp.c | 6 | ||||
-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 | ||||
-rw-r--r-- | library/http/http.tcl | 2 | ||||
-rw-r--r-- | unix/Makefile.in | 8 |
24 files changed, 260 insertions, 229 deletions
@@ -1,8 +1,13 @@ +2013-01-09 Jan Nijtmans <nijtmans@users.sf.net> + + * library/http/http.tcl: [Bug 3599395]: http assumes status line + is a proper tcl list. + 2013-01-08 Jan Nijtmans <nijtmans@users.sf.net> * win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path components. [Bug 3587096] win vista/7: "can't find init.tcl" when - called via junction. + called via junction without folder list access. 2013-01-07 Jan Nijtmans <nijtmans@users.sf.net> diff --git a/generic/tclBasic.c b/generic/tclBasic.c index bb89da9..a36657a 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 @@ -130,6 +127,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 Tcl_ObjCmdProc OldMathFuncProc; @@ -156,7 +157,6 @@ static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; static Tcl_NRPostProc TEOV_RestoreVarFrame; static Tcl_NRPostProc TEOV_RunLeaveTraces; -static Tcl_NRPostProc YieldToCallback; static Tcl_ObjCmdProc NRCoroInjectObjCmd; @@ -4049,10 +4049,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 @@ -4075,7 +4075,7 @@ TclNREvalObjv( Namespace *lookupNsPtr = iPtr->lookupNsPtr; Command **cmdPtrPtr; NRE_callback *callbackPtr; - + iPtr->lookupNsPtr = NULL; /* @@ -4097,11 +4097,6 @@ TclNREvalObjv( } cmdPtrPtr = (Command **) &(callbackPtr->data[0]); - - 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; @@ -4235,10 +4230,7 @@ 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.*/ { Interp *iPtr = (Interp *) interp; NRE_callback *cbPtr; @@ -4258,12 +4250,43 @@ TclNRRunCallbacks( (void) Tcl_GetObjResult(interp); } - 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; } @@ -4546,10 +4569,9 @@ TEOV_NotFound( savedNsPtr = varFramePtr->nsPtr; varFramePtr->nsPtr = lookupNsPtr; } - TclDeferCallbacks(interp); + TclDeferCallbacks(interp, 1); TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc), newObjv, savedNsPtr, NULL); - iPtr->evalFlags |= TCL_EVAL_REDIRECT; return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL); } @@ -5183,10 +5205,10 @@ Tcl_EvalObjEx( * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { 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 @@ -5243,9 +5265,9 @@ TclNREvalObjEx( Tcl_IncrRefCount(listPtr); TclDecrRefCount(objPtr); - TclDeferCallbacks(interp); + TclDeferCallbacks(interp, 0); TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, NULL, - NULL, NULL); + NULL, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); @@ -7169,8 +7191,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]; @@ -7191,8 +7211,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); } /* @@ -7314,19 +7336,23 @@ Tcl_NRCmdSwap( void TclDeferCallbacks( - Tcl_Interp *interp) + Tcl_Interp *interp, + int skipTailcalls) { Interp *iPtr = (Interp *) interp; if (iPtr->deferredCallbacks == NULL) { - TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); + TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(skipTailcalls != 0), + NULL, NULL); iPtr->deferredCallbacks = TOP_CB(interp); + } else if (skipTailcalls) { + iPtr->deferredCallbacks->data[1] = INT2PTR(skipTailcalls != 0); } } #if !NRE_STACK_DEBUG -int -TclNRStackBottom( +static int +NRStackBottom( ClientData data[], Tcl_Interp *interp, int result) @@ -7393,7 +7419,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]); @@ -7412,7 +7438,7 @@ TclNextCallback( NRE_callback *cbPtr) { - if (cbPtr->procPtr == TclNRStackBottom) { + if (cbPtr->procPtr == NRStackBottom) { NRE_stack *prev = cbPtr->data[0]; if (!prev) { @@ -7431,7 +7457,7 @@ TclSetTailcall( { /* * Find the splicing spot: right before the NRCommand of the thing - * being tailcalled. Note that we skip NRCommands marked in data[1] + * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1] * (used by command redirectors). */ @@ -7445,14 +7471,6 @@ TclSetTailcall( if (!runPtr) { Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } - - 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; } @@ -7549,7 +7567,7 @@ TclNRTailcallEval( * Perform the tailcall */ - TclDeferCallbacks(interp); + TclDeferCallbacks(interp, 0); TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); @@ -7680,21 +7698,11 @@ TclNRYieldToObjCmd( */ iPtr->execEnvPtr = corPtr->callerEEPtr; - TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, NULL, NULL); + TclSetTailcall(interp, listPtr); iPtr->execEnvPtr = corPtr->eePtr; return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv); } - -static int -YieldToCallback( - ClientData data[], - Tcl_Interp *interp, - int result) -{ - TclSetTailcall(interp, (Tcl_Obj *) data[1]); - return TCL_OK; -} static int RewindCoroutineCallback( @@ -7729,10 +7737,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 fe02845..7e22f7c 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -317,7 +317,7 @@ TclNRCatchObjCmd( optionVarNamePtr = objv[3]; } - TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc), + Tcl_NRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc), varNamePtr, optionVarNamePtr, NULL); return TclNREvalObjEx(interp, objv[1], 0); @@ -772,7 +772,7 @@ TclNREvalObjCmd( 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); } @@ -871,10 +871,10 @@ TclNRExprObjCmd( 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); @@ -2403,7 +2403,7 @@ TclNRForObjCmd( 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); } @@ -2422,7 +2422,7 @@ ForSetupCallback( TclSmallFreeEx(interp, iterPtr); return result; } - TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return TCL_OK; } @@ -2446,7 +2446,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: @@ -2484,10 +2484,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); @@ -2506,12 +2506,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; } @@ -2530,7 +2530,7 @@ ForPostNextCallback( } return result; } - TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); + Tcl_NRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); return result; } @@ -2701,7 +2701,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); } @@ -2766,7 +2766,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 7f4ee15..0be71d4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4661,7 +4661,7 @@ TclNRWhileObjCmd( 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 2f8cfd9..46b652c 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 = TclStackAlloc(interp, sizeof(CompileEnv)); TclInitCompileEnv(interp, envPtr, NULL, 0); CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, @@ -2205,7 +2205,7 @@ ExecConstantExprTree( TclStackFree(interp, 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 1e4a0eb..ea47844 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 ae329ac..85d2d27 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 d525fad..a1d2f1d 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1885,7 +1885,7 @@ NsEnsembleImplementationCmdNR( 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 @@ -1904,7 +1904,7 @@ NsEnsembleImplementationCmdNR( * Hand off to the target command. */ - iPtr->evalFlags |= TCL_EVAL_REDIRECT; + TclDeferCallbacks(interp, /* skip tailcalls */ 1); return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE); } @@ -2112,7 +2112,7 @@ EnsembleUnknownCallback( */ Tcl_Preserve(ensemblePtr); - ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT; + TclDeferCallbacks (interp, /*skip tailcalls */ 1); result = Tcl_EvalObjv(interp, paramc, paramv, 0); if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) { if (!Tcl_InterpDeleted(interp)) { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index db86b2e..94c84b8 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 @@ -189,7 +185,7 @@ typedef struct TEBCdata { esPtr->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() \ @@ -1117,7 +1113,7 @@ GrowEvaluationStack( if (move) { moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1; } - needed = growth + moveWords + WALLOCALIGN - 1; + needed = growth + moveWords + WALLOCALIGN; /* @@ -1390,14 +1386,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 @@ -1922,7 +1918,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; } @@ -2280,7 +2276,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; @@ -2322,6 +2318,9 @@ TEBCresume( listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); + if (iPtr->varFramePtr->tailcallPtr) { + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + } iPtr->varFramePtr->tailcallPtr = listPtr; result = TCL_RETURN; @@ -2916,8 +2915,9 @@ TEBCresume( DECACHE_STACK_INFO(); pc += 6; TEBC_YIELD(); - TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); - iPtr->evalFlags |= TCL_EVAL_REDIRECT; + + Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); + TclDeferCallbacks(interp, /*skip tailcalls */ 1); return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE); /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f29a7ef..19b04e5 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1937,7 +1937,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 7b58b2f..1e39db9 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -961,8 +961,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 609b924..d69093f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1154,7 +1154,8 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled for this CF*/ + Tcl_Obj *tailcallPtr; + /* NULL if no tailcall is scheduled */ } CallFrame; #define FRAME_IS_PROC 0x1 @@ -2011,7 +2012,6 @@ typedef struct InterpList { #define TCL_ALLOW_EXCEPTIONS 4 #define TCL_EVAL_FILE 2 #define TCL_EVAL_CTX 8 -#define TCL_EVAL_REDIRECT 16 /* * Flag bits for Interp structures: @@ -2567,7 +2567,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); -MODULE_SCOPE void TclDeferCallbacks(Tcl_Interp *interp); +MODULE_SCOPE void TclDeferCallbacks(Tcl_Interp *interp, int skipTailcall); /* // * This structure holds the data for the various iteration callbacks used to @@ -4505,109 +4505,28 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); */ #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 #include "tclIntDecls.h" #include "tclIntPlatDecls.h" diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 718c354..6628926 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -566,8 +566,7 @@ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 240 */ -EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, - struct NRE_callback *rootPtr); +EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result); /* 241 */ EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); @@ -843,7 +842,7 @@ typedef struct TclIntStubs { int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ 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 a2613ec..6731cba 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1798,10 +1798,9 @@ 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; + TclDeferCallbacks(interp, /* skip tailcalls */ 1); 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 82d2c6d..46826f1 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1945,7 +1945,7 @@ InvokeImportedNRCmd( ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; - ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT; + TclDeferCallbacks(interp, /* skip tailcalls */ 1); return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0); } @@ -3303,7 +3303,7 @@ NRNamespaceEvalCmd( 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); } @@ -3768,7 +3768,7 @@ NRNamespaceInscopeCmd( 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 d6d2d6a..e7071ec 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1774,7 +1774,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); @@ -2578,7 +2578,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); } @@ -2731,7 +2731,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 d92bb92..c08e975 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 a79e4fa..88a5bd9 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 8d484bc..628090f 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 38b0672..cecc1a8 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -908,7 +908,7 @@ TclNRUplevelObjCmd( 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); } @@ -1713,7 +1713,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); } @@ -2513,7 +2513,7 @@ TclNRApplyObjCmd( 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 1371278..75ecb6a 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 diff --git a/library/http/http.tcl b/library/http/http.tcl index cb221a3..01bf772 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -981,7 +981,7 @@ proc http::Event {sock token} { } elseif {$n == 0} { # We have now read all headers # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3 - if {$state(http) == "" || [lindex $state(http) 1] == 100} { + if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} { return } diff --git a/unix/Makefile.in b/unix/Makefile.in index ee31282..cc7f42f 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1001,7 +1001,7 @@ FSHDR=$(GENERIC_DIR)/tclFileSystem.h IOHDR=$(GENERIC_DIR)/tclIO.h MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h PARSEHDR=$(GENERIC_DIR)/tclParse.h -NREHDR=$(GENERIC_DIR)/tclInt.h +NREHDR=$(GENERIC_DIR)/tclNRE.h regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \ $(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \ @@ -1083,7 +1083,7 @@ tclEnv.o: $(GENERIC_DIR)/tclEnv.c tclEvent.o: $(GENERIC_DIR)/tclEvent.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c -tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR) +tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c @@ -1242,7 +1242,7 @@ tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c -tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(NREHDR) +tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c $(TCLREHDRS) @@ -1281,7 +1281,7 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c -tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) +tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(NREHDR) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS) |