diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2006-11-09 16:11:46 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2006-11-09 16:11:46 (GMT) |
commit | 50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d (patch) | |
tree | fc51c4267eadb24af3f968b7645c15fd549e2c81 /generic | |
parent | ffd8329a24b35299d0efa9610743cc016203dc84 (diff) | |
download | tcl-50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d.zip tcl-50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d.tar.gz tcl-50372ddbf9e9b93ddf9b64cad6b9380d5a542c2d.tar.bz2 |
Optimize for the unshared case.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCmdIL.c | 40 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 39 |
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: |