diff options
author | ferrieux <ferrieux@users.sourceforge.net> | 2008-06-29 23:12:58 (GMT) |
---|---|---|
committer | ferrieux <ferrieux@users.sourceforge.net> | 2008-06-29 23:12:58 (GMT) |
commit | f843ecd2f7b202e1c63288e271d352785ad601df (patch) | |
tree | 04ca5b87b29e66278fd835430aa3d517943a385e /generic | |
parent | 6806d5f10cc77778fd3bac70f636b1e1210d6ced (diff) | |
download | tcl-f843ecd2f7b202e1c63288e271d352785ad601df.zip tcl-f843ecd2f7b202e1c63288e271d352785ad601df.tar.gz tcl-f843ecd2f7b202e1c63288e271d352785ad601df.tar.bz2 |
Lrange cleanup and in-place optimization [Patch 1890831]
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCmdIL.c | 84 |
1 files changed, 48 insertions, 36 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 296c3f4..5a43d91 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.140 2008/06/16 19:59:03 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.141 2008/06/29 23:12:59 ferrieux Exp $ */ #include "tclInt.h" @@ -2331,52 +2331,64 @@ Tcl_LrangeObjCmd( register Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj *listPtr, **elemPtrs; - int listLen, first, result; + Tcl_Obj **elemPtrs; + int listLen, first, last, result; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; } - - /* - * Make sure the list argument is a list object and get its length and a - * pointer to its array of element pointers. - */ - - listPtr = TclListObjCopy(interp, objv[1]); - if (listPtr == NULL) { - return TCL_ERROR; + + result = TclListObjLength(interp, objv[1], &listLen); + if (result != TCL_OK) { + return result; } - TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs); - + result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1, - &first); - if (result == TCL_OK) { - int last; - - if (first < 0) { - first = 0; - } - - result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, - &last); - if (result == TCL_OK) { - if (last >= listLen) { - last = (listLen - 1); - } + &first); + if (result != TCL_OK) { + return result; + } + if (first < 0) { + first = 0; + } + + result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, + &last); + if (result != TCL_OK) { + return result; + } + if (last >= listLen) { + last = (listLen - 1); + } - if (first <= last) { - int numElems = (last - first + 1); + if (first>last) { + /* returning an empty list is easy */ + return TCL_OK; + } - Tcl_SetObjResult(interp, - Tcl_NewListObj(numElems, &(elemPtrs[first]))); - } - } + result=TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs); + if (result != TCL_OK) { + return result; } + + if (Tcl_IsShared(objv[1])||(((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1)) + { + Tcl_SetObjResult(interp, + Tcl_NewListObj(last - first + 1, &(elemPtrs[first]))); + } + else + { + /* in-place is possible */ + if (last<(listLen-1)) + Tcl_ListObjReplace(interp,objv[1], last+1, listLen-1-last, 0, NULL); + /* this one is not conditioned on (first>0) in order to + * preserve the string-canonizing effect of [lrange 0 end] */ + Tcl_ListObjReplace(interp,objv[1], 0, first, 0, NULL); + Tcl_SetObjResult(interp,objv[1]); + } - Tcl_DecrRefCount(listPtr); - return result; + return TCL_OK; } /* |