From ec332750d28a86537a3fc721decc3bb74d850dc9 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 27 Oct 2016 19:39:49 +0000 Subject: Start bringing all `string cat` operations into one place so it can be coded correctly one time instead of badly multiple times. --- generic/tclCmdMZ.c | 17 ++++++++--------- generic/tclInt.h | 2 ++ generic/tclStringObj.c | 40 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 50 insertions(+), 9 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 591e31c..1a08674 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2855,7 +2855,7 @@ StringCatCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i; + int code; Tcl_Obj *objResultPtr; if (objc < 2) { @@ -2872,16 +2872,15 @@ StringCatCmd( Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } - objResultPtr = objv[1]; - if (Tcl_IsShared(objResultPtr)) { - objResultPtr = Tcl_DuplicateObj(objResultPtr); - } - for(i = 2;i < objc;i++) { - Tcl_AppendObjToObj(objResultPtr, objv[i]); + + code = TclStringCatObjv(interp, objc-1, objv+1, &objResultPtr); + + if (code == TCL_OK) { + Tcl_SetObjResult(interp, objResultPtr); + return TCL_OK; } - Tcl_SetObjResult(interp, objResultPtr); - return TCL_OK; + return code; } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index da1b5c5..36c1a81 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3135,6 +3135,8 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); +MODULE_SCOPE int TclStringCatObjv(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], Tcl_Obj **objPtrPtr); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 2930fa1..1828d20 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2598,6 +2598,46 @@ TclGetStringStorage( *sizePtr = stringPtr->allocated; return objPtr->bytes; } + +/* + *--------------------------------------------------------------------------- + * + * TclStringCatObjv -- + * + * Performs the [string cat] function. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation + * of all objc values in objv. + * + *--------------------------------------------------------------------------- + */ + +int +TclStringCatObjv( + Tcl_Interp *interp, + int objc, + Tcl_Obj * const objv[], + Tcl_Obj **objPtrPtr) +{ + Tcl_Obj *objResultPtr; + + /* assert (objc >= 2) */ + + objResultPtr = *objv++; objc--; + if (Tcl_IsShared(objResultPtr)) { + objResultPtr = Tcl_DuplicateObj(objResultPtr); + } + while (objc--) { + Tcl_AppendObjToObj(objResultPtr, *objv++); + } + *objPtrPtr = objResultPtr; + return TCL_OK; +} + /* *--------------------------------------------------------------------------- * -- cgit v0.12 From 6beda912ab0f8bd8784d7b1a973d3897c89b75c0 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 27 Oct 2016 20:06:36 +0000 Subject: Convert INST_STR_CONCAT1 to the common `string cat` implementation. --- generic/tclExecute.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b19754e..fcf5ba9 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2692,6 +2692,13 @@ TEBCresume( opnd = TclGetUInt1AtPtr(pc+1); +#if 1 + if (TCL_OK != TclStringCatObjv(interp, opnd, &OBJ_AT_DEPTH(opnd-1), + &objResultPtr)) { + TRACE_ERROR(interp); + goto gotError; + } +#else /* * Detect only-bytearray-or-null case. */ @@ -2828,6 +2835,7 @@ TEBCresume( } } } +#endif TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); -- cgit v0.12 From 29038829dceb276e2d15cae2097f302f46eb272f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 28 Oct 2016 16:55:44 +0000 Subject: revise [dict append] to make use of common [string cat] engine. --- generic/tclDictObj.c | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index f99f984..3be968a 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -2282,7 +2282,7 @@ DictAppendCmd( Tcl_Obj *const *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; - int i, allocatedDict = 0; + int allocatedDict = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); @@ -2307,15 +2307,33 @@ DictAppendCmd( if ((objc > 3) || (valuePtr == NULL)) { /* Only go through append activites when something will change. */ + Tcl_Obj *appendObjPtr = NULL; - if (valuePtr == NULL) { + if (objc > 3) { + /* Something to append */ + + if (objc == 4) { + appendObjPtr = objv[3]; + } else if (TCL_OK != TclStringCatObjv(interp, objc-3, objv+3, + &appendObjPtr)) { + return TCL_ERROR; + } + } + + if (appendObjPtr == NULL) { + /* => (objc == 3) => (valuePtr == NULL) */ TclNewObj(valuePtr); - } else if (Tcl_IsShared(valuePtr)) { - valuePtr = Tcl_DuplicateObj(valuePtr); + } else if (valuePtr == NULL) { + valuePtr = appendObjPtr; + appendObjPtr = NULL; } - for (i=3 ; i Date: Fri, 28 Oct 2016 20:33:55 +0000 Subject: WIP --- generic/tclCmdIL.c | 5 ++--- generic/tclCmdMZ.c | 3 ++- generic/tclDictObj.c | 4 ++-- generic/tclExecute.c | 4 ++-- generic/tclInt.h | 5 +++-- generic/tclStringObj.c | 58 +++++++++++++++++++++++++++++++++++++++++++++++++- 6 files changed, 68 insertions(+), 11 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 09adc8d..73bd36f 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2187,9 +2187,8 @@ Tcl_JoinObjCmd( Tcl_IncrRefCount(joinObjPtr); if (Tcl_GetCharLength(joinObjPtr) == 0) { - Tcl_IncrRefCount(elemPtrs[0]); - TclStringCatObjv(interp, listLen, elemPtrs, &resObjPtr); - Tcl_DecrRefCount(elemPtrs[0]); + TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs, + &resObjPtr); } else { int i; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 1a08674..10c2ef3 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2873,7 +2873,8 @@ StringCatCmd( return TCL_OK; } - code = TclStringCatObjv(interp, objc-1, objv+1, &objResultPtr); + code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1, + &objResultPtr); if (code == TCL_OK) { Tcl_SetObjResult(interp, objResultPtr); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 3be968a..9686c6f 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -2314,8 +2314,8 @@ DictAppendCmd( if (objc == 4) { appendObjPtr = objv[3]; - } else if (TCL_OK != TclStringCatObjv(interp, objc-3, objv+3, - &appendObjPtr)) { + } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1, + objc-3, objv+3, &appendObjPtr)) { return TCL_ERROR; } } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index fcf5ba9..1cf8548 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2693,8 +2693,8 @@ TEBCresume( opnd = TclGetUInt1AtPtr(pc+1); #if 1 - if (TCL_OK != TclStringCatObjv(interp, opnd, &OBJ_AT_DEPTH(opnd-1), - &objResultPtr)) { + if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1, + opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) { TRACE_ERROR(interp); goto gotError; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 36c1a81..8a647f0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3135,8 +3135,9 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); -MODULE_SCOPE int TclStringCatObjv(Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[], Tcl_Obj **objPtrPtr); +MODULE_SCOPE int TclStringCatObjv(Tcl_Interp *interp, int inPlace, + int objc, Tcl_Obj *const objv[], + Tcl_Obj **objPtrPtr); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index cc30602..c248749 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2630,18 +2630,74 @@ TclGetStringStorage( int TclStringCatObjv( Tcl_Interp *interp, + int inPlace, int objc, Tcl_Obj * const objv[], Tcl_Obj **objPtrPtr) { Tcl_Obj *objResultPtr; + int i, length = 0, binary = 1, first = 0; /* assert (objc >= 2) */ + /* + * GOALS: Avoid shimmering & string rep generation. + * Produce pure bytearray when possible. + * Error on overflow. + */ + + for (i = 0; i < objc && binary; i++) { + Tcl_Obj *objPtr = objv[i]; + + if (objPtr->bytes) { + if (objPtr->length == 0) { + continue; + } + binary = 0; + } else if (!TclIsPureByteArray(objPtr)) { + binary = 0; + } + } + + if (binary) { + for (i = 0; i < objc && length >= 0; i++) { + if (objv[i]->bytes == NULL) { + int numBytes; + + Tcl_GetByteArrayFromObj(objv[i], &numBytes); + if (length == 0) { + first = i; + } + length += numBytes; + } + } + if (length < 0) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "max size for a Tcl value (%d bytes) exceeded", + INT_MAX)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + return TCL_ERROR; + } + if (length == 0) { + /* Total length of zero means every value has length zero */ + *objPtrPtr = objv[0]; + return TCL_OK; + } + } + + objv += first; objc -= first; objResultPtr = *objv++; objc--; - if (Tcl_IsShared(objResultPtr)) { + if (!inPlace || Tcl_IsShared(objResultPtr)) { objResultPtr = Tcl_DuplicateObj(objResultPtr); } + + if (binary) { + Tcl_SetByteArrayLength(objResultPtr, length); + } + + while (objc--) { Tcl_AppendObjToObj(objResultPtr, *objv++); } -- cgit v0.12 From 77c9a433f701214eafd76617a8e3c67316ebf08e Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 31 Oct 2016 16:15:16 +0000 Subject: Complete the "pure binary" implementation of the [string cat] engine. --- generic/tclStringObj.c | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c248749..c0d85a0 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2694,12 +2694,26 @@ TclStringCatObjv( } if (binary) { - Tcl_SetByteArrayLength(objResultPtr, length); - } - - - while (objc--) { - Tcl_AppendObjToObj(objResultPtr, *objv++); + /* Efficiently produce a pure binary result */ + unsigned char *dst; + int start; + + Tcl_GetByteArrayFromObj(objResultPtr, &start); + dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; + while (objc--) { + Tcl_Obj *objPtr = *objv++; + + if (objPtr->bytes == NULL) { + int more; + unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); + memcpy(dst, src, (size_t) more); + dst += more; + } + } + } else { + while (objc--) { + Tcl_AppendObjToObj(objResultPtr, *objv++); + } } *objPtrPtr = objResultPtr; return TCL_OK; -- cgit v0.12 From b550e65a968434e0f17d097f85df3fb64347e1ce Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 31 Oct 2016 18:10:21 +0000 Subject: Reduce copies in the pure binary implementation of [string cat]. --- generic/tclStringObj.c | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c0d85a0..1723804 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2688,18 +2688,21 @@ TclStringCatObjv( } objv += first; objc -= first; - objResultPtr = *objv++; objc--; - if (!inPlace || Tcl_IsShared(objResultPtr)) { - objResultPtr = Tcl_DuplicateObj(objResultPtr); - } if (binary) { /* Efficiently produce a pure binary result */ unsigned char *dst; - int start; - Tcl_GetByteArrayFromObj(objResultPtr, &start); - dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; + if (inPlace && !Tcl_IsShared(*objv)) { + int start; + + objResultPtr = *objv++; objc--; + Tcl_GetByteArrayFromObj(objResultPtr, &start); + dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; + } else { + objResultPtr = Tcl_NewByteArrayObj(NULL, length); + dst = Tcl_SetByteArrayLength(objResultPtr, length); + } while (objc--) { Tcl_Obj *objPtr = *objv++; @@ -2711,6 +2714,15 @@ TclStringCatObjv( } } } else { + + + objResultPtr = *objv++; objc--; + if (!inPlace || Tcl_IsShared(objResultPtr)) { + objResultPtr = Tcl_DuplicateObj(objResultPtr); + } + + + while (objc--) { Tcl_AppendObjToObj(objResultPtr, *objv++); } -- cgit v0.12 From ff2f0e85be431ad093ea78333f98942321ea1779 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 1 Nov 2016 15:07:30 +0000 Subject: Expand all the cases of the [string cat] engine. --- generic/tclStringObj.c | 156 ++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 129 insertions(+), 27 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 1723804..05dcba4 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2637,60 +2637,113 @@ TclStringCatObjv( { Tcl_Obj *objResultPtr; int i, length = 0, binary = 1, first = 0; + int allowUniChar = 1, requestUniChar = 0; /* assert (objc >= 2) */ /* + * Analyze to determine what representation result should be. * GOALS: Avoid shimmering & string rep generation. * Produce pure bytearray when possible. * Error on overflow. */ - for (i = 0; i < objc && binary; i++) { + for (i = 0; i < objc && (binary || allowUniChar); i++) { Tcl_Obj *objPtr = objv[i]; if (objPtr->bytes) { - if (objPtr->length == 0) { - continue; + /* Value has a string rep. */ + if (objPtr->length) { + /* + * Non-empty string rep. Not a pure bytearray, so we + * won't create a pure bytearray + */ + binary = 0; + if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) { + /* Prevent shimmer of non-string types. */ + allowUniChar = 0; + } + } + } else { + /* assert (objPtr->typePtr != NULL) -- stork! */ + if (TclIsPureByteArray(objPtr)) { + allowUniChar = 0; + } else { + binary = 0; + if (objPtr->typePtr == &tclStringType) { + /* Have a pure Unicode value; ask to preserve it */ + requestUniChar = 1; + } else { + /* Have another type; prevent shimmer */ + allowUniChar = 0; + } } - binary = 0; - } else if (!TclIsPureByteArray(objPtr)) { - binary = 0; } } if (binary) { + /* Result will be pure byte array. Pre-size it */ for (i = 0; i < objc && length >= 0; i++) { - if (objv[i]->bytes == NULL) { + Tcl_Obj *objPtr = objv[i]; + + if (objPtr->bytes == NULL) { int numBytes; - Tcl_GetByteArrayFromObj(objv[i], &numBytes); + Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (length == 0) { first = i; } length += numBytes; } } - if (length < 0) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", - INT_MAX)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } else if (allowUniChar && requestUniChar) { + /* Result will be pure Tcl_UniChar array. Pre-size it. */ + for (i = 0; i < objc && length >= 0; i++) { + Tcl_Obj *objPtr = objv[i]; + + if ((objPtr->bytes == NULL) || (objPtr->length)) { + int numChars; + + Tcl_GetUnicodeFromObj(objPtr, &numChars); + if (length == 0) { + first = i; + } + length += numChars; } - return TCL_ERROR; } - if (length == 0) { - /* Total length of zero means every value has length zero */ - *objPtrPtr = objv[0]; - return TCL_OK; + } else { + /* Result will be concat of string reps. Pre-size it. */ + for (i = 0; i < objc && length >= 0; i++) { + Tcl_Obj *objPtr = objv[i]; + int numBytes; + + Tcl_GetStringFromObj(objPtr, &numBytes); + if ((length == 0) && numBytes) { + first = i; + } + length += numBytes; + } + } + + if (length < 0) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } - } + return TCL_ERROR; + } + + if (length == 0) { + /* Total length of zero means every value has length zero */ + *objPtrPtr = objv[0]; + return TCL_OK; + } objv += first; objc -= first; if (binary) { - /* Efficiently produce a pure binary result */ + /* Efficiently produce a pure byte array result */ unsigned char *dst; if (inPlace && !Tcl_IsShared(*objv)) { @@ -2713,18 +2766,67 @@ TclStringCatObjv( dst += more; } } - } else { + } else if (allowUniChar && requestUniChar) { + /* Efficiently produce a pure Tcl_UniChar array result */ + Tcl_UniChar *dst; + if (inPlace && !Tcl_IsShared(*objv)) { + int start; - objResultPtr = *objv++; objc--; - if (!inPlace || Tcl_IsShared(objResultPtr)) { - objResultPtr = Tcl_DuplicateObj(objResultPtr); - } + objResultPtr = *objv++; objc--; + + /* Ugly interface! Force resize of the unicode array. */ + Tcl_GetUnicodeFromObj(objResultPtr, &start); + Tcl_InvalidateStringRep(objResultPtr); + Tcl_SetObjLength(objResultPtr, length); + dst = Tcl_GetUnicode(objResultPtr) + start; + } else { + Tcl_UniChar ch = 0; + + /* Ugly interface! No scheme to init array size. */ + objResultPtr = Tcl_NewUnicodeObj(&ch, 0); + Tcl_SetObjLength(objResultPtr, length); + dst = Tcl_GetUnicode(objResultPtr); + } + while (objc--) { + Tcl_Obj *objPtr = *objv++; + + if ((objPtr->bytes == NULL) || (objPtr->length)) { + int more; + Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); + memcpy(dst, src, more * sizeof(Tcl_UniChar)); + dst += more; + } + } + } else { + /* Efficiently concatenate string reps */ + char *dst; + if (inPlace && !Tcl_IsShared(*objv)) { + int start; + objResultPtr = *objv++; objc--; + Tcl_GetStringFromObj(objResultPtr, &start); + Tcl_SetObjLength(objResultPtr, length); + dst = Tcl_GetString(objResultPtr) + start; + if (length > start) { + TclFreeIntRep(objResultPtr); + } + } else { + objResultPtr = Tcl_NewObj(); + Tcl_SetObjLength(objResultPtr, length); + dst = Tcl_GetString(objResultPtr); + } while (objc--) { - Tcl_AppendObjToObj(objResultPtr, *objv++); + Tcl_Obj *objPtr = *objv++; + + if ((objPtr->bytes == NULL) || (objPtr->length)) { + int more; + char *src = Tcl_GetStringFromObj(objPtr, &more); + memcpy(dst, src, (size_t) more); + dst += more; + } } } *objPtrPtr = objResultPtr; -- cgit v0.12 From 418ded1bc9df7ae0976ce3793aa0190c93609332 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 1 Nov 2016 15:12:07 +0000 Subject: Trim away obsolete code. --- generic/tclExecute.c | 146 +-------------------------------------------------- 1 file changed, 1 insertion(+), 145 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 1cf8548..83b83f1 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2684,162 +2684,18 @@ TEBCresume( NEXT_INST_F(5, 0, 0); } - case INST_STR_CONCAT1: { - int appendLen = 0; - char *bytes, *p; - Tcl_Obj **currPtr; - int onlyb = 1; + case INST_STR_CONCAT1: opnd = TclGetUInt1AtPtr(pc+1); -#if 1 if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1, opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) { TRACE_ERROR(interp); goto gotError; } -#else - /* - * Detect only-bytearray-or-null case. - */ - - for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) { - if (((*currPtr)->typePtr != &tclByteArrayType) - && ((*currPtr)->bytes != tclEmptyStringRep)) { - onlyb = 0; - break; - } else if (((*currPtr)->typePtr == &tclByteArrayType) && - ((*currPtr)->bytes != NULL)) { - onlyb = 0; - break; - } - } - - /* - * Compute the length to be appended. - */ - - if (onlyb) { - for (currPtr = &OBJ_AT_DEPTH(opnd-2); - appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) { - if ((*currPtr)->bytes != tclEmptyStringRep) { - Tcl_GetByteArrayFromObj(*currPtr, &length); - appendLen += length; - } - } - } else { - for (currPtr = &OBJ_AT_DEPTH(opnd-2); - appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) { - bytes = TclGetStringFromObj(*currPtr, &length); - if (bytes != NULL) { - appendLen += length; - } - } - } - - if (appendLen < 0) { - /* TODO: convert panic to error ? */ - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - - /* - * If nothing is to be appended, just return the first object by - * dropping all the others from the stack; this saves both the - * computation and copy of the string rep of the first object, - * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'. - */ - - if (appendLen == 0) { - TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); - NEXT_INST_V(2, (opnd-1), 0); - } - - /* - * If the first object is shared, we need a new obj for the result; - * otherwise, we can reuse the first object. In any case, make sure it - * has enough room to accomodate all the concatenated bytes. Note that - * if it is unshared its bytes are copied by ckrealloc, so that we set - * the loop parameters to avoid copying them again: p points to the - * end of the already copied bytes, currPtr to the second object. - */ - - objResultPtr = OBJ_AT_DEPTH(opnd-1); - if (!onlyb) { - bytes = TclGetStringFromObj(objResultPtr, &length); - if (length + appendLen < 0) { - /* TODO: convert panic to error ? */ - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", - INT_MAX); - } -#ifndef TCL_COMPILE_DEBUG - if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) { - TclFreeIntRep(objResultPtr); - objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1); - objResultPtr->length = length + appendLen; - p = TclGetString(objResultPtr) + length; - currPtr = &OBJ_AT_DEPTH(opnd - 2); - } else -#endif - { - p = ckalloc(length + appendLen + 1); - TclNewObj(objResultPtr); - objResultPtr->bytes = p; - objResultPtr->length = length + appendLen; - currPtr = &OBJ_AT_DEPTH(opnd - 1); - } - - /* - * Append the remaining characters. - */ - - for (; currPtr <= &OBJ_AT_TOS; currPtr++) { - bytes = TclGetStringFromObj(*currPtr, &length); - if (bytes != NULL) { - memcpy(p, bytes, (size_t) length); - p += length; - } - } - *p = '\0'; - } else { - bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length); - if (length + appendLen < 0) { - /* TODO: convert panic to error ? */ - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", - INT_MAX); - } -#ifndef TCL_COMPILE_DEBUG - if (!Tcl_IsShared(objResultPtr)) { - bytes = (char *) Tcl_SetByteArrayLength(objResultPtr, - length + appendLen); - p = bytes + length; - currPtr = &OBJ_AT_DEPTH(opnd - 2); - } else -#endif - { - TclNewObj(objResultPtr); - bytes = (char *) Tcl_SetByteArrayLength(objResultPtr, - length + appendLen); - p = bytes; - currPtr = &OBJ_AT_DEPTH(opnd - 1); - } - - /* - * Append the remaining characters. - */ - - for (; currPtr <= &OBJ_AT_TOS; currPtr++) { - if ((*currPtr)->bytes != tclEmptyStringRep) { - bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length); - memcpy(p, bytes, (size_t) length); - p += length; - } - } - } -#endif TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); - } case INST_CONCAT_STK: /* -- cgit v0.12 From cdc8b6080c2a2f05f3f66adfa3184405f04dc003 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 1 Nov 2016 15:42:50 +0000 Subject: Replace indexing with pointer increments. --- generic/tclStringObj.c | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 05dcba4..7fd7cc1 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2635,8 +2635,8 @@ TclStringCatObjv( Tcl_Obj * const objv[], Tcl_Obj **objPtrPtr) { - Tcl_Obj *objResultPtr; - int i, length = 0, binary = 1, first = 0; + Tcl_Obj *objPtr, *objResultPtr, * const *ov; + int oc, length = 0, binary = 1, first = 0; int allowUniChar = 1, requestUniChar = 0; /* assert (objc >= 2) */ @@ -2648,8 +2648,9 @@ TclStringCatObjv( * Error on overflow. */ - for (i = 0; i < objc && (binary || allowUniChar); i++) { - Tcl_Obj *objPtr = objv[i]; + ov = objv, oc = objc; + while (oc-- && (binary || allowUniChar)) { + objPtr = *ov++; if (objPtr->bytes) { /* Value has a string rep. */ @@ -2683,43 +2684,47 @@ TclStringCatObjv( if (binary) { /* Result will be pure byte array. Pre-size it */ - for (i = 0; i < objc && length >= 0; i++) { - Tcl_Obj *objPtr = objv[i]; + ov = objv; oc = objc; + while (oc-- && (length >= 0)) { + objPtr = *ov++; if (objPtr->bytes == NULL) { int numBytes; Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (length == 0) { - first = i; + first = objc - oc - 1; } length += numBytes; } } } else if (allowUniChar && requestUniChar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ - for (i = 0; i < objc && length >= 0; i++) { - Tcl_Obj *objPtr = objv[i]; + ov = objv; oc = objc; + while (oc-- && (length >= 0)) { + objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int numChars; Tcl_GetUnicodeFromObj(objPtr, &numChars); if (length == 0) { - first = i; + first = objc - oc - 1; } length += numChars; } } } else { /* Result will be concat of string reps. Pre-size it. */ - for (i = 0; i < objc && length >= 0; i++) { - Tcl_Obj *objPtr = objv[i]; + ov = objv; oc = objc; + while (oc-- && (length >= 0)) { int numBytes; + objPtr = *ov++; + Tcl_GetStringFromObj(objPtr, &numBytes); if ((length == 0) && numBytes) { - first = i; + first = objc - oc - 1; } length += numBytes; } -- cgit v0.12