summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog16
-rw-r--r--generic/tclBasic.c32
-rw-r--r--generic/tclDictObj.c7
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclInterp.c5
-rw-r--r--generic/tclNRE.h28
-rw-r--r--generic/tclNamesp.c9
-rw-r--r--generic/tclOO.c8
-rw-r--r--generic/tclOOBasic.c10
-rw-r--r--generic/tclOOCall.c8
-rw-r--r--generic/tclOOInt.h3
-rw-r--r--generic/tclOOMethod.c4
-rw-r--r--generic/tclProc.c6
13 files changed, 86 insertions, 54 deletions
diff --git a/ChangeLog b/ChangeLog
index 521fe711..5e9a4d5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2008-07-18 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c: Optimization: replace calls to
+ * generic/tclDictObj.c: Tcl_NRAddCallback with the macro
+ * generic/tclExecute.c: TclNRAddCallback.
+ * generic/tclInterp.c:
+ * generic/tclNRE.h:
+ * generic/tclNamesp.c:
+ * generic/tclOO.c:
+ * generic/tclOOBasic.c:
+ * generic/tclOOCall.c:
+ * generic/tclOOInt.h:
+ * generic/tclOOMethod.c:
+ * generic/tclProc.c:
+
+
2008-07-18 Donal K. Fellows <dkf@users.sf.net>
* generic/tclOO.c (TclNRNewObjectInstance, FinalizeAlloc):
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b52ff39..eb35aaf 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.315 2008/07/18 13:46:43 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.316 2008/07/18 23:29:41 msofer Exp $
*/
#include "tclInt.h"
@@ -4304,7 +4304,7 @@ TEOV_PushExceptionHandlers(
* Error messages
*/
- Tcl_NRAddCallback(interp, TEOV_Error, INT2PTR(objc),
+ TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc),
(ClientData) objv, NULL,NULL);
}
@@ -4313,7 +4313,7 @@ TEOV_PushExceptionHandlers(
* No CONTINUE or BREAK at level 0, manage RETURN
*/
- Tcl_NRAddCallback(interp, TEOV_Exception, NULL, NULL, NULL, NULL);
+ TclNRAddCallback(interp, TEOV_Exception, NULL, NULL, NULL, NULL);
}
}
@@ -4328,7 +4328,7 @@ TEOV_SwitchVarFrame(
* restore things at the end.
*/
- Tcl_NRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL,
+ TclNRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL,
NULL, NULL);
iPtr->varFramePtr = iPtr->rootFramePtr;
}
@@ -4545,7 +4545,7 @@ TEOV_RunEnterTraces(
* Command was found: push a record to schedule the leave traces.
*/
- Tcl_NRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
+ TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
commandPtr, cmdPtr, NULL);
cmdPtr->refCount++;
} else {
@@ -5388,7 +5388,7 @@ TclNREvalObjEx(
iPtr->cmdFramePtr = eoFramePtr;
- Tcl_NRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr,
+ TclNRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr,
copyPtr, NULL);
return Tcl_NREvalObj(interp, objPtr, flags);
}
@@ -5411,7 +5411,7 @@ TclNREvalObjEx(
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = iPtr->rootFramePtr;
}
- Tcl_NRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
+ TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
objPtr, INT2PTR(allowExceptions), NULL);
newCodePtr = TclCompileObj(interp, objPtr, invoker, word);
@@ -7643,24 +7643,10 @@ Tcl_NRAddCallback(
ClientData data2,
ClientData data3)
{
- TEOV_record *recordPtr;
- TEOV_callback *callbackPtr;
-
- if (!postProcPtr) {
+ if (!(postProcPtr)) {
Tcl_Panic("Adding a callback without and objProc?!");
}
-
- recordPtr = TOP_RECORD(interp);
- TclSmallAlloc(sizeof(TEOV_callback), callbackPtr);
-
- callbackPtr->procPtr = postProcPtr;
- callbackPtr->data[0] = data0;
- callbackPtr->data[1] = data1;
- callbackPtr->data[2] = data2;
- callbackPtr->data[3] = data3;
-
- callbackPtr->nextPtr = recordPtr->callbackPtr;
- recordPtr->callbackPtr = callbackPtr;
+ TclNRAddCallback(interp, postProcPtr, data0, data1, data2, data3);
}
TEOV_record *
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 5b47c22..b75c92c 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,11 +9,12 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.63 2008/07/18 13:46:43 msofer Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.64 2008/07/18 23:29:42 msofer Exp $
*/
#include "tclInt.h"
#include "tommath.h"
+#include "tclNRE.h"
/*
* Forward declaration.
@@ -2932,7 +2933,7 @@ DictUpdateCmd(
objPtr = Tcl_NewListObj(objc-3, objv+2);
Tcl_IncrRefCount(objPtr);
Tcl_IncrRefCount(objv[1]);
- Tcl_NRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
+ TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
}
@@ -3111,7 +3112,7 @@ DictWithCmd(
Tcl_IncrRefCount(pathPtr);
}
Tcl_IncrRefCount(objv[1]);
- Tcl_NRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
+ TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
NULL);
return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index dd09802..7b9ae49 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.381 2008/07/18 13:46:43 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.382 2008/07/18 23:29:43 msofer Exp $
*/
#include "tclInt.h"
@@ -7796,7 +7796,7 @@ TclExecuteByteCode(
rootPtr = TOP_RECORD(iPtr);
PUSH_RECORD(iPtr, recordPtr);
- Tcl_NRAddCallback(interp, TailcallFromTebc, tailObjPtr, lookupNsPtr, NULL, NULL);
+ TclNRAddCallback(interp, TailcallFromTebc, tailObjPtr, lookupNsPtr, NULL, NULL);
/* Now swap them! */
recordPtr->nextPtr = rootPtr->nextPtr;
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 358d85c..4412aa8 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,10 +10,11 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.89 2008/07/18 13:46:45 msofer Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.90 2008/07/18 23:29:44 msofer Exp $
*/
#include "tclInt.h"
+#include "tclNRE.h"
/*
* A pointer to a string that holds an initialization script that if non-NULL
@@ -1805,7 +1806,7 @@ AliasNRCmd(
*/
if (isRootEnsemble) {
- Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
}
return TclNREvalCmd(interp, listPtr, flags);
}
diff --git a/generic/tclNRE.h b/generic/tclNRE.h
index 0d13d3a..08ddcd5 100644
--- a/generic/tclNRE.h
+++ b/generic/tclNRE.h
@@ -11,7 +11,7 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* // FIXME: RCS numbering?
- * RCS: @(#) $Id: tclNRE.h,v 1.3 2008/07/18 13:46:46 msofer Exp $
+ * RCS: @(#) $Id: tclNRE.h,v 1.4 2008/07/18 23:29:44 msofer Exp $
*/
@@ -171,6 +171,32 @@ typedef struct TEOV_record {
#define TEBC_DO_EXEC 1 /* MUST NOT be 0 */
#define TEBC_DO_TAILCALL 2
+#define TclNRAddCallback(\
+ interp,\
+ postProcPtr,\
+ data0,\
+ data1,\
+ data2,\
+ data3) \
+ { \
+ TEOV_record *recordPtr; \
+ TEOV_callback *callbackPtr; \
+ \
+ recordPtr = TOP_RECORD(interp); \
+ TclSmallAlloc(sizeof(TEOV_callback), callbackPtr); \
+ \
+ callbackPtr->procPtr = (postProcPtr); \
+ callbackPtr->data[0] = (data0); \
+ callbackPtr->data[1] = (data1); \
+ callbackPtr->data[2] = (data2); \
+ callbackPtr->data[3] = (data3); \
+ \
+ callbackPtr->nextPtr = recordPtr->callbackPtr; \
+ recordPtr->callbackPtr = callbackPtr; \
+ }
+
+
+
/*
* These are only used by TEOV; here for ease of ref. They should move to
* tclBasic.c later on.
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index f541a1e..b7cd491 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,10 +23,11 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.167 2008/07/18 13:46:46 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.168 2008/07/18 23:29:44 msofer Exp $
*/
#include "tclInt.h"
+#include "tclNRE.h"
/*
* Thread-local storage used to avoid having a global lock on data that is not
@@ -3332,7 +3333,7 @@ NamespaceEvalCmd(
* TIP #280: Make invoking context available to eval'd script.
*/
- Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
+ TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
NULL, NULL);
return TclNREvalObjEx(interp, objPtr, 0, iPtr->cmdFramePtr, 3);
}
@@ -3778,7 +3779,7 @@ NamespaceInscopeCmd(
Tcl_DecrRefCount(listPtr); /* We're done with the list object. */
}
- Tcl_NRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
+ TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
NULL, NULL);
return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
}
@@ -6263,7 +6264,7 @@ NsEnsembleImplementationCmdNR(
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = 2;
iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
- Tcl_NRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
NULL);
} else {
register int ni = iPtr->ensembleRewrite.numInsertedObjs;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 7280172..6f078e4 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOO.c,v 1.12 2008/07/18 17:23:56 dkf Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.13 2008/07/18 23:29:44 msofer Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -1358,7 +1358,7 @@ TclNRNewObjectInstance(
* Fire off the constructors non-recursively.
*/
- Tcl_NRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
+ TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
objectPtr);
return TclOOInvokeContext(contextPtr, interp, objc, objv);
}
@@ -2075,7 +2075,7 @@ TclOOObjectCmdCore(
*/
AddRef(oPtr);
- Tcl_NRAddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL);
+ TclNRAddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL);
return TclOOInvokeContext(contextPtr, interp, objc, objv);
}
@@ -2215,7 +2215,7 @@ TclNRObjectContextInvokeNext(
* all) come through the same code.
*/
- Tcl_NRAddCallback(interp, FinalizeNext, contextPtr,
+ TclNRAddCallback(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 cb717ee..2adf547 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOBasic.c,v 1.6 2008/07/18 17:23:57 dkf Exp $
+ * RCS: @(#) $Id: tclOOBasic.c,v 1.7 2008/07/18 23:29:44 msofer Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -32,7 +32,7 @@ static int RestoreFrame(ClientData data[],
*
* AddCreateCallback, FinalizeConstruction --
*
- * Special version of Tcl_NRAddCallback that allows the caller to splice
+ * Special version of TclNRAddCallback 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,
@@ -51,7 +51,7 @@ AddConstructionFinalizer(
{
TEOV_record *recordPtr;
- Tcl_NRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
+ TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
recordPtr = TOP_RECORD(interp);
return (Tcl_Object *) &recordPtr->callbackPtr->data[0];
}
@@ -346,7 +346,7 @@ TclOO_Object_Eval(
* the script completes.
*/
- Tcl_NRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
+ TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
return TclNREvalObjEx(interp, scriptPtr, flags, invoker, skip);
}
@@ -659,7 +659,7 @@ TclOONextObjCmd(
* that this is like [uplevel 1] and not [eval].
*/
- Tcl_NRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
+ TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
iPtr->varFramePtr = framePtr->callerVarPtr;
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 8686ee4..e517d28 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOCall.c,v 1.9 2008/07/18 13:46:46 msofer Exp $
+ * RCS: @(#) $Id: tclOOCall.c,v 1.10 2008/07/18 23:29:44 msofer Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -277,7 +277,7 @@ TclOOInvokeContext(
* this call is finished.
*/
- Tcl_NRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
+ TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
NULL);
}
@@ -286,9 +286,9 @@ TclOOInvokeContext(
*/
if (contextPtr->oPtr->flags & FILTER_HANDLING) {
- Tcl_NRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
+ TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
} else {
- Tcl_NRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
+ TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
}
if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
contextPtr->oPtr->flags |= FILTER_HANDLING;
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 66dfca5..fa7d80e 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -9,11 +9,12 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOInt.h,v 1.4 2008/07/18 17:23:57 dkf Exp $
+ * RCS: @(#) $Id: tclOOInt.h,v 1.5 2008/07/18 23:29:44 msofer Exp $
*/
#include <tclInt.h>
#include "tclOO.h"
+#include "tclNRE.h"
/*
* Forward declarations.
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 7ef07e2..3afe314 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOMethod.c,v 1.7 2008/07/18 13:46:46 msofer Exp $
+ * RCS: @(#) $Id: tclOOMethod.c,v 1.8 2008/07/18 23:29:44 msofer Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -682,7 +682,7 @@ InvokeProcedureMethod(
* Now invoke the body of the method.
*/
- Tcl_NRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
+ TclNRAddCallback(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 7816b5c..ddfb43b 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.147 2008/07/18 13:46:47 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.148 2008/07/18 23:29:45 msofer Exp $
*/
#include "tclInt.h"
@@ -966,7 +966,7 @@ TclNRUplevelObjCmd(
objPtr = Tcl_ConcatObj(objc, objv);
}
- Tcl_NRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
+ TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
NULL);
return TclNREvalObjEx(interp, objPtr, 0, NULL, 0);
}
@@ -1622,7 +1622,7 @@ Tcl_NRBC(
recordPtr->type = TCL_NR_BC_TYPE;
recordPtr->data.codePtr = codePtr;
- Tcl_NRAddCallback(interp, postProcPtr, procNameObj, errorProc, NULL,
+ TclNRAddCallback(interp, postProcPtr, procNameObj, errorProc, NULL,
NULL);
return TCL_OK;
}
generated by cgit v0.12 at 2024-11-15 10:41:50 (GMT)