summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-03-08 22:26:24 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-03-08 22:26:24 (GMT)
commitb22292c6011d63a4bee083d4afc3678880140fce (patch)
treeab95e21cee07fac78780860666af39f25dcec0af
parent044705529a95670964399979c6f08dbe891338cb (diff)
downloadtcl-b22292c6011d63a4bee083d4afc3678880140fce.zip
tcl-b22292c6011d63a4bee083d4afc3678880140fce.tar.gz
tcl-b22292c6011d63a4bee083d4afc3678880140fce.tar.bz2
* generic/tclListObj.c (TclLsetList): Rewrite so that the routine
itself does not do any direct intrep surgery. Better isolates those things into the implementation of the "list" Tcl_ObjType.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclListObj.c96
2 files changed, 32 insertions, 70 deletions
diff --git a/ChangeLog b/ChangeLog
index a66faa8..0deb5c3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2007-03-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclListObj.c (TclLsetList): Rewrite so that the routine
+ itself does not do any direct intrep surgery. Better isolates those
+ things into the implementation of the "list" Tcl_ObjType.
+
2007-03-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tclListObj.c (TclLindexList, TclLindexFlat): Moved these
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index d6e2ef5..23cbcdc 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclListObj.c,v 1.38 2007/03/08 11:19:33 dkf Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.39 2007/03/08 22:26:25 dgp Exp $
*/
#include "tclInt.h"
@@ -1134,36 +1134,18 @@ TclLindexFlat(
*
* Results:
* Returns the new value of the list variable, or NULL if an error
- * occurs.
+ * occurred. The returned object includes one reference count for
+ * the pointer returned.
*
* Side effects:
- * Surgery is performed on the list value to produce the result.
- *
- * On entry, the reference count of the variable value does not reflect
- * any references held on the stack. The first action of this function is
- * to determine whether the object is shared, and to duplicate it if it
- * is. The reference count of the duplicate is incremented. At this
- * point, the reference count will be 1 for either case, so that the
- * object will appear to be unshared.
- *
- * If an error occurs, and the object has been duplicated, the reference
- * count on the duplicate is decremented so that it is now 0: this
- * dismisses any memory that was allocated by this function.
- *
- * If no error occurs, the reference count of the original object is
- * incremented if the object has not been duplicated, and nothing is done
- * to a reference count of the duplicate. Now the reference count of an
- * unduplicated object is 2 (the returned pointer, plus the one stored in
- * the variable). The reference count of a duplicate object is 1,
- * reflecting that the returned pointer is the only active reference. The
- * caller is expected to store the returned value back in the variable
- * and decrement its reference count. (INST_STORE_* does exactly this.)
+ * None.
*
- * Tcl_LsetFlat and related functions maintain a linked list of Tcl_Obj's
- * whose string representations must be spoilt by threading via 'ptr2' of
- * the two-pointer internal representation. On entry to Tcl_LsetList, the
- * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
- * Tcl_Obj that has been modified is set to NULL.
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLsetFlat. All it does is reconfigure the argument format into the
+ * form required by TclLsetFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
*
*----------------------------------------------------------------------
*/
@@ -1179,8 +1161,7 @@ TclLsetList(
Tcl_Obj **indices; /* Vector of indices in the index list. */
Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */
int index; /* Current index in the list - discarded. */
- int i;
- List *indexListRepPtr;
+ Tcl_Obj *indexListCopy;
/*
* Determine whether the index arg designates a list or a single index.
@@ -1196,8 +1177,10 @@ TclLsetList(
return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
- } else if (Tcl_ListObjGetElements(NULL, indexArgPtr, &indexCount,
- &indices) != TCL_OK) {
+ }
+
+ indexListCopy = TclListObjCopy(NULL, indexArgPtr);
+ if (indexListCopy == NULL) {
/*
* indexArgPtr designates something that is neither an index nor a
* well formed list. Report the error via TclLsetFlat.
@@ -1205,21 +1188,7 @@ TclLsetList(
return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
}
-
- /*
- * At this point, we know that argPtr designates a well formed list, and
- * the 'else if' above has parsed it into indexCount and indices. Increase
- * the reference count of the internal rep of indexArgPtr, in order to
- * insure the validity of pointers even if indexArgPtr shimmers to another
- * type.
- */
-
- if (indexCount) {
- indexListRepPtr = (List *) indexArgPtr->internalRep.twoPtrValue.ptr1;
- indexListRepPtr->refCount++;
- } else {
- indexListRepPtr = NULL; /* Avoid compiler warning. */
- }
+ Tcl_ListObjGetElements(NULL, indexArgPtr, &indexCount, &indices);
/*
* Let TclLsetFlat handle the actual lset'ting.
@@ -1227,19 +1196,7 @@ TclLsetList(
retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);
- /*
- * If we are the only users of indexListRepPtr, we free it before
- * returning.
- */
-
- if (indexCount) {
- if (--indexListRepPtr->refCount <= 0) {
- for (i=0; i<indexCount; i++) {
- Tcl_DecrRefCount(indices[i]);
- }
- ckfree((char *) indexListRepPtr);
- }
- }
+ Tcl_DecrRefCount(indexListCopy);
return retValuePtr;
}
@@ -1248,16 +1205,14 @@ TclLsetList(
*
* TclLsetFlat --
*
- * Core of the 'lset' command when objc>=5. Objv[2], ... , objv[objc-2]
- * contain scalar indices.
+ * Core engine of the 'lset' command.
*
* Results:
* Returns the new value of the list variable, or NULL if an error
- * occurs.
+ * occurred. The returned object includes one reference count for
+ * the pointer returned.
*
* Side effects:
- * Surgery is performed on the list value to produce the result.
- *
* On entry, the reference count of the variable value does not reflect
* any references held on the stack. The first action of this function is
* to determine whether the object is shared, and to duplicate it if it
@@ -1278,11 +1233,12 @@ TclLsetList(
* caller is expected to store the returned value back in the variable
* and decrement its reference count. (INST_STORE_* does exactly this.)
*
- * Tcl_LsetList and related functions maintain a linked list of Tcl_Obj's
- * whose string representations must be spoilt by threading via 'ptr2' of
- * the two-pointer internal representation. On entry to Tcl_LsetList, the
- * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
- * Tcl_Obj that has been modified is set to NULL.
+ * Surgery is performed on the unshared list value to produce the result.
+ * TclLsetFlat maintains a linked list of Tcl_Obj's whose string
+ * representations must be spoilt by threading via 'ptr2' of the two-pointer
+ * internal representation. On entry to TclLsetFlat, the values of 'ptr2' are
+ * immaterial; on exit, the 'ptr2' field of any Tcl_Obj that has been modified
+ * is set to NULL.
*
*----------------------------------------------------------------------
*/