From 4dbb6d9db471aad324a4f71344df2306e988e48b Mon Sep 17 00:00:00 2001 From: hobbs Date: Wed, 22 Sep 2010 00:57:10 +0000 Subject: * generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect): * generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys): * generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths): * generic/tclExecute.c (TclExecuteByteCode): * generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt * generic/tclResult.c (TclMergeReturnOptions): use memcmp where applicable as possible speedup on some libc variants. --- ChangeLog | 10 ++++++++++ generic/tclExecute.c | 9 ++++----- generic/tclIOUtil.c | 4 ++-- generic/tclOOMethod.c | 14 +++++++++----- generic/tclPathObj.c | 22 +++++++++++++--------- generic/tclResult.c | 4 ++-- generic/tclVar.c | 30 ++++++++++-------------------- 7 files changed, 50 insertions(+), 43 deletions(-) diff --git a/ChangeLog b/ChangeLog index 161c59f..1331bce 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2010-09-21 Jeff Hobbs + + * generic/tclExecute.c (TclExecuteByteCode): + * generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect): + * generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys): + * generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths): + * generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt + * generic/tclResult.c (TclMergeReturnOptions): use memcmp where + applicable as possible speedup on some libc variants. + 2010-09-21 Jan Nijtmans * win/tclWinFile.c: Fix declaration after statement. diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6a4b495..71999d2 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.494 2010/09/01 20:35:33 andreas_kupries Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.495 2010/09/22 00:57:11 hobbs Exp $ */ #include "tclInt.h" @@ -4454,7 +4454,6 @@ TclExecuteByteCode( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - /* TODO: Consider more efficient tests than strcmp() */ s1 = TclGetStringFromObj(valuePtr, &s1len); if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr), @@ -4479,7 +4478,7 @@ TclExecuteByteCode( s2len = 0; } if (s1len == s2len) { - match = (strcmp(s1, s2) == 0); + match = (memcmp(s1, s2, s1len) == 0); } i++; } while (i < length && match == 0); @@ -4545,10 +4544,10 @@ TclExecuteByteCode( */ if (*pc == INST_STR_NEQ) { - match = (strcmp(s1, s2) != 0); + match = (memcmp(s1, s2, s1len) != 0); } else { /* INST_STR_EQ */ - match = (strcmp(s1, s2) == 0); + match = (memcmp(s1, s2, s1len) == 0); } } else { match = (*pc == INST_STR_NEQ); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 234e973..6683ff9 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.177 2010/08/14 17:13:02 nijtmans Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.178 2010/09/22 00:57:11 hobbs Exp $ */ #include "tclInt.h" @@ -506,7 +506,7 @@ TclFSCwdPointerEquals( str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2); - if (len1 == len2 && !strcmp(str1,str2)) { + if ((len1 == len2) && !memcmp(str1, str2, len1)) { /* * They are equal, but different objects. Update so they will be * the same object in the future. diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 9f5be6b..3b9e700 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.26 2010/03/24 13:21:11 dkf Exp $ + * RCS: @(#) $Id: tclOOMethod.c,v 1.27 2010/09/22 00:57:11 hobbs Exp $ */ #ifdef HAVE_CONFIG_H @@ -994,8 +994,10 @@ ProcedureMethodCompiledVarConnect( CallContext *contextPtr; Tcl_Obj *variableObj; Tcl_HashEntry *hPtr; - int i, isNew, cacheIt; - const char *varName = Tcl_GetString(infoPtr->variableObj); + int i, isNew, cacheIt, varLen, len; + const char *match, *varName; + + varName = TclGetStringFromObj(infoPtr->variableObj, &varLen); /* * Check that the variable is being requested in a context that is also a @@ -1027,14 +1029,16 @@ ProcedureMethodCompiledVarConnect( .mPtr->declaringClassPtr != NULL) { FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->variables) { - if (!strcmp(Tcl_GetString(variableObj), varName)) { + match = TclGetStringFromObj(variableObj, &len); + if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 0; goto gotMatch; } } } else { FOREACH(variableObj, contextPtr->oPtr->variables) { - if (!strcmp(Tcl_GetString(variableObj), varName)) { + match = TclGetStringFromObj(variableObj, &len); + if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 1; goto gotMatch; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 152ffde..fd4651f 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPathObj.c,v 1.88 2010/03/05 14:34:04 dkf Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.89 2010/09/22 00:57:11 hobbs Exp $ */ #include "tclInt.h" @@ -2028,8 +2028,12 @@ Tcl_FSGetNormalizedPath( */ if (pureNormalized) { - if (!strcmp(TclGetString(fsPathPtr->normPathPtr), - TclGetString(pathPtr))) { + int normPathLen, pathLen; + const char *normPath; + + path = TclGetStringFromObj(pathPtr, &pathLen); + normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen); + if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) { /* * The path was already normalized. Get rid of the duplicate. */ @@ -2301,9 +2305,9 @@ Tcl_FSEqualPaths( if (firstPtr == NULL || secondPtr == NULL) { return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { return 1; } @@ -2321,9 +2325,9 @@ Tcl_FSEqualPaths( return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0); + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); } /* diff --git a/generic/tclResult.c b/generic/tclResult.c index 07b50db..18aae6c 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.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: tclResult.c,v 1.61 2010/04/05 19:44:45 ferrieux Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.62 2010/09/22 00:57:11 hobbs Exp $ */ #include "tclInt.h" @@ -1378,7 +1378,7 @@ TclMergeReturnOptions( const char *compare = TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen); - if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) { + if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) { Tcl_DictSearch search; int done = 0; Tcl_Obj *keyPtr; diff --git a/generic/tclVar.c b/generic/tclVar.c index ee4e84f..9cc2ec6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.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: tclVar.c,v 1.203 2010/09/01 20:35:33 andreas_kupries Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.204 2010/09/22 00:57:11 hobbs Exp $ */ #include "tclInt.h" @@ -880,8 +880,8 @@ TclLookupSimpleVar( * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - int isNew, i, result; - const char *varName = TclGetString(varNamePtr); + int isNew, i, result, varLen; + const char *varName = TclGetStringFromObj(varNamePtr, &varLen); varPtr = NULL; varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */ @@ -1006,17 +1006,18 @@ TclLookupSimpleVar( } } } else { /* Local var: look in frame varFramePtr. */ - int localCt = varFramePtr->numCompiledLocals; + int localLen, localCt = varFramePtr->numCompiledLocals; Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; + const char *localNameStr; for (i=0 ; icompiledLocals[i]; } @@ -6428,21 +6429,10 @@ CompareVarKeys( l2 = objPtr2->length; /* - * Only compare if the string representations are of the same length. + * Only compare string representations of the same length. */ - if (l1 == l2) { - for (;; p1++, p2++, l1--) { - if (*p1 != *p2) { - break; - } - if (l1 == 0) { - return 1; - } - } - } - - return 0; + return ((l1 == l2) && !memcmp(p1, p2, l1)); } /* -- cgit v0.12