From 02457f7d6507f76fac8b308899e6592ab8214cb3 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 12 Jul 2009 18:04:33 +0000 Subject: Fix [Bug 2637173] by consolidating bytearray purity check. --- ChangeLog | 6 ++++++ generic/tclCmdMZ.c | 12 ++++++------ generic/tclExecute.c | 10 +++++----- generic/tclInt.h | 26 +++++++++++++++++++++++++- generic/tclStringObj.c | 23 +++++------------------ generic/tclUtil.c | 12 ++++++------ 6 files changed, 53 insertions(+), 36 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4ba0279..ae48b2e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,11 @@ 2009-07-12 Donal K. Fellows + * generic/tclCmdMZ.c (StringIndexCmd, StringEqualCmd, StringCmpCmd): + * generic/tclExecute.c (TclExecuteByteCode): [Bug 2637173]: Factor out + * generic/tclInt.h (TclIsPureByteArray): the code to determine if + * generic/tclUtil.c (TclStringMatchObj): it is safe to work with + byte arrays directly, so that we get the check correct _once_. + * generic/tclOOCall.c (TclOOGetCallContext): [Bug 1895546]: Changed * generic/tclOO.c (TclOOObjectCmdCore): the way that the cache is managed so that when itcl does cunning things, those cunning things diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index bb0d3bd..2021b5b 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.183 2009/05/06 20:16:17 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.184 2009/07/12 18:04:33 dkf Exp $ */ #include "tclInt.h" @@ -1369,7 +1369,7 @@ StringIndexCmd( * bytearray for a result. */ - if (objv[1]->typePtr == &tclByteArrayType) { + if (TclIsPureByteArray(objv[1])) { unsigned char uch = (unsigned char) ch; Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1)); @@ -2490,8 +2490,8 @@ StringEqualCmd( return TCL_OK; } - if (!nocase && objv[0]->typePtr == &tclByteArrayType && - objv[1]->typePtr == &tclByteArrayType) { + if (!nocase && TclIsPureByteArray(objv[0]) && + TclIsPureByteArray(objv[1])) { /* * Use binary versions of comparisons since that won't cause undue * type conversions and it is much faster. Only do this if we're @@ -2637,8 +2637,8 @@ StringCmpCmd( return TCL_OK; } - if (!nocase && objv[0]->typePtr == &tclByteArrayType && - objv[1]->typePtr == &tclByteArrayType) { + if (!nocase && TclIsPureByteArray(objv[0]) && + TclIsPureByteArray(objv[1])) { /* * Use binary versions of comparisons since that won't cause undue * type conversions and it is much faster. Only do this if we're diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6c89523..aac36da 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.439 2009/06/03 23:12:11 das Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.440 2009/07/12 18:04:33 dkf Exp $ */ #include "tclInt.h" @@ -4516,8 +4516,8 @@ TclExecuteByteCode( */ iResult = s1len = s2len = 0; - } else if ((valuePtr->typePtr == &tclByteArrayType) - && (value2Ptr->typePtr == &tclByteArrayType)) { + } else if (TclIsPureByteArray(valuePtr) + && TclIsPureByteArray(value2Ptr)) { s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); iResult = memcmp(s1, s2, @@ -4635,7 +4635,7 @@ TclExecuteByteCode( } if ((index >= 0) && (index < length)) { - if (valuePtr->typePtr == &tclByteArrayType) { + if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1); } else if (valuePtr->bytes && length == valuePtr->length) { @@ -4687,7 +4687,7 @@ TclExecuteByteCode( ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); match = TclUniCharMatch(ustring1, length1, ustring2, length2, nocase); - } else if ((valuePtr->typePtr == &tclByteArrayType) && !nocase) { + } else if (TclIsPureByteArray(valuePtr) && !nocase) { unsigned char *string1, *string2; int length1, length2; diff --git a/generic/tclInt.h b/generic/tclInt.h index 42915e0..007facd 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.426 2009/06/30 14:21:43 das Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.427 2009/07/12 18:04:33 dkf Exp $ */ #ifndef _TCLINT @@ -236,8 +236,15 @@ typedef struct Namespace { struct Namespace *parentPtr;/* Points to the namespace that contains this * one. NULL if this is the global * namespace. */ +#if 1 Tcl_HashTable childTable; /* Contains any child namespaces. Indexed by * strings; values have type (Namespace *). */ +#else + Tcl_HashTable *childTablePtr; + /* Contains any child namespaces. Indexed by + * strings; values have type (Namespace *). If + * NULL, there are no children. */ +#endif long nsId; /* Unique id for the namespace. */ Tcl_Interp *interp; /* The interpreter containing this * namespace. */ @@ -3847,6 +3854,23 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (numChars) = count; \ } while (0); +/* + *---------------------------------------------------------------- + * Macro that encapsulates the logic that determines when it is safe to + * interpret a string as a byte array directly. In summary, the object must be + * a byte array and must not have a string representation (as the operations + * that it is used in are defined on strings, not byte arrays). Theoretically + * it is possible to also be efficient in the case where the object's bytes + * field is filled by generation from the byte array (c.f. list canonicality) + * but we don't do that at the moment since this is purely about efficiency. + * The ANSI C "prototype" for this macro is: + * + * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); + *---------------------------------------------------------------- + */ + +#define TclIsPureByteArray(objPtr) \ + (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL)) /* *---------------------------------------------------------------- diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 09ac25a..7804e1f 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.126 2009/07/01 15:06:06 patthoyts Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.127 2009/07/12 18:04:33 dkf Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -144,19 +144,6 @@ typedef struct String { ((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr)) /* - * Macro that encapsulates the logic that determines when it is safe to - * interpret a string as a byte array directly. In summary, the object must be - * a byte array and must not have a string representation (as the operations - * that it is used in are defined on strings, not byte arrays). Theoretically - * it is possible to also be efficient in the case where the object's bytes - * field is filled by generation from the byte array (c.f. list canonicality) - * but we don't do that at the moment since this is purely about efficiency. - */ - -#define IS_PURE_BYTE_ARRAY(objPtr) \ - (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL)) - -/* * TCL STRING GROWTH ALGORITHM * * When growing strings (during an append, for example), the following growth @@ -472,7 +459,7 @@ Tcl_GetCharLength( * perform the get-length operation. */ - if (IS_PURE_BYTE_ARRAY(objPtr)) { + if (TclIsPureByteArray(objPtr)) { int length; (void) Tcl_GetByteArrayFromObj(objPtr, &length); @@ -538,7 +525,7 @@ Tcl_GetUniChar( * perform the indexing operation. */ - if (IS_PURE_BYTE_ARRAY(objPtr)) { + if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); return (Tcl_UniChar) bytes[index]; @@ -669,7 +656,7 @@ Tcl_GetRange( * perform the substring operation. */ - if (IS_PURE_BYTE_ARRAY(objPtr)) { + if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); return Tcl_NewByteArrayObj(bytes+first, last-first+1); @@ -1247,7 +1234,7 @@ Tcl_AppendObjToObj( * information; this is a special-case optimization only. */ - if (IS_PURE_BYTE_ARRAY(objPtr) && IS_PURE_BYTE_ARRAY(appendObjPtr)) { + if (TclIsPureByteArray(objPtr) && TclIsPureByteArray(appendObjPtr)) { unsigned char *bytesDst, *bytesSrc; int lengthSrc, lengthTotal; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 881edca..862470f 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.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: tclUtil.c,v 1.110 2009/02/25 19:59:52 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.111 2009/07/12 18:04:33 dkf Exp $ */ #include "tclInt.h" @@ -1747,9 +1747,10 @@ TclByteArrayMatch( int TclStringMatchObj( - Tcl_Obj *strObj, /* string object. */ - Tcl_Obj *ptnObj, /* pattern object. */ - int flags) /* Only TCL_MATCH_NOCASE should be passed or 0. */ + Tcl_Obj *strObj, /* string object. */ + Tcl_Obj *ptnObj, /* pattern object. */ + int flags) /* Only TCL_MATCH_NOCASE should be passed, or + * 0. */ { int match, length, plen; @@ -1766,8 +1767,7 @@ TclStringMatchObj( udata = Tcl_GetUnicodeFromObj(strObj, &length); uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); - } else if ((strObj->typePtr == &tclByteArrayType) - && (strObj->bytes == NULL) && !flags) { + } else if (TclIsPureByteArray(strObj) && !flags) { unsigned char *data, *ptn; data = Tcl_GetByteArrayFromObj(strObj, &length); -- cgit v0.12