Changed the internal representation of lists to (a) reduce the malloc/free

calls at list creation (from 2 to 1), (b) reduce the cost of handling empty
lists (we now never create a list internal rep for them), (c) allow
refcounting of the list internal rep. The latter permits insuring that the
pointers returned by Tcl_ListObjGetElements remain valid even if the object
shimmers away from its original list type. This is [Patch 1158008]

12 files changed, 530 insertions, 639 deletions

diff --git a/ChangeLog b/ChangeLog
index d11b7ad..a05e3ad 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,23 @@
 2005-04-01  Miguel Sofer <msofer@users.sf.net>
 
+	* doc/ListObj.3:
+	* generic/tclBasic.c:
+	* generic/tclCmdIL.c:
+	* generic/tclConfig.c:
+	* generic/tclExecute.c:
+	* generic/tclInt.decls:
+	* generic/tclInt.h:
+	* generic/tclIntDecls.h:
+	* generic/tclListObj.c:
+	* generic/tclStubInit.c:
+	* generic/tclVar.c: Changed the internal representation of lists
+	to (a) reduce the malloc/free calls at list creation (from 2 to
+	1), (b) reduce the cost of handling empty lists (we now never
+	create a list internal rep for them), (c) allow refcounting of the
+	list internal rep. The latter permits insuring that the pointers
+	returned by Tcl_ListObjGetElements remain valid even if the object
+	shimmers away from its original list type. This is [Patch 1158008]
+	
 	* generic/tclExecute.c:
 	* generic/tclInt.h:
 	* generic/tclObj.c:
diff --git a/doc/ListObj.3 b/doc/ListObj.3
index 9bbf818..8ec698f 100644
--- a/doc/ListObj.3
+++ b/doc/ListObj.3
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: ListObj.3,v 1.8 2004/10/07 16:05:14 dkf Exp $
+'\" RCS: @(#) $Id: ListObj.3,v 1.9 2005/04/02 02:08:29 msofer Exp $
 '\" 
 .so man.macros
 .TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures"
@@ -151,8 +151,9 @@ has reference count zero.
 the elements in a list object.  It returns the count by storing it in the
 address \fIobjcPtr\fR.  Similarly, it returns the array pointer by storing
 it in the address \fIobjvPtr\fR.
