diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 38 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 84 |
4 files changed, 99 insertions, 38 deletions
@@ -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 |