summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclHistory.c86
2 files changed, 79 insertions, 15 deletions
diff --git a/ChangeLog b/ChangeLog
index 2b51700..280603b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2009-12-29 Donal K. Fellows <dkf@users.sf.net>
+ * generic/tclHistory.c (Tcl_RecordAndEvalObj): Reduce the amount
+ of allocation and deallocation of memory by caching objects in the
+ interpreter assocData table.
+
* generic/tclObj.c (Tcl_GetCommandFromObj): Rewrite the logic so
that it does not require making assignments part way through an
'if' condition, which was deeply unclear.
@@ -9,8 +13,8 @@
2009-12-29 Pat Thoyts <patthoyts@users.sourceforge.net>
- * generic/tclBinary.c: Handle completely invalid input to the decode
- * tests/binary.test: methods [Bug 2922555].
+ * generic/tclBinary.c: [Bug 2922555]: Handle completely invalid input
+ * tests/binary.test: to the decode methods.
2009-12-28 Donal K. Fellows <dkf@users.sf.net>
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