summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclEvent.c7
-rw-r--r--generic/tclFCmd.c18
-rw-r--r--generic/tclNamesp.c12
-rw-r--r--generic/tclTrace.c70
5 files changed, 62 insertions, 53 deletions
diff --git a/ChangeLog b/ChangeLog
index a2dd5ea..6eb3506 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-09-17 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclTrace.c (Tcl_TraceObjCmd, TraceExecutionObjCmd)
+ (TraceCommandObjCmd, TraceVariableObjCmd): Generate literal values
+ * generic/tclNamesp.c (NamespaceCodeCmd): more efficiently using
+ * generic/tclFCmd.c (CopyRenameOneFile): TclNewLiteralStringObj
+ * generic/tclEvent.c (TclSetBgErrorHandler): macro.
+
2007-09-15 Daniel Steffen <das@users.sourceforge.net>
* unix/tcl.m4: replace all direct references to compiler by ${CC} to
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index e9619bc..198f27c 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.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: tclEvent.c,v 1.76 2007/09/07 18:11:24 dgp Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.77 2007/09/17 10:44:04 dkf Exp $
*/
#include "tclInt.h"
@@ -521,7 +521,10 @@ TclGetBgErrorHandler(
Tcl_GetAssocData(interp, "tclBgError", NULL);
if (assocPtr == NULL) {
- TclSetBgErrorHandler(interp, Tcl_NewStringObj("::tcl::Bgerror", -1));
+ Tcl_Obj *bgerrorObj;
+
+ TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
+ TclSetBgErrorHandler(interp, bgerrorObj);
assocPtr = (ErrAssocData *)
Tcl_GetAssocData(interp, "tclBgError", NULL);
}
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index a9c1613..0d6db51 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.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: tclFCmd.c,v 1.41 2007/06/28 21:10:38 patthoyts Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.42 2007/09/17 10:44:04 dkf Exp $
*/
#include "tclInt.h"
@@ -694,20 +694,20 @@ CopyRenameOneFile(
* cross-filesystem copy. We do this through our Tcl library.
*/
- Tcl_Obj *copyCommand = Tcl_NewListObj(0, NULL);
+ Tcl_Obj *copyCommand, *cmdObj, *opObj;
- Tcl_IncrRefCount(copyCommand);
- Tcl_ListObjAppendElement(interp, copyCommand,
- Tcl_NewStringObj("::tcl::CopyDirectory",-1));
+ TclNewObj(copyCommand);
+ TclNewLiteralStringObj(cmdObj, "::tcl::CopyDirectory");
+ Tcl_ListObjAppendElement(interp, copyCommand, cmdObj);
if (copyFlag) {
- Tcl_ListObjAppendElement(interp, copyCommand,
- Tcl_NewStringObj("copying",-1));
+ TclNewLiteralStringObj(opObj, "copying");
} else {
- Tcl_ListObjAppendElement(interp, copyCommand,
- Tcl_NewStringObj("renaming",-1));
+ TclNewLiteralStringObj(opObj, "renaming");
}
+ Tcl_ListObjAppendElement(interp, copyCommand, opObj);
Tcl_ListObjAppendElement(interp, copyCommand, source);
Tcl_ListObjAppendElement(interp, copyCommand, target);
+ Tcl_IncrRefCount(copyCommand);
result = Tcl_EvalObjEx(interp, copyCommand,
TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
Tcl_DecrRefCount(copyCommand);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 41b93d0..65a6952 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* 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.149 2007/09/09 19:28:31 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.150 2007/09/17 10:44:04 dkf Exp $
*/
#include "tclInt.h"
@@ -3026,11 +3026,11 @@ NamespaceCodeCmd(
* "namespace inscope" command.
*/
- listPtr = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj("::namespace", -1));
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj("inscope", -1));
+ TclNewObj(listPtr);
+ TclNewLiteralStringObj(objPtr, "::namespace");
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+ TclNewLiteralStringObj(objPtr, "inscope");
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 6ee7798..c67515f 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTrace.c,v 1.44 2007/07/31 17:03:39 msofer Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.45 2007/09/17 10:44:05 dkf Exp $
*/
#include "tclInt.h"
@@ -270,30 +270,29 @@ Tcl_TraceObjCmd(
goto badVarOps;
}
for (p = flagOps; *p != 0; p++) {
+ Tcl_Obj *opObj;
+
if (*p == 'r') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("read", -1));
+ TclNewLiteralStringObj(opObj, "read");
} else if (*p == 'w') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("write", -1));
+ TclNewLiteralStringObj(opObj, "write");
} else if (*p == 'u') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("unset", -1));
+ TclNewLiteralStringObj(opObj, "unset");
} else if (*p == 'a') {
- Tcl_ListObjAppendElement(NULL, opsList,
- Tcl_NewStringObj("array", -1));
+ TclNewLiteralStringObj(opObj, "array");
} else {
Tcl_DecrRefCount(opsList);
goto badVarOps;
}
+ Tcl_ListObjAppendElement(NULL, opsList, opObj);
}
copyObjv[0] = NULL;
memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *));
copyObjv[4] = opsList;
if (optionIndex == TRACE_OLD_VARIABLE) {
- code = (traceSubCmds[2])(interp,TRACE_ADD,objc+1,copyObjv);
+ code = (traceSubCmds[2])(interp, TRACE_ADD, objc+1, copyObjv);
} else {
- code = (traceSubCmds[2])(interp,TRACE_REMOVE,objc+1,copyObjv);
+ code = (traceSubCmds[2])(interp, TRACE_REMOVE, objc+1, copyObjv);
}
Tcl_DecrRefCount(opsList);
return code;
@@ -567,7 +566,7 @@ TraceExecutionObjCmd(
while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
TraceCommandProc, clientData)) != NULL) {
int numOps = 0;
-
+ Tcl_Obj *opObj;
TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
/*
@@ -579,20 +578,20 @@ TraceExecutionObjCmd(
elemObjPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(elemObjPtr);
if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("enter",5));
+ TclNewLiteralStringObj(opObj, "enter");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("leave",5));
+ TclNewLiteralStringObj(opObj, "leave");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("enterstep",9));
+ TclNewLiteralStringObj(opObj, "enterstep");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("leavestep",9));
+ TclNewLiteralStringObj(opObj, "leavestep");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
@@ -606,8 +605,7 @@ TraceExecutionObjCmd(
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr,
Tcl_NewStringObj(tcmdPtr->command, -1));
- Tcl_ListObjAppendElement(interp, resultListPtr,
- eachTraceObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, eachTraceObjPtr);
}
Tcl_SetObjResult(interp, resultListPtr);
break;
@@ -775,7 +773,7 @@ TraceCommandObjCmd(
while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
TraceCommandProc, clientData)) != NULL) {
int numOps = 0;
-
+ Tcl_Obj *opObj;
TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
/*
@@ -787,12 +785,12 @@ TraceCommandObjCmd(
elemObjPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(elemObjPtr);
if (tcmdPtr->flags & TCL_TRACE_RENAME) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("rename",6));
+ TclNewLiteralStringObj(opObj, "rename");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tcmdPtr->flags & TCL_TRACE_DELETE) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("delete",6));
+ TclNewLiteralStringObj(opObj, "delete");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
@@ -961,7 +959,7 @@ TraceVariableObjCmd(
name = Tcl_GetString(objv[3]);
while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc,
clientData)) != 0) {
-
+ Tcl_Obj *opObj;
TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
/*
@@ -972,20 +970,20 @@ TraceVariableObjCmd(
elemObjPtr = Tcl_NewListObj(0, NULL);
if (tvarPtr->flags & TCL_TRACE_ARRAY) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("array", 5));
+ TclNewLiteralStringObj(opObj, "array");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tvarPtr->flags & TCL_TRACE_READS) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("read", 4));
+ TclNewLiteralStringObj(opObj, "read");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tvarPtr->flags & TCL_TRACE_WRITES) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("write", 5));
+ TclNewLiteralStringObj(opObj, "write");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
if (tvarPtr->flags & TCL_TRACE_UNSETS) {
- Tcl_ListObjAppendElement(NULL, elemObjPtr,
- Tcl_NewStringObj("unset", 5));
+ TclNewLiteralStringObj(opObj, "unset");
+ Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);