From 05ee62d96f55adfce2725b9746b6c8b0557989ee Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Fri, 18 Jul 2008 23:29:41 +0000
Subject: new TclNRAddCallback macro for internal use instead of the public
 Tcl_NRAddCallback

---
 ChangeLog             | 16 ++++++++++++++++
 generic/tclBasic.c    | 32 +++++++++-----------------------
 generic/tclDictObj.c  |  7 ++++---
 generic/tclExecute.c  |  4 ++--
 generic/tclInterp.c   |  5 +++--
 generic/tclNRE.h      | 28 +++++++++++++++++++++++++++-
 generic/tclNamesp.c   |  9 +++++----
 generic/tclOO.c       |  8 ++++----
 generic/tclOOBasic.c  | 10 +++++-----
 generic/tclOOCall.c   |  8 ++++----
 generic/tclOOInt.h    |  3 ++-
 generic/tclOOMethod.c |  4 ++--
 generic/tclProc.c     |  6 +++---
 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;
 }
-- 
cgit v0.12