summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCmdMZ.c122
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,