summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-03-28 19:03:41 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-03-28 19:03:41 (GMT)
commitf0dcf496f096fd97761a4392ff77c13f9eb49707 (patch)
tree5e6ea6dfc617bfe467971c624cb6c9218f9eb92c
parent2ef27f98192e8690ab3b297accafe52001b24014 (diff)
downloadtcl-f0dcf496f096fd97761a4392ff77c13f9eb49707.zip
tcl-f0dcf496f096fd97761a4392ff77c13f9eb49707.tar.gz
tcl-f0dcf496f096fd97761a4392ff77c13f9eb49707.tar.bz2
* 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.
-rw-r--r--ChangeLog12
-rw-r--r--generic/tclCmdMZ.c38
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclStringObj.c84
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