From eb3b46a34f42059728dc5d5c220c4757dd0b1b2b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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