* generic/tclCmdMZ.c (STR_REVERSE): Implement the actual

        [string reverse] command in terms of the new TclStringObjReverse()
        routine.

        * generic/tclInt.h (TclStringObjReverse):       New internal routine
        * generic/tclStringObj.c (TclStringObjReverse): that implements the
        [string reverse] operation, making use of knowledge/surgery of the
        String intrep to minimize the number of allocs and copies needed to
        do the job.

4 files changed, 99 insertions, 38 deletions

diff --git a/ChangeLog b/ChangeLog
index 160af2a..8bd4d2b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2007-03-28  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclCmdMZ.c (STR_REVERSE):	Implement the actual
+	[string reverse] command in terms of the new TclStringObjReverse()
+	routine.
+
+	* generic/tclInt.h (TclStringObjReverse):	New internal routine
+	* generic/tclStringObj.c (TclStringObjReverse):	that implements the
+	[string reverse] operation, making use of knowledge/surgery of the
+	String intrep to minimize the number of allocs and copies needed to
+	do the job.
+
 2007-03-27  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclCmdMZ.c (STR_MAP): Replace ckalloc calls with
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 709c8cd..4d82870 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.145 2007/03/27 16:44:05 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.146 2007/03/28 19:03:42 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2245,46 +2245,12 @@ Tcl_StringObjCmd(
 	break;
     }
     case STR_REVERSE: {
-	Tcl_UniChar *ustring1;
-	int i, j;
-
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "string");
 	    return TCL_ERROR;
 	}
 
-	ustring1 = Tcl_GetUnicodeFromObj(objv[2], &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<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, TclStringObjReverse(objv[2]));
 	break;
     }
     case STR_TOLOWER:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 967cec8..564c19e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.301 2007/02/24 18:55:43 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.302 2007/03/28 19:03:42 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -2407,6 +2407,7 @@ MODULE_SCOPE void	TclSetBignumIntRep (Tcl_Obj *objPtr,
 MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
 			    Tcl_Obj *newValue, Tcl_Encoding encoding);
 MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
+MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
 MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
 			    int count, int *tokensLeftPtr, int line);
 MODULE_SCOPE void	TclTransferResult(Tcl_Interp *sourceInterp, int result,
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index f3aa3ab..2ab51fb 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStringObj.c,v 1.64 2007/03/21 18:02:51 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.65 2007/03/28 19:03:42 dgp Exp $ */
 
 #include "tclInt.h"
 #include "tommath.h"
@@ -2519,6 +2519,88 @@ Tcl_ObjPrintf(
 /*
  *---------------------------------------------------------------------------
  *
+ * TclStringObjReverse --
+ *
+ *	Implements the [string reverse] operation.
+ *
+ * Results:
+ *	An unshared Tcl value which is the [string reverse] of the argument
+ *	supplied.  When sharing rules permit, the returned value might be
+ *	the argument with modifications done in place.
+ *
+ * Side effects:
+ *	May allocate a new Tcl_Obj.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclStringObjReverse(
+    Tcl_Obj *objPtr)
+{
+    String *stringPtr;
+    int numChars = Tcl_GetCharLength(objPtr);
+    int i = 0, lastCharIdx = numChars - 1;
+    char *bytes;
+
+    if (numChars <= 1) {
+	return objPtr;
+    }
+
+    stringPtr = GET_STRING(objPtr);
+    if (stringPtr->hasUnicode) {
+	Tcl_UniChar *source = stringPtr->unicode;
+
+	if (Tcl_IsShared(objPtr)) {
+	    Tcl_UniChar *dest, ch = 0;
+
+	    /*
+	     * Create a non-empty, pure unicode value, so we can coax
+	     * Tcl_SetObjLength into growing the unicode rep buffer.
+	     */
+
+	    Tcl_Obj *resultPtr = Tcl_NewUnicodeObj(&ch, 1);
+	    Tcl_SetObjLength(resultPtr, numChars);
+	    dest = Tcl_GetUnicode(resultPtr);
+
+	    while (i < numChars) {
+		dest[i++] = source[lastCharIdx--];
+	    }
+	    return resultPtr;
+	}
+
+	while (i < lastCharIdx) {
+	    Tcl_UniChar tmp = source[lastCharIdx];
+	    source[lastCharIdx--] = source[i];
+	    source[i++] = tmp;
+	}
+	Tcl_InvalidateStringRep(objPtr);
+	return objPtr;
+    }
+
+    bytes = Tcl_GetString(objPtr);
+    if (Tcl_IsShared(objPtr)) {
+	char *dest;
+	Tcl_Obj *resultPtr = Tcl_NewObj();
+	Tcl_SetObjLength(resultPtr, numChars);
+	dest = Tcl_GetString(resultPtr);
+	while (i < numChars) {
+	    dest[i++] = bytes[lastCharIdx--];
+	}
+	return resultPtr;
+    }
+
+    while (i < lastCharIdx) {
+	char tmp = bytes[lastCharIdx];
+	bytes[lastCharIdx--] = bytes[i];
+	bytes[i++] = tmp;
+    }
+    return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
  * FillUnicodeRep --
  *
  *	Populate the Unicode internal rep with the Unicode form of its string