-The memory pointed to is managed by Tcl and should not be freed by the
-caller.
+The memory pointed to is managed by Tcl and should not be freed or written
+to by the caller. If the list is empty, 0 is stored at \fIobjcPtr\fR
+and NULL at \fIobjvPtr\fR.
 If \fIlistPtr\fR is not already a list object, \fBTcl_ListObjGetElements\fR
 will attempt to convert it to one; if the conversion fails, it returns
 \fBTCL_ERROR\fR and leaves an error message in the interpreter's result
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1c497dc..bcb8967 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.142 2005/03/18 15:50:59 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.143 2005/04/02 02:08:29 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -3754,26 +3754,31 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 	 */
 	if ((objPtr->typePtr == &tclListType) && /* is a list... */
 		(objPtr->bytes == NULL) /* ...without a string rep */) {	    
-	    List *listRepPtr =
-		(List *) objPtr->internalRep.twoPtrValue.ptr1;
-	    int i, objc = listRepPtr->elemCount;
-	    Tcl_Obj **objv;
+	    List *listRepPtr;
 
 	    /*
-	     * Copy the list elements here, to avoid a segfault if objPtr
-	     * loses its List internal rep [Bug 1119369]
+	     * Increase the reference count of the List structure, to avoid a
+	     * segfault if objPtr loses its List internal rep [Bug 1119369]
 	     */
 	    
-	    objv = (Tcl_Obj **) TclStackAlloc(interp, objc*sizeof(Tcl_Obj *));
-	    for (i=0; i < objc; i++) {
-		objv[i] = listRepPtr->elements[i];
-		Tcl_IncrRefCount(objv[i]);
-	    }
-	    result = Tcl_EvalObjv(interp, objc, objv, flags);
-	    for (i=0; i < objc; i++) {
-		TclDecrRefCount(objv[i]);
+	    listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
+	    listRepPtr->refCount++;
+
+	    result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
+		    &listRepPtr->elements, flags);
+
+	    /*
+	     * If we are the last users of listRepPtr, free it.
+	     */
+
+	    if (--listRepPtr->refCount <= 0) {
+		int i, elemCount = listRepPtr->elemCount;
+		Tcl_Obj **elements = &listRepPtr->elements;
+		for (i=0; i<elemCount; i++) {
+		    Tcl_DecrRefCount(elements[i]);
+		}
+		ckfree((char *) listRepPtr);
 	    }
-	    TclStackFree(interp);
 	} else {
 	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 	    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 746d033..1813fe0 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.71 2004/12/14 21:11:45 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.72 2005/04/02 02:08:31 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2866,8 +2866,9 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
     register Tcl_Obj *CONST objv[];	/* The argument objects. */
 {
     int elementCount, i, result;
-    Tcl_Obj **dataArray;
-
+    Tcl_Obj *listPtr, **dataArray;
+    List *listRepPtr;
+    
     /* 
      * Check arguments for legality:
      *		lrepeat posInt value ?value ...?
@@ -2896,33 +2897,14 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
     objv += 2;
 
     /*
-     * Create workspace array large enough to hold each init value
-     * elementCount times.  Note that we don't bother with stack
-     * allocation for this, as we expect this function to be used
-     * mainly when stack allocation would be inappropriate anyway.
-     * First check to see if we'd overflow and try to allocate an
-     * object larger than our memory allocator allows.  Note that this
-     * is actually a fairly small value when you're on a serious
-     * 64-bit machine, but that requires API changes to fix.
-     *
-     * We allocate using attemptckalloc() because if we ask for
-     * something big but can't get it, we've still got a high chance
-     * of having a proper failover strategy.  If *that* fails to get
-     * memory, Tcl_Panic() will happen just a few lines lower...
+     * Get an empty list object that is allocated large enough to hold each
+     * init value elementCount times.
      */
 
-    if ((unsigned)elementCount > INT_MAX/sizeof(Tcl_Obj *)/objc) {
-	Tcl_AppendResult(interp, "overflow of maximum list length", NULL);
-	return TCL_ERROR;
-    }
-
-    dataArray = (Tcl_Obj **)
-	    attemptckalloc(elementCount * objc * sizeof(Tcl_Obj *));
-
-    if (dataArray == NULL) {
-	Tcl_AppendResult(interp, "insufficient memory to create list", NULL);
-	return TCL_ERROR;
-    }
+    listPtr = Tcl_NewListObj(elementCount*objc, NULL);
+    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    listRepPtr->elemCount = elementCount*objc;
+    dataArray = &listRepPtr->elements;
 
     /*
      * Set the elements.  Note that we handle the common degenerate
@@ -2934,6 +2916,7 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
     if (objc == 1) {
 	register Tcl_Obj *tmpPtr = objv[0];
 
+	tmpPtr->refCount += elementCount;
 	for (i=0 ; i<elementCount ; i++) {
 	    dataArray[i] = tmpPtr;
 	}
@@ -2942,16 +2925,13 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
 
 	for (i=0 ; i<elementCount ; i++) {
 	    for (j=0 ; j<objc ; j++) {
+		Tcl_IncrRefCount(objv[j]);
 		dataArray[k++] = objv[j];
 	    }
 	}
     }
 
-    /*
-     * Build the result list, clean up and return.
-     */
-
-    Tcl_SetObjResult(interp, TclNewListObjDirect(elementCount*objc,dataArray));
+    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 4daf92f..4172fdb 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclConfig.c,v 1.6 2004/10/29 15:39:05 dkf Exp $
+ * RCS: @(#) $Id: tclConfig.c,v 1.7 2005/04/02 02:08:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -196,7 +196,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
      struct Tcl_Obj * CONST *objv;
 {
     Tcl_Obj *pkgName = (Tcl_Obj*) clientData;
-    Tcl_Obj *pDB, *pkgDict, *val;
+    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
     Tcl_DictSearch s;
     int n, i, res, done, index;
     Tcl_Obj *key, **vals;
@@ -248,19 +248,29 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
 	}
 
 	Tcl_DictObjSize(interp, pkgDict, &n);
-	if (n == 0) {
-	    Tcl_SetObjResult(interp, Tcl_NewListObj(0, NULL));
-	    return TCL_OK;
+	listPtr = Tcl_NewListObj(n, NULL);
+	
+	if (!listPtr) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("insufficient memory to create list", -1));
+	    return TCL_ERROR;
 	}
-
-	vals = (Tcl_Obj**) ckalloc(n * sizeof(Tcl_Obj*));
-
-	for (i=0, Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
-		!done; Tcl_DictObjNext(&s, &key, NULL, &done), i++) {
-	    vals[i] = key;
+	
+	if (n) {
+	    List *listRepPtr =
+		(List *) listPtr->internalRep.twoPtrValue.ptr1;
+
+	    listRepPtr->elemCount = n;
+	    vals = &listRepPtr->elements;
+
+	    for (i=0, Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
+		    !done; Tcl_DictObjNext(&s, &key, NULL, &done), i++) {
+		vals[i] = key;
+		Tcl_IncrRefCount(key);
+	    }
 	}
 
-	Tcl_SetObjResult(interp, TclNewListObjDirect(n, vals));
+	Tcl_SetObjResult(interp, listPtr);
 	return TCL_OK;
 
     default:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a66f278..395b7ef 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.176 2005/04/01 19:08:30 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.177 2005/04/02 02:08:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4677,7 +4677,7 @@ TclExecuteByteCode(interp, codePtr)
 	    ForeachVarList *varListPtr;
 	    int numLists;
 	    Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
-	    List *listRepPtr;
+	    Tcl_Obj **elements;
 	    Var *iterVarPtr, *listVarPtr;
 	    int iterNum, listTmpIndex, listLen, numVars;
 	    int varIndex, valIndex, continueLoop, j;
@@ -4739,8 +4739,7 @@ TclExecuteByteCode(interp, codePtr)
 
 		    listVarPtr = &(compiledLocals[listTmpIndex]);
 		    listPtr = listVarPtr->value.objPtr;
-		    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-		    listLen = listRepPtr->elemCount;
+		    TclListObjGetElements(listPtr, listLen, elements);
 			
 		    valIndex = (iterNum * numVars);
 		    for (j = 0;  j < numVars;  j++) {
@@ -4749,7 +4748,7 @@ TclExecuteByteCode(interp, codePtr)
 			    setEmptyStr = 1;
 			    TclNewObj(valuePtr);
 			} else {
-			    valuePtr = listRepPtr->elements[valIndex];
+			    valuePtr = elements[valIndex];
 			}
 			    
 			varIndex = varListPtr->varIndexes[j];
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f59d01e..be0618f 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.85 2004/12/15 20:44:38 msofer Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.86 2005/04/02 02:08:36 msofer Exp $
 
 library tcl
 
@@ -734,14 +734,15 @@ declare 179 generic {
     Tcl_Obj *Tcl_GetStartupScript(CONST char **encodingNamePtr)
 }
 
+# REMOVED
 # Allocate lists without copying arrays
-declare 180 generic {
-    Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
-}
-declare 181 generic {
-    Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
-	    CONST char *file, int line)
-}
+# declare 180 generic {
+#    Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
+# }
+#declare 181 generic {
+#    Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
+#	    CONST char *file, int line)
+#}
 
 # TclpGmtime and TclpLocaltime promoted to the generic interface from unix
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4521ff4..cb72307 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.218 2005/04/01 16:18:59 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.219 2005/04/02 02:08:37 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -1618,20 +1618,34 @@ typedef enum TclEolTranslation {
 
 /*
  * The structure used as the internal representation of Tcl list
- * objects. This is an array of pointers to the element objects. This array
- * is grown (reallocated and copied) as necessary to hold all the list's
- * element pointers. The array might contain more slots than currently used
- * to hold all element pointers. This is done to make append operations
- * faster.
+ * objects. This struct is grown (reallocated and copied) as necessary to hold
+ * all the list's element pointers. The struct might contain more slots than
+ * currently used to hold all element pointers. This is done to make append
+ * operations faster.
  */
 
 typedef struct List {
+    int refCount;
     int maxElemCount;		/* Total number of element array slots. */
     int elemCount;		/* Current number of list elements. */
-    Tcl_Obj **elements;		/* Array of pointers to element objects. */
+    Tcl_Obj *elements;		/* First list element; the struct is grown to
+				 * accomodate all elements. */
 } List;
 
 /*
+ * Macro used to get the elements of a list object - do NOT forget to verify
+ * that it is of list type before using!
+ */
+
+#define TclListObjGetElements(listPtr, objc, objv) \
+    { \
+	List *listRepPtr = \
+	    (List *) (listPtr)->internalRep.twoPtrValue.ptr1;\
+	(objc) = listRepPtr->elemCount;\
+	(objv) = &listRepPtr->elements;\
+    }
+
+/*
  *----------------------------------------------------------------
  * Data structures related to the filesystem internals
  *----------------------------------------------------------------
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 23acb90..5d38426 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIntDecls.h,v 1.76 2004/12/15 20:44:39 msofer Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.77 2005/04/02 02:08:56 msofer Exp $
  */
 
 #ifndef _TCLINTDECLS
@@ -917,18 +917,8 @@ EXTERN void		Tcl_SetStartupScript _ANSI_ARGS_((Tcl_Obj * pathPtr,
 EXTERN Tcl_Obj *	Tcl_GetStartupScript _ANSI_ARGS_((
 				CONST char ** encodingNamePtr));
 #endif
-#ifndef TclNewListObjDirect_TCL_DECLARED
-#define TclNewListObjDirect_TCL_DECLARED
-/* 180 */
-EXTERN Tcl_Obj *	TclNewListObjDirect _ANSI_ARGS_((int objc, 
-				Tcl_Obj ** objv));
-#endif
-#ifndef TclDbNewListObjDirect_TCL_DECLARED
-#define TclDbNewListObjDirect_TCL_DECLARED
-/* 181 */
-EXTERN Tcl_Obj *	TclDbNewListObjDirect _ANSI_ARGS_((int objc, 
-				Tcl_Obj ** objv, CONST char * file, int line));
-#endif
+/* Slot 180 is reserved */
+/* Slot 181 is reserved */
 #ifndef TclpLocaltime_TCL_DECLARED
 #define TclpLocaltime_TCL_DECLARED
 /* 182 */
@@ -1342,8 +1332,8 @@ typedef struct TclIntStubs {
     void (*tclVarErrMsg) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * operation, CONST char * reason)); /* 177 */
     void (*tcl_SetStartupScript) _ANSI_ARGS_((Tcl_Obj * pathPtr, CONST char* encodingName)); /* 178 */
     Tcl_Obj * (*tcl_GetStartupScript) _ANSI_ARGS_((CONST char ** encodingNamePtr)); /* 179 */
-    Tcl_Obj * (*tclNewListObjDirect) _ANSI_ARGS_((int objc, Tcl_Obj ** objv)); /* 180 */
-    Tcl_Obj * (*tclDbNewListObjDirect) _ANSI_ARGS_((int objc, Tcl_Obj ** objv, CONST char * file, int line)); /* 181 */
+    void *reserved180;
+    void *reserved181;
     struct tm * (*tclpLocaltime) _ANSI_ARGS_((CONST time_t * clock)); /* 182 */
     struct tm * (*tclpGmtime) _ANSI_ARGS_((CONST time_t * clock)); /* 183 */
     void (*tclThreadStorageLockInit) _ANSI_ARGS_((void)); /* 184 */
@@ -1988,14 +1978,8 @@ extern TclIntStubs *tclIntStubsPtr;
 #define Tcl_GetStartupScript \
 	(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
 #endif
-#ifndef TclNewListObjDirect
-#define TclNewListObjDirect \
-	(tclIntStubsPtr->tclNewListObjDirect) /* 180 */
-#endif
-#ifndef TclDbNewListObjDirect
-#define TclDbNewListObjDirect \
-	(tclIntStubsPtr->tclDbNewListObjDirect) /* 181 */
-#endif
+/* Slot 180 is reserved */
+/* Slot 181 is reserved */
 #ifndef TclpLocaltime
 #define TclpLocaltime \
 	(tclIntStubsPtr->tclpLocaltime) /* 182 */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 162101c..ddcb062 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -11,7 +11,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.20 2004/11/11 01:17:51 das Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.21 2005/04/02 02:08:59 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -20,6 +20,8 @@
  * Prototypes for procedures defined later in this file:
  */
 
+static List*            NewListIntRep _ANSI_ARGS_((int objc,
+			    Tcl_Obj *CONST objv[]));
 static void		DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr));
 static void		FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
@@ -46,8 +48,78 @@ Tcl_ObjType tclListType = {
     FreeListInternalRep,		/* freeIntRepProc */
     DupListInternalRep,			/* dupIntRepProc */
     UpdateStringOfList,			/* updateStringProc */
-    SetListFromAny			/* setFromAnyProc */
+    NULL 			        /* setFromAnyProc */
 };
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewListIntRep --
+ *
+ *	If objc>0 and objv!=NULL, this procedure creates a list internal rep
+ *	with objc elements given in the array objv.
+ *      If objc>0 and objv==NULL it creates the list internal rep of a list
+ *	with 0 elements, where enough space has been preallocated to store
+ *	objc elements.
+ *      If objc<=0, it returns NULL.
+ *
+ * Results:
+ *	A new List struct is returned. If objc<=0 or if the allocation fails
+ *      for lack of memory, NULL is returned.
+ *      The list returned has refCount 0.
+ *
+ * Side effects:
+ *	The ref counts of the elements in objv are incremented since the
+ *	resulting list now refers to them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+List*
+NewListIntRep(objc, objv)
+    int objc;
+    Tcl_Obj *CONST objv[];
+{
+    Tcl_Obj **elemPtrs;
+    List *listRepPtr;
+    int i;
+
+    if (objc <= 0) {
+	return NULL;
+    }
+
+    /* First check to see if we'd overflow and try to allocate an
+     * object larger than our memory allocator allows.  Note that this
+     * is actually a fairly small value when you're on a serious
+     * 64-bit machine, but that requires API changes to fix.
+     */
+    
+    if (objc > INT_MAX/sizeof(Tcl_Obj *)) {
+	return NULL;
+    }
+    
+    listRepPtr = (List *) attemptckalloc(sizeof(List) +
+	    ((objc-1) * sizeof(Tcl_Obj *)));
+    if (listRepPtr == NULL) {
+	return NULL;
+    }
+
+    listRepPtr->refCount = 0;
+    listRepPtr->maxElemCount = objc;
+
+    if (objv) {
+	listRepPtr->elemCount = objc;
+	elemPtrs = &listRepPtr->elements;
+	for (i = 0;  i < objc;  i++) {
+	    elemPtrs[i] = objv[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}    
+    } else {
+	listRepPtr->elemCount = 0;
+    }
+    return listRepPtr;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -93,32 +165,34 @@ Tcl_NewListObj(objc, objv)
     int objc;			/* Count of objects referenced by objv. */
     Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
 {
-    register Tcl_Obj *listPtr;
-    register Tcl_Obj **elemPtrs;
-    register List *listRepPtr;
-    int i;
+    List *listRepPtr;
+    Tcl_Obj *listPtr;
 
     TclNewObj(listPtr);
 
-    if (objc > 0) {
-	Tcl_InvalidateStringRep(listPtr);
+    if (objc <= 0) {
+	return listPtr;
+    }
+    
+    /*
+     * Create the internal rep.
+     */
 
-	elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
-	for (i = 0;  i < objc;  i++) {
-	    elemPtrs[i] = objv[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
-	}
+    listRepPtr = NewListIntRep(objc, objv);
+    if (!listRepPtr) {
+	Tcl_Panic("Not enough memory to create the list\n");
+    }
 
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = elemPtrs;
+    /*
+     * Now create the object.
+     */
+        
+    Tcl_InvalidateStringRep(listPtr);
+    listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    listPtr->typePtr = &tclListType;
+    listRepPtr->refCount++;
 
-	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-	listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	listPtr->typePtr = &tclListType;
-    }
     return listPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -163,32 +237,34 @@ Tcl_DbNewListObj(objc, objv, file, line)
     int line;			/* Line number in the source file; used
 				 * for debugging. */
 {
-    register Tcl_Obj *listPtr;
-    register Tcl_Obj **elemPtrs;
-    register List *listRepPtr;
-    int i;
+    Tcl_Obj *listPtr;
+    List *listRepPtr;
 
     TclDbNewObj(listPtr, file, line);
 
-    if (objc > 0) {
-	Tcl_InvalidateStringRep(listPtr);
+    if (objc <= 0) {
+	return listPtr;
+    }
+    
+    /*
+     * Create the internal rep.
+     */
 
-	elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
-	for (i = 0;  i < objc;  i++) {
-	    elemPtrs[i] = objv[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
-	}
+    listRepPtr = NewListIntRep(objc, objv);
+    if (!listRepPtr) {
+	Tcl_Panic("Not enough memory to create the list\n");
+    }
 
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = elemPtrs;
+    /*
+     * Now create the object.
+     */
+    
+    Tcl_InvalidateStringRep(listPtr);
+    listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    listPtr->typePtr = &tclListType;
+    listRepPtr->refCount++;
 
-	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-	listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	listPtr->typePtr = &tclListType;
-    }
     return listPtr;
 }
 
@@ -210,120 +286,6 @@ Tcl_DbNewListObj(objc, objv, file, line)
 /*
  *----------------------------------------------------------------------
  *
- * TclNewListObjDirect, TclDbNewListObjDirect --
- *
- *	Version of Tcl_NewListOb/Tcl_DbNewListObj that does not copy
- *	the array of Tcl_Objs. It still scans it though to update the
- *	reference counts.
- *
- * Results:
- *	A new list object is returned that is initialized from the object
- *	pointers in objv. If objc is less than or equal to zero, an empty
- *	object is returned (and "ownership" of the array of objects is
- *	not transferred.) The new object's string representation is left
- *	NULL. The resulting new list object has ref count 0.
- *
- * Side effects:
- *	The ref counts of the elements in objv are incremented since the
- *	resulting list now refers to them.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef TclNewListObjDirect
-Tcl_Obj *
-TclNewListObjDirect(objc, objv)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj **objv;		/* An array of pointers to Tcl objects. */
-{
-    return TclDbNewListObjDirect(objc, objv, "unknown", 0);
-}
-#else /* !TCL_MEM_DEBUG */
-Tcl_Obj *
-TclNewListObjDirect(objc, objv)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj **objv;		/* An array of pointers to Tcl objects. */
-{
-    register Tcl_Obj *listPtr;
-
-    TclNewObj(listPtr);
-
-    if (objc > 0) {
-	register List *listRepPtr;
-	int i;
-
-	Tcl_InvalidateStringRep(listPtr);
-
-	for (i=0 ; i<objc ; i++) {
-	    Tcl_IncrRefCount(objv[i]);
-	}
-
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = objv;
-
-	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-	listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	listPtr->typePtr = &tclListType;
-    }
-    return listPtr;
-}
-#endif /* TCL_MEM_DEBUG */
-
-#ifdef TCL_MEM_DEBUG
-Tcl_Obj *
-TclDbNewListObjDirect(objc, objv, file, line)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj **objv;		/* An array of pointers to Tcl objects. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
-{
-    register Tcl_Obj *listPtr;
-
-    TclDbNewObj(listPtr, file, line);
-
-    if (objc > 0) {
-	register List *listRepPtr;
-	int i;
-
-	Tcl_InvalidateStringRep(listPtr);
-
-	for (i=0 ; i<objc ; i++) {
-	    Tcl_IncrRefCount(objv[i]);
-	}
-
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = objv;
-
-	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
-	listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	listPtr->typePtr = &tclListType;
-    }
-    return listPtr;
-}
-#else /* !TCL_MEM_DEBUG */
-Tcl_Obj *
-TclDbNewListObjDirect(objc, objv, file, line)
-    int objc;			/* Count of objects referenced by objv. */
-    Tcl_Obj **objv;		/* An array of pointers to Tcl objects. */
-    CONST char *file;		/* The name of the source file calling this
-				 * procedure; used for debugging. */
-    int line;			/* Line number in the source file; used
-				 * for debugging. */
-{
-    return TclNewListObjDirect(objc, objv);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_SetListObj --
  *
  *	Modify an object to be a list containing each of the objc elements
@@ -349,9 +311,7 @@ Tcl_SetListObj(objPtr, objc, objv)
     int objc;			/* Count of objects referenced by objv. */
     Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
 {
-    register Tcl_Obj **elemPtrs;
-    register List *listRepPtr;
-    int i;
+    List *listRepPtr;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("Tcl_SetListObj called with shared object");
@@ -372,21 +332,14 @@ Tcl_SetListObj(objPtr, objc, objv)
      */
 
     if (objc > 0) {
-	elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
-	for (i = 0;  i < objc;  i++) {
-	    elemPtrs[i] = objv[i];
-	    Tcl_IncrRefCount(elemPtrs[i]);
+	listRepPtr = NewListIntRep(objc, objv);
+	if (!listRepPtr) {
+	    Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
 	}
-
-	listRepPtr = (List *) ckalloc(sizeof(List));
-	listRepPtr->maxElemCount = objc;
-	listRepPtr->elemCount    = objc;
-	listRepPtr->elements     = elemPtrs;
-
 	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
 	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 	objPtr->typePtr = &tclListType;
+	listRepPtr->refCount++;
     } else {
 	objPtr->bytes = tclEmptyStringRep;
 	objPtr->length = 0;
@@ -436,14 +389,23 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
     register List *listRepPtr;
 
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result, length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (!length) {
+	    *objcPtr = 0;
+	    *objvPtr = NULL;
+	    return TCL_OK;
+	}
+
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
     *objcPtr = listRepPtr->elemCount;
-    *objvPtr = listRepPtr->elements;
+    *objvPtr = &listRepPtr->elements;
     return TCL_OK;
 }
 
@@ -479,21 +441,17 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
     register Tcl_Obj *listPtr;	/* List object to append elements to. */
     Tcl_Obj *elemListPtr;	/* List obj with elements to append. */
 {
-    register List *listRepPtr;
     int listLen, objc, result;
     Tcl_Obj **objv;
 
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("Tcl_ListObjAppendList called with shared object");
     }
-    if (listPtr->typePtr != &tclListType) {
-	result = SetListFromAny(interp, listPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+
+    result = Tcl_ListObjLength(interp, listPtr, &listLen);
+    if (result != TCL_OK) {
+	return result;
     }
-    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    listLen = listRepPtr->elemCount;
 
     result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
     if (result != TCL_OK) {
@@ -543,40 +501,66 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
 {
     register List *listRepPtr;
     register Tcl_Obj **elemPtrs;
-    int numElems, numRequired;
+    int numElems, numRequired, newMax, newSize, i;
 
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("Tcl_ListObjAppendElement called with shared object");
     }
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result, length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (!length) {
+	    Tcl_SetListObj(listPtr, 1, &objPtr);
+	    return TCL_OK;
+	}
+
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
 
     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    elemPtrs = listRepPtr->elements;
     numElems = listRepPtr->elemCount;
     numRequired = numElems + 1 ;
 
     /*
      * If there is no room in the current array of element pointers,
-     * allocate a new, larger array and copy the pointers to it.
+     * allocate a new, larger array and copy the pointers to it. If the
+     * List struct is shared, allocate a new one.
      */
 
-    if (numRequired > listRepPtr->maxElemCount) {
-	int newMax = (2 * numRequired);
-	Tcl_Obj **newElemPtrs = (Tcl_Obj **)
-		ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-
-	memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
-		(size_t) (numElems * sizeof(Tcl_Obj *)));
+    if (numRequired > listRepPtr->maxElemCount){
+	newMax = (2 * numRequired);
+	newSize = sizeof(List)+((newMax-1)*sizeof(Tcl_Obj*));
+    } else {
+	newMax = listRepPtr->maxElemCount;
+	newSize = 0;
+    }
 
+    if (listRepPtr->refCount > 1) {
+	List *oldListRepPtr = listRepPtr;
+	Tcl_Obj **oldElems;
+	
+	listRepPtr = NewListIntRep(newMax, NULL);
+	if (!listRepPtr) {
+	    Tcl_Panic("Not enough memory to allocate list");
+	}
+	oldElems = &oldListRepPtr->elements;
+	elemPtrs = &listRepPtr->elements;
+	for (i=0; i<numElems; i++) {
+	    elemPtrs[i] = oldElems[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	listRepPtr->elemCount = numElems;
+	listRepPtr->refCount++; 
+	oldListRepPtr->refCount--;
+	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+    } else if (newSize) {
+	listRepPtr = (List *) ckrealloc((char *)listRepPtr, newSize);
 	listRepPtr->maxElemCount = newMax;
-	listRepPtr->elements = newElemPtrs;
-	ckfree((char *) elemPtrs);
-	elemPtrs = newElemPtrs;
+	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
     }
 
     /*
@@ -584,6 +568,7 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
      * pointers. Increment the ref count for the (now shared) objPtr.
      */
 
+    elemPtrs = &listRepPtr->elements;
     elemPtrs[numElems] = objPtr;
     Tcl_IncrRefCount(objPtr);
     listRepPtr->elemCount++;
@@ -633,7 +618,14 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
     register List *listRepPtr;
 
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result, length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (!length) {
+	    return 0;
+	}
+
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
@@ -643,7 +635,7 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
     if ((index < 0) || (index >= listRepPtr->elemCount)) {
 	*objPtrPtr = NULL;
     } else {
-	*objPtrPtr = listRepPtr->elements[index];
+	*objPtrPtr = (&listRepPtr->elements)[index];
     }
 
     return TCL_OK;
@@ -680,7 +672,15 @@ Tcl_ListObjLength(interp, listPtr, intPtr)
     register List *listRepPtr;
 
     if (listPtr->typePtr != &tclListType) {
-	int result = SetListFromAny(interp, listPtr);
+	int result, length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (!length) {
+	    *intPtr = 0;
+	    return TCL_OK;
+	}
+
+	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
@@ -740,22 +740,35 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
 				 * to insert. */
 {
     List *listRepPtr;
-    register Tcl_Obj **elemPtrs, **newPtrs;
+    register Tcl_Obj **elemPtrs;
     Tcl_Obj *victimPtr;
     int numElems, numRequired, numAfterLast;
     int start, shift, newMax, i, j, result;
-
+    int isShared;
+    
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("Tcl_ListObjReplace called with shared object");
     }
     if (listPtr->typePtr != &tclListType) {
-	result = SetListFromAny(interp, listPtr);
-	if (result != TCL_OK) {
-	    return result;
+	int length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (!length) {
+	    if (objc) {
+		Tcl_SetListObj(listPtr, objc, NULL);
+	    } else {
+	       return TCL_OK;
+	    }
+	} else {	    
+	    result = SetListFromAny(interp, listPtr);
+	    if (result != TCL_OK) {
+		return result;
+	    }
 	}
     }
+    
     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    elemPtrs = listRepPtr->elements;
+    elemPtrs = &listRepPtr->elements;
     numElems = listRepPtr->elemCount;
 
     if (first < 0)  {
@@ -766,16 +779,21 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
     }
     if (count < 0) {
 	count = 0;
+    } else if (numElems < first+count) {
+	count = numElems - first;
     }
 
+    isShared = (listRepPtr->refCount > 1);    
     numRequired = (numElems - count + objc);
-    if (numRequired <= listRepPtr->maxElemCount) {
+    
+    if ((numRequired <= listRepPtr->maxElemCount)
+	    && !isShared) {
 	/*
-	 * Enough room in the current array. First "delete" count
+	 * Can use the current List struct. First "delete" count
 	 * elements starting at first.
 	 */
 
-	for (i = 0, j = first;  i < count;  i++, j++) {
+	for (j = first;  j < first + count;  j++) {
 	    victimPtr = elemPtrs[j];
 	    TclDecrRefCount(victimPtr);
 	}
@@ -795,79 +813,100 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
 	    memmove((VOID*) dst, (VOID*) src, 
 	            (size_t) (numAfterLast * sizeof(Tcl_Obj*)));
 	}
-
-	/*
-	 * Insert the new elements into elemPtrs before "first".
-	 */
-
-	for (i=0,j=first ; i<objc ; i++,j++) {
-	    elemPtrs[j] = objv[i];
-	    Tcl_IncrRefCount(objv[i]);
-	}
-
-	/*
-	 * Update the count of elements.
-	 */
-
-	listRepPtr->elemCount = numRequired;
     } else {
 	/*
-	 * Not enough room in the current array. Allocate a larger array and
-	 * insert elements into it. 
+	 * Cannot use the current List struct - it is shared, too small,
+	 * or both. Allocate a new struct and insert elements into it.
 	 */
 
-	newMax = (2 * numRequired);
-	newPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-
-	/*
-	 * Copy over the elements before "first".
-	 */
+	List *oldListRepPtr = listRepPtr;
+	Tcl_Obj **oldPtrs = elemPtrs;
 
-	if (first > 0) {
-	    memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
-		    (size_t) (first * sizeof(Tcl_Obj *)));
+	if (numRequired > listRepPtr->maxElemCount){
+	    newMax = (2 * numRequired);
+	} else {
+	    newMax = listRepPtr->maxElemCount;
+	}
+	
+	listRepPtr = NewListIntRep(newMax, NULL);
+	if (!listRepPtr) {
+	    Tcl_Panic("Not enough memory to allocate list");
 	}
 
-	/*
-	 * "Delete" count elements starting at first.
-	 */
+	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+	listRepPtr->refCount++;
+
+	elemPtrs = &listRepPtr->elements;
+	
+	if (isShared) {
+	    /*
+	     * The old struct will remain in place; need new refCounts for the
+	     * new List struct references. Copy over only the surviving elements.
+	     */
 
-	for (i = 0, j = first;  i < count;  i++, j++) {
-	    victimPtr = elemPtrs[j];
-	    TclDecrRefCount(victimPtr);
-	}
+	    for (i=0; i < first; i++) {
+		elemPtrs[i] = oldPtrs[i];
+		Tcl_IncrRefCount(elemPtrs[i]);
+	    }
+	    for (i= first + count, j = first + objc;
+		    j < numRequired; i++, j++) {
+		elemPtrs[j] = oldPtrs[i];
+		Tcl_IncrRefCount(elemPtrs[j]);
+	    }
 
-	/*
-	 * Copy the elements after the last one removed, shifted to
-	 * their new locations.
-	 */
+	    oldListRepPtr->refCount--;
+	} else {
+	    /*
+	     * The old struct will be removed; use its inherited refCounts. 
+	     */
 
-	start = (first + count);
-	numAfterLast = (numElems - start);
-	if (numAfterLast > 0) {
-	    memcpy((VOID *) &(newPtrs[first + objc]),
-		    (VOID *) &(elemPtrs[start]),
-		    (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
-	}
+	    if (first > 0) {
+		memcpy((VOID *) elemPtrs, (VOID *) oldPtrs,
+			(size_t) (first * sizeof(Tcl_Obj *)));
+	    }
 
-	/*
-	 * Insert the new elements before "first" and update the
-	 * count of elements.
-	 */
+	    /*
+	     * "Delete" count elements starting at first.
+	     */
+	    
+	    for (j = first;  j < first + count;  j++) {
+		victimPtr = oldPtrs[j];
+		TclDecrRefCount(victimPtr);
+	    }
+	    
+	    /*
+	     * Copy the elements after the last one removed, shifted to
+	     * their new locations.
+	     */
+	    
+	    start = (first + count);
+	    numAfterLast = (numElems - start);
+	    if (numAfterLast > 0) {
+		memcpy((VOID *) &(elemPtrs[first + objc]),
+			(VOID *) &(oldPtrs[start]),
+			(size_t) (numAfterLast * sizeof(Tcl_Obj *)));
+	    }
 
-	for (i = 0, j = first;  i < objc;  i++, j++) {
-	    newPtrs[j] = objv[i];
-	    Tcl_IncrRefCount(objv[i]);
+	    ckfree((char *) oldListRepPtr);
 	}
-
-	listRepPtr->elemCount = numRequired;
-	listRepPtr->maxElemCount = newMax;
-	listRepPtr->elements = newPtrs;
-	ckfree((char *) elemPtrs);
     }
 
     /*
+     * Insert the new elements into elemPtrs before "first".
+     */
+    
+    for (i=0,j=first ; i<objc ; i++,j++) {
+	elemPtrs[j] = objv[i];
+	Tcl_IncrRefCount(objv[i]);
+    }
+    
+    /*
+     * Update the count of elements.
+     */
+    
+    listRepPtr->elemCount = numRequired;
+    
+    /*
      * Invalidate and free any old string representation since it no longer
      * reflects the list's internal representation.
      */
@@ -932,18 +971,11 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr)
 {
     int indexCount;		/* Number of indices in the index list */
     Tcl_Obj** indices;		/* Vector of indices in the index list*/
-    int duplicated;		/* Flag == 1 if the obj has been
-				 * duplicated, 0 otherwise */
     Tcl_Obj* retValuePtr;	/* Pointer to the list to be returned */
     int index;			/* Current index in the list - discarded */
-    int result;			/* Status return from library calls */
-    Tcl_Obj* subListPtr;	/* Pointer to the current sublist */
-    int elemCount;		/* Count of elements in the current sublist */
-    Tcl_Obj** elemPtrs;		/* Pointers to elements of current sublist  */
-    Tcl_Obj* chainPtr;		/* Pointer to the enclosing sublist
-				 * of the current sublist */
     int i;
-
+    List *indexListRepPtr;
+    
     /*
      * Determine whether the index arg designates a list or a single
      * index.  We have to be careful about the order of the checks to
@@ -971,165 +1003,39 @@ TclLsetList(interp, listPtr, 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.
-     * If there are no indices, simply return 'valuePtr', counting the
-     * returned pointer as a reference.
-     */
-
-    if (indexCount == 0) {
-	Tcl_IncrRefCount(valuePtr);
-	return valuePtr;
-    }
-
-    /*
-     * Duplicate the list arg if necessary.
+     * 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 (Tcl_IsShared(listPtr)) {
-	duplicated = 1;
-	listPtr = Tcl_DuplicateObj(listPtr);
-	Tcl_IncrRefCount(listPtr);
+    if (indexCount) {
+	indexListRepPtr = (List *) indexArgPtr->internalRep.twoPtrValue.ptr1;
+	indexListRepPtr->refCount++;
     } else {
-	duplicated = 0;
+	indexListRepPtr = NULL; /* avoid compiler warning*/
     }
+				  
 
     /*
-     * It would be tempting simply to go off to TclLsetFlat to finish the
-     * processing.  Alas, it is also incorrect!  The problem is that
-     * 'indexArgPtr' may designate a sublist of 'listPtr' whose value
-     * is to be manipulated.  The fact that 'listPtr' is itself unshared
-     * does not guarantee that no sublist is.  Therefore, it's necessary
-     * to replicate all the work here, expanding the index list on each
-     * trip through the loop.
+     * Let TclLsetFlat handle the actual lset'ting.
      */
 
-    /*
-     * Anchor the linked list of Tcl_Obj's whose string reps must be
-     * invalidated if the operation succeeds.
-     */
-
-    retValuePtr = listPtr;
-    chainPtr = NULL;
+    retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);
 
     /*
-     * Handle each index arg by diving into the appropriate sublist
+     * If we are the only users of indexListRepPtr, we free it before
+     * returning. 
      */
-
-    for (i=0 ; ; i++) {
-	/*
-	 * Take the sublist apart.
-	 */
-
-	result = Tcl_ListObjGetElements(interp, listPtr, &elemCount, &elemPtrs);
-	if (result != TCL_OK) {
-	    break;
-	}
-	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
-
-	/*
-	 * Reconstitute the index array
-	 */
-
-	result = Tcl_ListObjGetElements(interp, indexArgPtr, &indexCount,
-		&indices);
-	if (result != TCL_OK) {
-	    /* 
-	     * Shouldn't be able to get here, because we already
-	     * parsed the thing successfully once.
-	     */
-	    break;
-	}
-
-	/*
-	 * Determine the index of the requested element.
-	 */
-
-	result = TclGetIntForIndex(interp, indices[i], elemCount-1, &index);
-	if (result != TCL_OK) {
-	    break;
-	}
-
-	/*
-	 * Check that the index is in range.
-	 */
-
-	if (index<0 || index>=elemCount) {
-	    Tcl_SetObjResult(interp,
-		    Tcl_NewStringObj("list index out of range", -1));
-	    result = TCL_ERROR;
-	    break;
-	}
-
-	/*
-	 * Break the loop after extracting the innermost sublist
-	 */
-
-	if (i >= indexCount-1) {
-	    result = TCL_OK;
-	    break;
-	}
-
-	/*
-	 * Extract the appropriate sublist, and make sure that it is unshared.
-	 */
-
-	subListPtr = elemPtrs[index];
-	if (Tcl_IsShared(subListPtr)) {
-	    subListPtr = Tcl_DuplicateObj(subListPtr);
-	    result = TclListObjSetElement(interp, listPtr, index, subListPtr);
-	    if (result != TCL_OK) {
-		/* 
-		 * We actually shouldn't be able to get here, because
-		 * we've already checked everything that TclListObjSetElement
-		 * checks. If we were to get here, it would result in leaking
-		 * subListPtr.
-		 */
-		break;
+    
+    if (indexCount) {
+	if (--indexListRepPtr->refCount <= 0) {
+	    for (i=0; i<indexCount; i++) {
+		Tcl_DecrRefCount(indices[i]);
 	    }
+	    ckfree((char *) indexListRepPtr);
 	}
-
-	/* 
-	 * Chain the current sublist onto the linked list of Tcl_Obj's
-	 * whose string reps must be spoilt.
-	 */
-
-	chainPtr = listPtr;
-	listPtr = subListPtr;
     }
-
-    /*
-     * Store the new element into the correct slot in the innermost sublist.
-     */
-
-    if (result == TCL_OK) {
-	result = TclListObjSetElement(interp, listPtr, index, valuePtr);
-    }
-
-    if (result == TCL_OK) {
-	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
-
-	/* Spoil all the string reps */
-
-	while (listPtr != NULL) {
-	    subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
-	    Tcl_InvalidateStringRep(listPtr);
-	    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	    listPtr = subListPtr;
-	}
-
-	/* Return the new list if everything worked. */
-
-	if (!duplicated) {
-	    Tcl_IncrRefCount(retValuePtr);
-	}
-	return retValuePtr;
-    }
-
-    /* Clean up the one dangling reference otherwise */
-
-    if (duplicated) {
-	Tcl_DecrRefCount(retValuePtr);
-    }
-    return NULL;
+    return retValuePtr;
 }
 
 /*
@@ -1200,7 +1106,7 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
 				 * the current sublist. */
     int result;			/* Status return from library calls */
     int i;
-
+    
     /*
      * If there are no indices, then simply return the new value,
      * counting the returned pointer as a reference
@@ -1244,6 +1150,12 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
 	if (result != TCL_OK) {
 	    break;
 	}
+	if (elemCount == 0) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("list index out of range", -1));
+	    result = TCL_ERROR;
+	    break;
+	}
 	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
 
 	/*
@@ -1358,10 +1270,10 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
  * Side effects:
  *
  *	Tcl_Panic if listPtr designates a shared object.  Otherwise,
- *	attempts to convert it to a list.  Decrements the ref count of
- *	the object at the specified index within the list, replaces with
- *	the object designated by valuePtr, and increments the ref count
- *	of the replacement object.  
+ *	attempts to convert it to a list with a non-shared internal rep.
+ *	Decrements the ref count of the object at the specified index within
+ *	the list, replaces with the object designated by valuePtr, and
+ *	increments the ref count of the replacement object.  
  *
  * It is the caller's responsibility to invalidate the string
  * representation of the object.
@@ -1384,23 +1296,33 @@ TclListObjSetElement(interp, listPtr, index, valuePtr)
 				 * being modified */
     Tcl_Obj** elemPtrs;		/* Pointers to elements of the list */
     int elemCount;		/* Number of elements in the list */
-
+    int i;
+    
     /* Ensure that the listPtr parameter designates an unshared list */
 
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("Tcl_ListObjSetElement called with shared object");
     }
     if (listPtr->typePtr != &tclListType) {
+	int length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (!length) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("list index out of range", -1));
+	    return TCL_ERROR;
+	}
 	result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
+    
     listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
-    elemPtrs = listRepPtr->elements;
     elemCount = listRepPtr->elemCount;
+    elemPtrs = &listRepPtr->elements;
 
-    /* Ensure that the index is in bounds */
+    /* Ensure that the index is in bounds. */
 
     if (index<0 || index>=elemCount) {
 	if (interp != NULL) {
@@ -1410,6 +1332,26 @@ TclListObjSetElement(interp, listPtr, index, valuePtr)
 	}
     }
 
+    /*
+     * If the internal rep is shared, replace it with an unshared copy.
+     */
+
+    if (listRepPtr->refCount > 1) {
+	List *oldListRepPtr = listRepPtr;
+	Tcl_Obj **oldElemPtrs = elemPtrs;
+	
+	listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL);
+	elemPtrs = &listRepPtr->elements;
+	for (i=0; i < elemCount; i++) {
+	    elemPtrs[i] = oldElemPtrs[i];
+	    Tcl_IncrRefCount(elemPtrs[i]);
+	}
+	listRepPtr->refCount++;
+	listRepPtr->elemCount = elemCount;
+	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+	oldListRepPtr->refCount--;
+    }
+
     /* Add a reference to the new list element */
 
     Tcl_IncrRefCount(valuePtr);
@@ -1449,18 +1391,19 @@ FreeListInternalRep(listPtr)
     Tcl_Obj *listPtr;		/* List object with internal rep to free. */
 {
     register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
-    register Tcl_Obj **elemPtrs = listRepPtr->elements;
+    register Tcl_Obj **elemPtrs = &listRepPtr->elements;
     register Tcl_Obj *objPtr;
     int numElems = listRepPtr->elemCount;
     int i;
 
-    for (i = 0;  i < numElems;  i++) {
-	objPtr = elemPtrs[i];
-	Tcl_DecrRefCount(objPtr);
+    if (--listRepPtr->refCount <= 0) {
+	for (i = 0;  i < numElems;  i++) {
+	    objPtr = elemPtrs[i];
+	    Tcl_DecrRefCount(objPtr);
+	}
+	ckfree((char *) listRepPtr);	
     }
-    ckfree((char *) elemPtrs);
-    ckfree((char *) listRepPtr);
-
+    
     listPtr->internalRep.twoPtrValue.ptr1 = NULL;
     listPtr->internalRep.twoPtrValue.ptr2 = NULL;
 }
@@ -1470,19 +1413,14 @@ FreeListInternalRep(listPtr)
  *
  * DupListInternalRep --
  *
- *	Initialize the internal representation of a list Tcl_Obj to a
- *	copy of the internal representation of an existing list object. 
+ *	Initialize the internal representation of a list Tcl_Obj to share
+ *	the internal representation of an existing list object. 
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	"srcPtr"s list internal rep pointer should not be NULL and we assume
- *	it is not NULL. We set "copyPtr"s internal rep to a pointer to a
- *	newly allocated List structure that, in turn, points to "srcPtr"s
- *	element objects. Those element objects are not actually copied but
- *	are shared between "srcPtr" and "copyPtr". The ref count of each
- *	element object is incremented.
+ *      The reference count of the List internal rep is incremented.
  *
  *----------------------------------------------------------------------
  */
@@ -1492,33 +1430,10 @@ DupListInternalRep(srcPtr, copyPtr)
     Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
     Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
 {
-    List *srcListRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
-    int numElems = srcListRepPtr->elemCount;
-    int maxElems = srcListRepPtr->maxElemCount;
-    register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
-    register Tcl_Obj **copyElemPtrs;
-    register List *copyListRepPtr;
-    int i;
-
-    /*
-     * Allocate a new List structure that points to "srcPtr"s element
-     * objects. Increment the ref counts for those (now shared) element
-     * objects.
-     */
-
-    copyElemPtrs = (Tcl_Obj **)
-	ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
-    for (i = 0;  i < numElems;  i++) {
-	copyElemPtrs[i] = srcElemPtrs[i];
-	Tcl_IncrRefCount(copyElemPtrs[i]);
-    }
+    List *listRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
 
-    copyListRepPtr = (List *) ckalloc(sizeof(List));
-    copyListRepPtr->maxElemCount = maxElems;
-    copyListRepPtr->elemCount    = numElems;
-    copyListRepPtr->elements     = copyElemPtrs;
-
-    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
+    listRepPtr->refCount++;
+    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
     copyPtr->typePtr = &tclListType;
 }
@@ -1587,8 +1502,14 @@ SetListFromAny(interp, objPtr)
      * corresponding "argv" strings.
      */
 
-    elemPtrs = (Tcl_Obj **)
-	    ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
+    listRepPtr = NewListIntRep(estCount, NULL);
+    if(!listRepPtr) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("Not enough memory to allocate the list internal rep",-1));
+	return TCL_ERROR;
+    }
+    elemPtrs = &listRepPtr->elements;
+    
     for (p = string, lenRemain = length, i = 0;
 	    lenRemain > 0;
 	    p = nextElem, lenRemain = (limit - nextElem), i++) {
@@ -1599,7 +1520,7 @@ SetListFromAny(interp, objPtr)
 		elemPtr = elemPtrs[j];
 		Tcl_DecrRefCount(elemPtr);
 	    }
-	    ckfree((char *) elemPtrs);
+	    ckfree((char *) listRepPtr);
 	    return result;
 	}
 	if (elemStart >= limit) {
@@ -1629,10 +1550,7 @@ SetListFromAny(interp, objPtr)
 	Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
     }
 
-    listRepPtr = (List *) ckalloc(sizeof(List));
-    listRepPtr->maxElemCount = estCount;
     listRepPtr->elemCount    = i;
-    listRepPtr->elements     = elemPtrs;
 
     /*
      * Free the old internalRep before setting the new one. We do this as
@@ -1640,6 +1558,7 @@ SetListFromAny(interp, objPtr)
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
+    listRepPtr->refCount++;
     TclFreeIntRep(objPtr);
     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -1679,7 +1598,8 @@ UpdateStringOfList(listPtr)
     register int i;
     char *elem, *dst;
     int length;
-
+    Tcl_Obj **elemPtrs;
+    
     /*
      * Convert each element of the list to string form and then convert it
      * to proper list element form, adding it to the result buffer.
@@ -1695,8 +1615,9 @@ UpdateStringOfList(listPtr)
 	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
     }
     listPtr->length = 1;
+    elemPtrs = &listRepPtr->elements;
     for (i = 0; i < numElems; i++) {
-	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
 	listPtr->length += Tcl_ScanCountedElement(elem, length,
 		&flagPtr[i]) + 1;
     }
@@ -1708,7 +1629,7 @@ UpdateStringOfList(listPtr)
     listPtr->bytes = ckalloc((unsigned) listPtr->length);
     dst = listPtr->bytes;
     for (i = 0; i < numElems; i++) {
-	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
 	dst += Tcl_ConvertCountedElement(elem, length, dst,
 		flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
 	*dst = ' ';
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 29ed7bb..6dfe793 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.113 2005/01/27 00:23:27 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.114 2005/04/02 02:08:59 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -264,8 +264,8 @@ TclIntStubs tclIntStubs = {
     TclVarErrMsg, /* 177 */
     Tcl_SetStartupScript, /* 178 */
     Tcl_GetStartupScript, /* 179 */
-    TclNewListObjDirect, /* 180 */
-    TclDbNewListObjDirect, /* 181 */
+    NULL, /* 180 */
+    NULL, /* 181 */
     TclpLocaltime, /* 182 */
     TclpGmtime, /* 183 */
     TclThreadStorageLockInit, /* 184 */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 362449a..dc8162e 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.101 2004/12/14 21:11:47 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.102 2005/04/02 02:09:01 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2468,11 +2468,10 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     Tcl_Obj *varValuePtr, *newValuePtr;
-    register List *listRepPtr;
-    register Tcl_Obj **elemPtrs;
-    int numElems, numRequired, createdNewObj, createVar, i, j;
+    int numElems, createdNewObj, createVar;
     Var *varPtr, *arrayPtr;
     char *part1;
+    int result;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
@@ -2549,60 +2548,19 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
 	    createdNewObj = 1;
 	}
 
-	/*
-	 * Convert the variable's old value to a list object if necessary.
-	 */
-
-	if (varValuePtr->typePtr != &tclListType) {
-	    int result = tclListType.setFromAnyProc(interp, varValuePtr);
-	    if (result != TCL_OK) {
-		if (createdNewObj) {
-		    Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
-		}
-		return result;
-	    }
+	result = Tcl_ListObjLength(interp, varValuePtr, &numElems);
+	if (result == TCL_OK) {
+	    result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0,
+		    (objc-2), (objv+2));
 	}
-	listRepPtr = (List *) varValuePtr->internalRep.twoPtrValue.ptr1;
-	elemPtrs = listRepPtr->elements;
-	numElems = listRepPtr->elemCount;
-
-	/*
-	 * If there is no room in the current array of element pointers,
-	 * allocate a new, larger array and copy the pointers to it.
-	 */
-	
-	numRequired = numElems + (objc-2);
-	if (numRequired > listRepPtr->maxElemCount) {
-	    int newMax = (2 * numRequired);
-	    Tcl_Obj **newElemPtrs = (Tcl_Obj **)
-		ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
-	    
-	    memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
-		    (size_t) (numElems * sizeof(Tcl_Obj *)));
-	    listRepPtr->maxElemCount = newMax;
-	    listRepPtr->elements = newElemPtrs;
-	    ckfree((char *) elemPtrs);
-	    elemPtrs = newElemPtrs;
+	if (result != TCL_OK) {
+	    if (createdNewObj) {
+		Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
+	    }
+	    return result;
 	}
 
 	/*
-	 * Insert the new elements at the end of the list.
-	 */
-
-	for (i = 2, j = numElems;  i < objc;  i++, j++) {
-            elemPtrs[j] = objv[i];
-            Tcl_IncrRefCount(objv[i]);
-        }
-	listRepPtr->elemCount = numRequired;
-
-	/*
-	 * Invalidate and free any old string representation since it no
-	 * longer reflects the list's internal representation.
-	 */
-
-	Tcl_InvalidateStringRep(varValuePtr);
-
-	/*
 	 * Now store the list object back into the variable. If there is an
 	 * error setting the new value, decrement its ref count if it
 	 * was new and we didn't create the variable.