Refactored lrange to common function.

4 files changed, 87 insertions, 80 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b41d312..001b62d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2543,7 +2543,6 @@ Tcl_LrangeObjCmd(
     register Tcl_Obj *const objv[])
 				/* Argument objects. */
 {
-    Tcl_Obj **elemPtrs;
     int listLen, first, last, result;
 
     if (objc != 4) {
@@ -2561,55 +2560,14 @@ Tcl_LrangeObjCmd(
     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) {
-	/*
-	 * Returning an empty list is easy.
-	 */
-
-	return TCL_OK;
-    }
-
-    result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    if (Tcl_IsShared(objv[1]) ||
-	    ((ListRepPtr(objv[1])->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_SetObjResult(interp, TclListObjRange(objv[1], first, last));
     return TCL_OK;
 }
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0f501b9..8568642 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5087,11 +5087,11 @@ TEBCresume(
 		TclGetInt4AtPtr(pc+5)));
 
 	/*
-	 * Get the contents of the list, making sure that it really is a list
+	 * Get the length of the list, making sure that it really is a list
 	 * in the process.
 	 */
 
-	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+	if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
@@ -5128,41 +5128,7 @@ TEBCresume(
 	    toIdx = objc;
 	}
 
-	/*
-	 * Check if we are referring to a valid, non-empty list range, and if
-	 * so, build the list of elements in that range.
-	 */
-
-	if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
-	    if (fromIdx < 0) {
-		fromIdx = 0;
-	    }
-	    if (toIdx >= objc) {
-		toIdx = objc-1;
-	    }
-
-	    /*
-	     * If we are just removing the beginning or the end from an
-	     * unshared object, Tcl_ListObjReplace is very efficient, and also
-	     * guarantees a pure list.
-	     */
-
-	    if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {
-		Tcl_ListObjReplace(interp, valuePtr,
-			toIdx + 1, LIST_MAX, 0, NULL);
-		TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
-		NEXT_INST_F(9, 0, 0);
-	    }
-	    if (toIdx == objc-1 && !Tcl_IsShared(valuePtr)) {
-		Tcl_ListObjReplace(interp, valuePtr,
-			0, fromIdx, 0, NULL);
-		TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
-		NEXT_INST_F(9, 0, 0);
-	    }
-	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
-	} else {
-	    TclNewObj(objResultPtr);
-	}
+	objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
 
 	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 2ba0493..8322095 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3069,6 +3069,8 @@ MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
 			    int *lines, Tcl_Obj *const *elems);
 MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
+MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, int fromIdx,
+			    int toIdx);
 MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
 MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 43d90ab..c4dafba 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -423,6 +423,87 @@ TclListObjCopy(
 /*
  *----------------------------------------------------------------------
  *
+ * TclListObjRange --
+ *
+ *	Makes a slice of a list value.
+ *      *listPtr must be known to be a valid list.
+ *
+ * Results:
+ *	Returns a pointer to the sliced list.
+ *      This may be a new object or the same object if not shared.
+ *
+ * Side effects:
+ *	The possible conversion of the object referenced by listPtr
+ *	to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjRange(
+    Tcl_Obj *listPtr,		/* List object to take a range from. */
+    int fromIdx,		/* Index of first element to include. */
+    int toIdx)			/* Index of last element to include. */
+{
+    Tcl_Obj **elemPtrs;
+    int listLen, i, newLen;
+    List *listRepPtr;
+
+    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
+
+    if (fromIdx < 0) {
+	fromIdx = 0;
+    }
+    if (toIdx >= listLen) {
+	toIdx = listLen-1;
+    }
+    if (fromIdx > toIdx) {
+	return Tcl_NewObj();
+    }
+
+    newLen = toIdx - fromIdx + 1;
+
+    if (Tcl_IsShared(listPtr) ||
+	    ((ListRepPtr(listPtr)->refCount > 1))) {
+	return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
+    }
+
+    /*
+     * In-place is possible.
+     */
+
+    /*
+     * Even if nothing below cause any changes, we still want the
+     * string-canonizing effect of [lrange 0 end].
+     */
+
+    TclInvalidateStringRep(listPtr);
+
+    /*
+     * Delete elements that should not be included.
+     */
+
+    for (i = 0; i < fromIdx; i++) {
+	TclDecrRefCount(elemPtrs[i]);
+    }
+    for (i = toIdx + 1; i < listLen; i++) {
+	TclDecrRefCount(elemPtrs[i]);
+    }
+
+    if (fromIdx > 0) {
+	memmove(elemPtrs, &elemPtrs[fromIdx],
+		(size_t) newLen * sizeof(Tcl_Obj*));
+    }
+
+    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr->elemCount = newLen;
+
+    return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ListObjGetElements --
  *
  *	This function returns an (objc,objv) array of the elements in a list