summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c73
-rw-r--r--generic/tclCmdAH.c28
-rw-r--r--generic/tclCmdMZ.c2
-rw-r--r--generic/tclCompExpr.c4
-rw-r--r--generic/tclCompile.c7
-rw-r--r--generic/tclDictObj.c12
-rw-r--r--generic/tclEnsemble.c2
-rw-r--r--generic/tclExecute.c18
-rw-r--r--generic/tclIOUtil.c2
-rw-r--r--generic/tclInt.decls3
-rw-r--r--generic/tclInt.h103
-rw-r--r--generic/tclIntDecls.h5
-rw-r--r--generic/tclInterp.c2
-rw-r--r--generic/tclNRE.h100
-rw-r--r--generic/tclNamesp.c4
-rw-r--r--generic/tclOO.c6
-rw-r--r--generic/tclOOBasic.c16
-rw-r--r--generic/tclOOCall.c6
-rw-r--r--generic/tclOOMethod.c2
-rw-r--r--generic/tclProc.c6
-rw-r--r--generic/tclTest.c1
-rw-r--r--unix/Makefile.in8
22 files changed, 227 insertions, 183 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
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 7176a1e..96427b3 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -997,7 +997,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 \
@@ -1073,7 +1073,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
@@ -1235,7 +1235,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)
@@ -1274,7 +1274,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)
generated by cgit v0.12 at 2024-07-16 02:31:47 (GMT)