From 3c73dfe8f910b0af223198e6f8196f6bc52124f6 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 17 Sep 2007 10:43:58 +0000 Subject: Generate literal values more efficiently using TclNewLiteralStringObj macro. --- ChangeLog | 8 ++++++ generic/tclEvent.c | 7 ++++-- generic/tclFCmd.c | 18 +++++++------- generic/tclNamesp.c | 12 ++++----- generic/tclTrace.c | 70 ++++++++++++++++++++++++++--------------------------- 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 + + * 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 * 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); -- cgit v0.12