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]

1 files changed, 22 insertions, 12 deletions

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: