Minor optimization for Tcl_RecordAndEvalObj

1 files changed, 73 insertions, 13 deletions

diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index 48739ad..0d6af52 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -12,10 +12,28 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclHistory.c,v 1.13 2008/10/26 18:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclHistory.c,v 1.14 2009/12/29 16:58:41 dkf Exp $
  */
 
 #include "tclInt.h"
+
+/*
+ * Type of the assocData structure used to hold the reference to the [history
+ * add] subcommand, used in Tcl_RecordAndEvalObj.
+ */
+
+typedef struct {
+    Tcl_Obj *historyObj;	/* == "::history" */
+    Tcl_Obj *addObj;		/* == "add" */
+} HistoryObjs;
+
+#define HISTORY_OBJS_KEY	"::tcl::HistoryObjs"
+
+/*
+ * Static functions in this file.
+ */
+
+static Tcl_InterpDeleteProc DeleteHistoryObjs;
 
 /*
  *----------------------------------------------------------------------
@@ -113,36 +131,49 @@ Tcl_RecordAndEvalObj(
 				 * current procedure. */
 {
     int result, call = 1;
-    Tcl_Obj *list[3];
-    register Tcl_Obj *objPtr;
     Tcl_CmdInfo info;
+    HistoryObjs *histObjsPtr =
+	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
 
     /*
-     * Do not call [history] if it has been replaced by an empty proc
+     * Create the references to the [::history add] command if necessary.
      */
 
-    result = Tcl_GetCommandInfo(interp, "history", &info);
+    if (histObjsPtr == NULL) {
+	histObjsPtr = (HistoryObjs *) ckalloc(sizeof(HistoryObjs));
+	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
+	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
+	Tcl_IncrRefCount(histObjsPtr->historyObj);
+	Tcl_IncrRefCount(histObjsPtr->addObj);
+	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
+		histObjsPtr);
+    }
+
+    /*
+     * Do not call [history] if it has been replaced by an empty proc
+     */
 
+    result = Tcl_GetCommandInfo(interp, "::history", &info);
     if (result && (info.deleteProc == TclProcDeleteProc)) {
 	Proc *procPtr = (Proc *) info.objClientData;
 	call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
     }
 
     if (call) {
+	Tcl_Obj *list[3];
 
 	/*
 	 * Do recording by eval'ing a tcl history command: history add $cmd. 
 	 */
 
-	TclNewLiteralStringObj(list[0], "history");
-	TclNewLiteralStringObj(list[1], "add");
+	list[0] = histObjsPtr->historyObj;
+	list[1] = histObjsPtr->addObj;
 	list[2] = cmdPtr;
-	
-	objPtr = Tcl_NewListObj(3, list);
-	Tcl_IncrRefCount(objPtr);
-	(void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
-	Tcl_DecrRefCount(objPtr);
-	
+
+	Tcl_IncrRefCount(cmdPtr);
+	(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(cmdPtr);
+
 	/*
 	 * One possible failure mode above: exceeding a resource limit.
 	 */
@@ -164,6 +195,35 @@ Tcl_RecordAndEvalObj(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * DeleteHistoryObjs --
+ *
+ *	Called to delete the references to the constant words used when adding
+ *	to the history.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The constant words may be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteHistoryObjs(
+    ClientData clientData,
+    Tcl_Interp *interp)
+{
+    register HistoryObjs *histObjsPtr = clientData;
+
+    TclDecrRefCount(histObjsPtr->historyObj);
+    TclDecrRefCount(histObjsPtr->addObj);
+    ckfree((char *) histObjsPtr);
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4