summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2006-11-09 16:11:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2006-11-09 16:11:46 (GMT)
commit50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d (patch)
treefc51c4267eadb24af3f968b7645c15fd549e2c81 /generic
parentffd8329a24b35299d0efa9610743cc016203dc84 (diff)
downloadtcl-50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d.zip
tcl-50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d.tar.gz
tcl-50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d.tar.bz2
Optimize for the unshared case.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdIL.c40
-rw-r--r--generic/tclCmdMZ.c39
2 files changed, 59 insertions, 20 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: