From aa371355b1d31208dd1e1c3b5cae011d33a62290 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 30 Mar 2020 11:37:54 +0000
Subject: Optimize TclStringFirst/TclStringLast: Let it return a Tcl_Obj * in
stead of an int, so its callers don't need to do the conversion any more.
---
generic/tclCmdMZ.c | 6 ++--
generic/tclExecute.c | 10 +++---
generic/tclInt.h | 8 ++---
generic/tclStringObj.c | 98 +++++++++++++++++++++++++++-----------------------
4 files changed, 63 insertions(+), 59 deletions(-)
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 03f9823..dcdc266 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1337,8 +1337,7 @@ StringFirstCmd(
return TCL_ERROR;
}
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclStringFirst(objv[1],
- objv[2], start)));
+ Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
return TCL_OK;
}
@@ -1382,8 +1381,7 @@ StringLastCmd(
return TCL_ERROR;
}
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclStringLast(objv[1],
- objv[2], last)));
+ Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));
return TCL_OK;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 69ddfab..5708772 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5522,19 +5522,17 @@ TEBCresume(
NEXT_INST_V(1, 3, 1);
case INST_STR_FIND:
- match = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
+ objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
TRACE(("%.20s %.20s => %d\n",
- O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
- TclNewIntObj(objResultPtr, match);
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_STR_FIND_LAST:
- match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
+ objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
TRACE(("%.20s %.20s => %d\n",
- O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
- TclNewIntObj(objResultPtr, match);
+ O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_STR_CLASS:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index be6f26e..49a72de 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4075,9 +4075,9 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[], int flags);
-MODULE_SCOPE int TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
+MODULE_SCOPE Tcl_Obj * TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
int start);
-MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
+MODULE_SCOPE Tcl_Obj * TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
int last);
MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
int count, int flags);
@@ -4817,13 +4817,13 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#ifndef TCL_MEM_DEBUG
-#define TclNewIntObj(objPtr, i) \
+#define TclNewIntObj(objPtr, w) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
- (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
+ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
(objPtr)->typePtr = &tclIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index cb2a773..c6d5323 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3544,13 +3544,16 @@ TclStringCmp(
*---------------------------------------------------------------------------
*/
-int
+Tcl_Obj *
TclStringFirst(
Tcl_Obj *needle,
Tcl_Obj *haystack,
int start)
{
int lh, ln = Tcl_GetCharLength(needle);
+ Tcl_Obj *result;
+ int value = -1;
+ Tcl_UniChar *check, *end, *uh, *un;
if (start < 0) {
start = 0;
@@ -3559,7 +3562,7 @@ TclStringFirst(
/* We don't find empty substrings. Bizarre!
* Whenever this routine is turned into a proper substring
* finder, change to `return start` after limits imposed. */
- return -1;
+ goto firstEnd;
}
if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
@@ -3570,7 +3573,7 @@ TclStringFirst(
bh = Tcl_GetByteArrayFromObj(haystack, &lh);
if ((lh < ln) || (start > lh - ln)) {
/* Don't start the loop if there cannot be a valid answer */
- return -1;
+ goto firstEnd;
}
end = bh + lh;
@@ -3584,17 +3587,18 @@ TclStringFirst(
check = (unsigned char *)memchr(check, bn[0], (end + 1 - ln) - check);
if (check == NULL) {
/* Leading byte not found -> needle cannot be found. */
- return -1;
+ goto firstEnd;
}
/* Leading byte found, check rest of needle. */
if (0 == memcmp(check+1, bn+1, ln-1)) {
/* Checks! Return the successful index. */
- return (check - bh);
+ value = (check - bh);
+ goto firstEnd;
}
/* Rest of needle match failed; Iterate to continue search. */
check++;
}
- return -1;
+ goto firstEnd;
}
/*
@@ -3609,25 +3613,24 @@ TclStringFirst(
* do only the well-defined Tcl_UniChar array search.
*/
- {
- Tcl_UniChar *check, *end, *uh;
- Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
-
- uh = Tcl_GetUnicodeFromObj(haystack, &lh);
- if ((lh < ln) || (start > lh - ln)) {
- /* Don't start the loop if there cannot be a valid answer */
- return -1;
- }
- end = uh + lh;
+ un = Tcl_GetUnicodeFromObj(needle, &ln);
+ uh = Tcl_GetUnicodeFromObj(haystack, &lh);
+ if ((lh < ln) || (start > lh - ln)) {
+ /* Don't start the loop if there cannot be a valid answer */
+ goto firstEnd;
+ }
+ end = uh + lh;
- for (check = uh + start; check + ln <= end; check++) {
- if ((*check == *un) && (0 ==
- memcmp(check + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
- return (check - uh);
- }
+ for (check = uh + start; check + ln <= end; check++) {
+ if ((*check == *un) && (0 ==
+ memcmp(check + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
+ value = (check - uh);
+ goto firstEnd;
}
- return -1;
}
+ firstEnd:
+ TclNewIntObj(result, value);
+ return result;
}
/*
@@ -3648,13 +3651,16 @@ TclStringFirst(
*---------------------------------------------------------------------------
*/
-int
+Tcl_Obj *
TclStringLast(
Tcl_Obj *needle,
Tcl_Obj *haystack,
int last)
{
int lh, ln = Tcl_GetCharLength(needle);
+ Tcl_Obj *result;
+ int value = -1;
+ Tcl_UniChar *check, *uh, *un;
if (ln == 0) {
/*
@@ -3663,7 +3669,7 @@ TclStringLast(
* TODO: When we one day make this a true substring
* finder, change this to "return last", after limitation.
*/
- return -1;
+ goto lastEnd;
}
if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
@@ -3675,41 +3681,43 @@ TclStringLast(
}
if (last + 1 < ln) {
/* Don't start the loop if there cannot be a valid answer */
- return -1;
+ goto lastEnd;
}
check = bh + last + 1 - ln;
while (check >= bh) {
if ((*check == bn[0])
&& (0 == memcmp(check+1, bn+1, ln-1))) {
- return (check - bh);
+ value = (check - bh);
+ goto lastEnd;
}
check--;
}
- return -1;
+ goto lastEnd;
}
- {
- Tcl_UniChar *check, *uh = Tcl_GetUnicodeFromObj(haystack, &lh);
- Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
+ uh = Tcl_GetUnicodeFromObj(haystack, &lh);
+ un = Tcl_GetUnicodeFromObj(needle, &ln);
- if (last >= lh) {
- last = lh - 1;
- }
- if (last + 1 < ln) {
- /* Don't start the loop if there cannot be a valid answer */
- return -1;
- }
- check = uh + last + 1 - ln;
- while (check >= uh) {
- if ((*check == un[0])
- && (0 == memcmp(check+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
- return (check - uh);
- }
- check--;
+ if (last >= lh) {
+ last = lh - 1;
+ }
+ if (last + 1 < ln) {
+ /* Don't start the loop if there cannot be a valid answer */
+ goto lastEnd;
+ }
+ check = uh + last + 1 - ln;
+ while (check >= uh) {
+ if ((*check == un[0])
+ && (0 == memcmp(check+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
+ value = (check - uh);
+ goto lastEnd;
}
- return -1;
+ check--;
}
+ lastEnd:
+ TclNewIntObj(result, value);
+ return result;
}
/*
--
cgit v0.12