From 50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 9 Nov 2006 16:11:46 +0000
Subject: Optimize for the unshared case.

---
 generic/tclCmdIL.c | 40 ++++++++++++++++++++++++++++------------
 generic/tclCmdMZ.c | 39 +++++++++++++++++++++++++++++++--------
 tests/cmdIL.test   | 10 +++++++---
 tests/string.test  | 12 +++++++++---
 4 files changed, 75 insertions(+), 26 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 6f9d9ac..d679e90 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.93 2006/11/09 15:19:03 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.94 2006/11/09 16:11:46 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3164,9 +3164,8 @@ Tcl_LreverseObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *CONST objv[])	/* Argument values. */
 {
-    Tcl_Obj *resultObj, **dataArray, **elemv;
+    Tcl_Obj **elemv;
     int elemc, i, j;
-    List *listPtr;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list");
@@ -3176,17 +3175,34 @@ Tcl_LreverseObjCmd(
 	return TCL_ERROR;
     }
 
-    resultObj = Tcl_NewListObj(elemc, NULL);
-    listPtr = (List *) resultObj->internalRep.twoPtrValue.ptr1;
-    listPtr->elemCount = elemc;
-    dataArray = &listPtr->elements;
+    if (Tcl_IsShared(objv[1])) {
+	Tcl_Obj *resultObj = Tcl_NewListObj(elemc, NULL);
+	Tcl_Obj **dataArray;
+	List *listPtr;
 
-    for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
-	dataArray[j] = elemv[i];
-	Tcl_IncrRefCount(elemv[i]);
-    }
+	listPtr = (List *) resultObj->internalRep.twoPtrValue.ptr1;
+	listPtr->elemCount = elemc;
+	dataArray = &listPtr->elements;
+
+	for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
+	    dataArray[j] = elemv[i];
+	    Tcl_IncrRefCount(elemv[i]);
+	}
 
-    Tcl_SetObjResult(interp, resultObj);
+	Tcl_SetObjResult(interp, resultObj);
+    } else {
+	/*
+	 * Not shared, so swap "in place". This relies on Tcl_LOGE above
+	 * returning a pointer to the live array of Tcl_Obj values.
+	 */
+
+	for (i=0,j=elemc-1 ; i<j ; i++,j--) {
+	    Tcl_Obj *tmp = elemv[i];
+	    elemv[i] = elemv[j];
+	    elemv[j] = tmp;
+	}
+	Tcl_SetObjResult(interp, objv[1]);
+    }
     return TCL_OK;
 }
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 474f90f..e121999 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,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.139 2006/11/09 15:37:55 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.140 2006/11/09 16:11:46 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2196,7 +2196,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	break;
     }
     case STR_REVERSE: {
-	Tcl_UniChar *ustring1, *ustring2;
+	Tcl_UniChar *ustring1;
 	int i, j;
 
 	if (objc != 3) {
@@ -2205,14 +2205,37 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	}
 
 	ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
-	ustring2 = (Tcl_UniChar *)
-		ckalloc(sizeof(Tcl_UniChar) * (unsigned)length1);
+	if (Tcl_IsShared(objv[2])) {
+	    Tcl_UniChar *ustring2 = (Tcl_UniChar *)
+		    ckalloc(sizeof(Tcl_UniChar) * (unsigned)length1);
+
+	    for (i=0,j=length1-1 ; i<length1 ; i++,j--) {
+		ustring2[j] = ustring1[i];
+	    }
+	    Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(ustring2, length1));
+	    ckfree((char *) ustring2);
+	} else {
+	    /*
+	     * The object is unshared, so we can do the swap in-place. This
+	     * avoids memory allocation, and so is faster.
+	     */
 
-	for (i=0,j=length1-1 ; i<length1 ; i++,j--) {
-	    ustring2[j] = ustring1[i];
+	    for (i=0,j=length1-1 ; i<j ; i++,j--) {
+		Tcl_UniChar tmp = ustring1[i];
+		ustring1[i] = ustring1[j];
+		ustring1[j] = tmp;
+	    }
+
+	    /*
+	     * Tricky. Must invalidate the string (utf-8) representation to
+	     * ensure that it is regenerated from the "unicode" internal rep.
+	     */
+
+	    if (objv[2]->bytes != NULL) {
+		Tcl_InvalidateStringRep(objv[2]);
+	    }
+	    Tcl_SetObjResult(interp, objv[2]);
 	}
-	Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(ustring2, length1));
-	ckfree((char *) ustring2);
 	break;
     }
     case STR_TOLOWER:
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index c2fd650..87af599 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdIL.test,v 1.29 2006/11/09 15:19:03 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.30 2006/11/09 16:11:46 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -733,8 +733,12 @@ test cmdIL-7.2 {lreverse command} -body {
 test cmdIL-7.3 {lreverse command} -body {
     lreverse "not \{a list"
 } -returnCodes error -result {unmatched open brace in list}
-test cmdIL-7.4 {lreverse command} {
-    lreverse {a b {c d} e f}
+test cmdIL-7.4 {lreverse command - shared object} {
+    set x {a b {c d} e f}
+    lreverse $x
+} {f e {c d} b a}
+test cmdIL-7.5 {lreverse command - unshared object} {
+    lreverse [list a b {c d} e f]
 } {f e {c d} b a}
 
 # cleanup
diff --git a/tests/string.test b/tests/string.test
index e0a96ee..6bdffb4 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: string.test,v 1.58 2006/11/09 15:37:56 dkf Exp $
+# RCS: @(#) $Id: string.test,v 1.59 2006/11/09 16:11:46 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1503,8 +1503,14 @@ test string-24.1 {string reverse command} -body {
 test string-24.2 {string reverse command} -body {
     string reverse a b
 } -returnCodes error -result "wrong # args: should be \"string reverse string\""
-test string-24.3 {string reverse command} {
-    string reverse abcde
+test string-24.3 {string reverse command - shared string} {
+    set x abcde
+    string reverse $x
+} edcba
+test string-24.4 {string reverse command - unshared string} {
+    set x abc
+    set y de
+    string reverse $x$y
 } edcba
 
 # cleanup
-- 
cgit v0.12