diff options
| -rw-r--r-- | generic/tclCmdMZ.c | 122 |
1 files changed, 60 insertions, 62 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 6d6939e..602fca4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -13,7 +13,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.37 2001/05/14 08:57:26 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.38 2001/05/17 02:11:32 hobbs Exp $ */ #include "tclInt.h" @@ -568,10 +568,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) } objPtr = objv[1]; - wstring = Tcl_GetUnicode(objPtr); - wlen = Tcl_GetCharLength(objPtr); - wsubspec = Tcl_GetUnicode(objv[2]); - wsublen = Tcl_GetCharLength(objv[2]); + wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); + wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); varPtr = objv[3]; result = TCL_OK; @@ -1060,6 +1058,12 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) switch ((enum options) index) { case STR_EQUAL: case STR_COMPARE: { + /* + * Remember to keep code here in some sync with the + * byte-compiled versions in tclExecute.c (INST_STR_EQ, + * INST_STR_NEQ and INST_STR_CMP as well as the expr string + * comparison in INST_EQ/INST_NEQ/INST_LT/...). + */ int i, match, length, nocase = 0, reqlength = -1; if (objc < 4 || objc > 7) { @@ -1107,29 +1111,21 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) objv += objc-2; /* - * Use UNICODE versions of string comparisons since that - * won't cause undue type conversions and we can work with - * characters all of a fixed size (much faster.) Also use - * this code for untyped objects, since like that we'll - * pick up many things that are used for comparison in - * scripts and convert them (efficiently) to UNICODE - * strings for comparison, but exclude case where both are - * untyped as that is a little bit aggressive. + * Use binary versions of comparisons since that won't + * cause undue type conversions and it is much faster. + * Only do this if we're case-sensitive (which is all + * that really makes sense with byte arrays anyway, and + * we have no memcasecmp() for some reason... :^) */ - if ((objv[0]->typePtr == &tclStringType || - objv[0]->typePtr == NULL) && - (objv[1]->typePtr == &tclStringType || - objv[1]->typePtr == NULL) && - !(objv[0]->typePtr == NULL && objv[1]->typePtr == NULL)) { - Tcl_UniChar *uni1, *uni2; + if (!nocase && objv[0]->typePtr == &tclByteArrayType && + objv[1]->typePtr == &tclByteArrayType) { + unsigned char *bytes1, *bytes2; - length1 = Tcl_GetCharLength(objv[0]); - length2 = Tcl_GetCharLength(objv[1]); + bytes1 = Tcl_GetByteArrayFromObj(objv[0], &length1); + bytes2 = Tcl_GetByteArrayFromObj(objv[1], &length2); length = (length1 < length2) ? length1 : length2; - uni1 = Tcl_GetUnicode(objv[0]); - uni2 = Tcl_GetUnicode(objv[1]); - if (reqlength > 0 && reqlength < length) { + if ((reqlength > 0) && (reqlength < length)) { length = reqlength; } else if (reqlength < 0) { /* @@ -1137,15 +1133,10 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * setting it to the longer of the two lengths. */ - reqlength = (length1 < length2) ? length2 : length1; - } - - if (nocase) { - match = Tcl_UniCharNcasecmp(uni1, uni2, (unsigned)length); - } else { - match = Tcl_UniCharNcmp(uni1, uni2, (unsigned)length); + reqlength = (length1 > length2) ? length1 : length2; } + match = memcmp(bytes1, bytes2, (unsigned)length); if ((match == 0) && (reqlength > length)) { match = length1 - length2; } @@ -1153,21 +1144,27 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } /* - * Use binary versions of comparisons since that won't - * cause undue type conversions and it is much faster. - * Only do this if we're case-sensitive (which is all - * that really makes sense with byte arrays anyway, and - * we have no memcasecmp() for some reason... :^) + * Use UNICODE versions of string comparisons since that + * won't cause undue type conversions and we can work with + * characters all of a fixed size (much faster.) Also use + * this code for untyped objects, since like that we'll + * pick up many things that are used for comparison in + * scripts and convert them (efficiently) to UNICODE + * strings for comparison, but exclude case where both are + * untyped as that is a little bit aggressive. */ - if (objv[0]->typePtr == &tclByteArrayType && - objv[1]->typePtr == &tclByteArrayType && !nocase) { - unsigned char *bytes1, *bytes2; + if ((objv[0]->typePtr == &tclStringType || + objv[0]->typePtr == NULL) && + (objv[1]->typePtr == &tclStringType || + objv[1]->typePtr == NULL) && + !(objv[0]->typePtr == NULL && objv[1]->typePtr == NULL)) { + Tcl_UniChar *uni1, *uni2; - bytes1 = Tcl_GetByteArrayFromObj(objv[0], &length1); - bytes2 = Tcl_GetByteArrayFromObj(objv[1], &length2); + uni1 = Tcl_GetUnicodeFromObj(objv[0], &length1); + uni2 = Tcl_GetUnicodeFromObj(objv[1], &length2); length = (length1 < length2) ? length1 : length2; - if ((reqlength > 0) && (reqlength < length)) { + if (reqlength > 0 && reqlength < length) { length = reqlength; } else if (reqlength < 0) { /* @@ -1175,10 +1172,15 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * setting it to the longer of the two lengths. */ - reqlength = (length1 > length2) ? length1 : length2; + reqlength = (length1 < length2) ? length2 : length1; + } + + if (nocase) { + match = Tcl_UniCharNcasecmp(uni1, uni2, (unsigned)length); + } else { + match = Tcl_UniCharNcmp(uni1, uni2, (unsigned)length); } - match = memcmp(bytes1, bytes2, (unsigned)length); if ((match == 0) && (reqlength > length)) { match = length1 - length2; } @@ -1247,10 +1249,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) start = 0; length2 = -1; - ustring1 = Tcl_GetUnicode(objv[2]); - length1 = Tcl_GetCharLength(objv[2]); - ustring2 = Tcl_GetUnicode(objv[3]); - length2 = Tcl_GetCharLength(objv[3]); + ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1); + ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2); if (objc == 5) { /* @@ -1643,10 +1643,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) start = 0; length2 = -1; - ustring1 = Tcl_GetUnicode(objv[2]); - length1 = Tcl_GetCharLength(objv[2]); - ustring2 = Tcl_GetUnicode(objv[3]); - length2 = Tcl_GetCharLength(objv[3]); + ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1); + ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2); if (objc == 5) { /* @@ -1756,8 +1754,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } objc--; - ustring1 = Tcl_GetUnicode(objv[objc]); - length1 = Tcl_GetCharLength(objv[objc]); + ustring1 = Tcl_GetUnicodeFromObj(objv[objc], &length1); if (length1 == 0) { /* * Empty input string, just stop now @@ -1780,10 +1777,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * algorithm is otherwise identical to the multi-pair case. * This will be >30% faster on larger strings. */ - Tcl_UniChar *mapString = Tcl_GetUnicode(mapElemv[1]); - int mapLen = Tcl_GetCharLength(mapElemv[1]); - ustring2 = Tcl_GetUnicode(mapElemv[0]); - length2 = Tcl_GetCharLength(mapElemv[0]); + int mapLen; + Tcl_UniChar *mapString; + + ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); + mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); for (p = ustring1; ustring1 < end; ustring1++) { if ((length2 > 0) && (nocase || (*ustring1 == *ustring2)) && @@ -1813,8 +1811,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * significantly speeding up the algorithm. */ for (index = 0; index < mapElemc; index++) { - mapStrings[index] = Tcl_GetUnicode(mapElemv[index]); - mapLens[index] = Tcl_GetCharLength(mapElemv[index]); + mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], + &(mapLens[index])); } for (p = ustring1; ustring1 < end; ustring1++) { for (index = 0; index < mapElemc; index += 2) { @@ -1973,8 +1971,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - ustring1 = Tcl_GetUnicode(objv[2]); - length1 = Tcl_GetCharLength(objv[2]) - 1; + ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1); + length1--; if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK) || (TclGetIntForIndex(interp, objv[4], length1, |