tclListObj.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:49k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * tclListObj.c --
  3.  *
  4.  * This file contains procedures that implement the Tcl list object
  5.  * type.
  6.  *
  7.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  8.  * Copyright (c) 1998 by Scriptics Corporation.
  9.  * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * RCS: @(#) $Id: tclListObj.c,v 1.13.4.2 2005/08/25 22:27:08 dkf Exp $
  15.  */
  16. #include "tclInt.h"
  17. /*
  18.  * Prototypes for procedures defined later in this file:
  19.  */
  20. static void DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
  21.     Tcl_Obj *copyPtr));
  22. static void FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
  23. static int SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
  24.     Tcl_Obj *objPtr));
  25. static void UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
  26. /*
  27.  * The structure below defines the list Tcl object type by means of
  28.  * procedures that can be invoked by generic object code.
  29.  *
  30.  * The internal representation of a list object is a two-pointer
  31.  * representation.  The first pointer designates a List structure that
  32.  * contains an array of pointers to the element objects, together with
  33.  * integers that represent the current element count and the allocated
  34.  * size of the array.  The second pointer is normally NULL; during
  35.  * execution of functions in this file that operate on nested sublists,
  36.  * it is occasionally used as working storage to avoid an auxiliary
  37.  * stack.
  38.  */
  39. Tcl_ObjType tclListType = {
  40.     "list", /* name */
  41.     FreeListInternalRep, /* freeIntRepProc */
  42.     DupListInternalRep,         /* dupIntRepProc */
  43.     UpdateStringOfList, /* updateStringProc */
  44.     SetListFromAny /* setFromAnyProc */
  45. };
  46. /*
  47.  *----------------------------------------------------------------------
  48.  *
  49.  * Tcl_NewListObj --
  50.  *
  51.  * This procedure is normally called when not debugging: i.e., when
  52.  * TCL_MEM_DEBUG is not defined. It creates a new list object from an
  53.  * (objc,objv) array: that is, each of the objc elements of the array
  54.  * referenced by objv is inserted as an element into a new Tcl object.
  55.  *
  56.  * When TCL_MEM_DEBUG is defined, this procedure just returns the
  57.  * result of calling the debugging version Tcl_DbNewListObj.
  58.  *
  59.  * Results:
  60.  * A new list object is returned that is initialized from the object
  61.  * pointers in objv. If objc is less than or equal to zero, an empty
  62.  * object is returned. The new object's string representation
  63.  * is left NULL. The resulting new list object has ref count 0.
  64.  *
  65.  * Side effects:
  66.  * The ref counts of the elements in objv are incremented since the
  67.  * resulting list now refers to them.
  68.  *
  69.  *----------------------------------------------------------------------
  70.  */
  71. #ifdef TCL_MEM_DEBUG
  72. #undef Tcl_NewListObj
  73. Tcl_Obj *
  74. Tcl_NewListObj(objc, objv)
  75.     int objc; /* Count of objects referenced by objv. */
  76.     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
  77. {
  78.     return Tcl_DbNewListObj(objc, objv, "unknown", 0);
  79. }
  80. #else /* if not TCL_MEM_DEBUG */
  81. Tcl_Obj *
  82. Tcl_NewListObj(objc, objv)
  83.     int objc; /* Count of objects referenced by objv. */
  84.     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
  85. {
  86.     register Tcl_Obj *listPtr;
  87.     register Tcl_Obj **elemPtrs;
  88.     register List *listRepPtr;
  89.     int i;
  90.     
  91.     TclNewObj(listPtr);
  92.     
  93.     if (objc > 0) {
  94. Tcl_InvalidateStringRep(listPtr);
  95. elemPtrs = (Tcl_Obj **)
  96.     ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
  97. for (i = 0;  i < objc;  i++) {
  98.     elemPtrs[i] = objv[i];
  99.     Tcl_IncrRefCount(elemPtrs[i]);
  100. }
  101. listRepPtr = (List *) ckalloc(sizeof(List));
  102. listRepPtr->maxElemCount = objc;
  103. listRepPtr->elemCount    = objc;
  104. listRepPtr->elements     = elemPtrs;
  105. listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
  106. listPtr->internalRep.twoPtrValue.ptr2 = NULL;
  107. listPtr->typePtr = &tclListType;
  108.     }
  109.     return listPtr;
  110. }
  111. #endif /* if TCL_MEM_DEBUG */
  112. /*
  113.  *----------------------------------------------------------------------
  114.  *
  115.  * Tcl_DbNewListObj --
  116.  *
  117.  * This procedure is normally called when debugging: i.e., when
  118.  * TCL_MEM_DEBUG is defined. It creates new list objects. It is the
  119.  * same as the Tcl_NewListObj procedure above except that it calls
  120.  * Tcl_DbCkalloc directly with the file name and line number from its
  121.  * caller. This simplifies debugging since then the [memory active]
  122.  * command will report the correct file name and line number when
  123.  * reporting objects that haven't been freed.
  124.  *
  125.  * When TCL_MEM_DEBUG is not defined, this procedure just returns the
  126.  * result of calling Tcl_NewListObj.
  127.  *
  128.  * Results:
  129.  * A new list object is returned that is initialized from the object
  130.  * pointers in objv. If objc is less than or equal to zero, an empty
  131.  * object is returned. The new object's string representation
  132.  * is left NULL. The new list object has ref count 0.
  133.  *
  134.  * Side effects:
  135.  * The ref counts of the elements in objv are incremented since the
  136.  * resulting list now refers to them.
  137.  *
  138.  *----------------------------------------------------------------------
  139.  */
  140. #ifdef TCL_MEM_DEBUG
  141. Tcl_Obj *
  142. Tcl_DbNewListObj(objc, objv, file, line)
  143.     int objc; /* Count of objects referenced by objv. */
  144.     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
  145.     CONST char *file; /* The name of the source file calling this
  146.  * procedure; used for debugging. */
  147.     int line; /* Line number in the source file; used
  148.  * for debugging. */
  149. {
  150.     register Tcl_Obj *listPtr;
  151.     register Tcl_Obj **elemPtrs;
  152.     register List *listRepPtr;
  153.     int i;
  154.     
  155.     TclDbNewObj(listPtr, file, line);
  156.     
  157.     if (objc > 0) {
  158. Tcl_InvalidateStringRep(listPtr);
  159. elemPtrs = (Tcl_Obj **)
  160.     ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
  161. for (i = 0;  i < objc;  i++) {
  162.     elemPtrs[i] = objv[i];
  163.     Tcl_IncrRefCount(elemPtrs[i]);
  164. }
  165. listRepPtr = (List *) ckalloc(sizeof(List));
  166. listRepPtr->maxElemCount = objc;
  167. listRepPtr->elemCount    = objc;
  168. listRepPtr->elements     = elemPtrs;
  169. listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
  170. listPtr->internalRep.twoPtrValue.ptr2 = NULL;
  171. listPtr->typePtr = &tclListType;
  172.     }
  173.     return listPtr;
  174. }
  175. #else /* if not TCL_MEM_DEBUG */
  176. Tcl_Obj *
  177. Tcl_DbNewListObj(objc, objv, file, line)
  178.     int objc; /* Count of objects referenced by objv. */
  179.     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
  180.     CONST char *file; /* The name of the source file calling this
  181.  * procedure; used for debugging. */
  182.     int line; /* Line number in the source file; used
  183.  * for debugging. */
  184. {
  185.     return Tcl_NewListObj(objc, objv);
  186. }
  187. #endif /* TCL_MEM_DEBUG */
  188. /*
  189.  *----------------------------------------------------------------------
  190.  *
  191.  * Tcl_SetListObj --
  192.  *
  193.  * Modify an object to be a list containing each of the objc elements
  194.  * of the object array referenced by objv.
  195.  *
  196.  * Results:
  197.  * None.
  198.  *
  199.  * Side effects:
  200.  * The object is made a list object and is initialized from the object
  201.  * pointers in objv. If objc is less than or equal to zero, an empty
  202.  * object is returned. The new object's string representation
  203.  * is left NULL. The ref counts of the elements in objv are incremented
  204.  * since the list now refers to them. The object's old string and
  205.  * internal representations are freed and its type is set NULL.
  206.  *
  207.  *----------------------------------------------------------------------
  208.  */
  209. void
  210. Tcl_SetListObj(objPtr, objc, objv)
  211.     Tcl_Obj *objPtr; /* Object whose internal rep to init. */
  212.     int objc; /* Count of objects referenced by objv. */
  213.     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
  214. {
  215.     register Tcl_Obj **elemPtrs;
  216.     register List *listRepPtr;
  217.     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
  218.     int i;
  219.     if (Tcl_IsShared(objPtr)) {
  220. panic("Tcl_SetListObj called with shared object");
  221.     }
  222.     
  223.     /*
  224.      * Free any old string rep and any internal rep for the old type.
  225.      */
  226.     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
  227. oldTypePtr->freeIntRepProc(objPtr);
  228.     }
  229.     objPtr->typePtr = NULL;
  230.     Tcl_InvalidateStringRep(objPtr);
  231.         
  232.     /*
  233.      * Set the object's type to "list" and initialize the internal rep.
  234.      * However, if there are no elements to put in the list, just give
  235.      * the object an empty string rep and a NULL type.
  236.      */
  237.     if (objc > 0) {
  238. elemPtrs = (Tcl_Obj **)
  239.     ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
  240. for (i = 0;  i < objc;  i++) {
  241.     elemPtrs[i] = objv[i];
  242.     Tcl_IncrRefCount(elemPtrs[i]);
  243. }
  244. listRepPtr = (List *) ckalloc(sizeof(List));
  245. listRepPtr->maxElemCount = objc;
  246. listRepPtr->elemCount    = objc;
  247. listRepPtr->elements     = elemPtrs;
  248. objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
  249. objPtr->internalRep.twoPtrValue.ptr2 = NULL;
  250. objPtr->typePtr = &tclListType;
  251.     } else {
  252. objPtr->bytes = tclEmptyStringRep;
  253. objPtr->length = 0;
  254.     }
  255. }
  256. /*
  257.  *----------------------------------------------------------------------
  258.  *
  259.  * Tcl_ListObjGetElements --
  260.  *
  261.  * This procedure returns an (objc,objv) array of the elements in a
  262.  * list object.
  263.  *
  264.  * Results:
  265.  * The return value is normally TCL_OK; in this case *objcPtr is set to
  266.  * the count of list elements and *objvPtr is set to a pointer to an
  267.  * array of (*objcPtr) pointers to each list element. If listPtr does
  268.  * not refer to a list object and the object can not be converted to
  269.  * one, TCL_ERROR is returned and an error message will be left in
  270.  * the interpreter's result if interp is not NULL.
  271.  *
  272.  * The objects referenced by the returned array should be treated as
  273.  * readonly and their ref counts are _not_ incremented; the caller must
  274.  * do that if it holds on to a reference. Furthermore, the pointer
  275.  * and length returned by this procedure may change as soon as any
  276.  * procedure is called on the list object; be careful about retaining
  277.  * the pointer in a local data structure.
  278.  *
  279.  * Side effects:
  280.  * The possible conversion of the object referenced by listPtr
  281.  * to a list object.
  282.  *
  283.  *----------------------------------------------------------------------
  284.  */
  285. int
  286. Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
  287.     Tcl_Interp *interp; /* Used to report errors if not NULL. */
  288.     register Tcl_Obj *listPtr; /* List object for which an element array
  289.  * is to be returned. */
  290.     int *objcPtr; /* Where to store the count of objects
  291.  * referenced by objv. */
  292.     Tcl_Obj ***objvPtr;         /* Where to store the pointer to an array
  293.  * of pointers to the list's objects. */
  294. {
  295.     register List *listRepPtr;
  296.     if (listPtr->typePtr != &tclListType) {
  297. int result = SetListFromAny(interp, listPtr);
  298. if (result != TCL_OK) {
  299.     return result;
  300. }
  301.     }
  302.     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  303.     *objcPtr = listRepPtr->elemCount;
  304.     *objvPtr = listRepPtr->elements;
  305.     return TCL_OK;
  306. }
  307. /*
  308.  *----------------------------------------------------------------------
  309.  *
  310.  * Tcl_ListObjAppendList --
  311.  *
  312.  * This procedure appends the objects in the list referenced by
  313.  * elemListPtr to the list object referenced by listPtr. If listPtr is
  314.  * not already a list object, an attempt will be made to convert it to
  315.  * one.
  316.  *
  317.  * Results:
  318.  * The return value is normally TCL_OK. If listPtr or elemListPtr do
  319.  * not refer to list objects and they can not be converted to one,
  320.  * TCL_ERROR is returned and an error message is left in
  321.  * the interpreter's result if interp is not NULL.
  322.  *
  323.  * Side effects:
  324.  * The reference counts of the elements in elemListPtr are incremented
  325.  * since the list now refers to them. listPtr and elemListPtr are
  326.  * converted, if necessary, to list objects. Also, appending the
  327.  * new elements may cause listObj's array of element pointers to grow.
  328.  * listPtr's old string representation, if any, is invalidated.
  329.  *
  330.  *----------------------------------------------------------------------
  331.  */
  332. int
  333. Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
  334.     Tcl_Interp *interp; /* Used to report errors if not NULL. */
  335.     register Tcl_Obj *listPtr; /* List object to append elements to. */
  336.     Tcl_Obj *elemListPtr; /* List obj with elements to append. */
  337. {
  338.     register List *listRepPtr;
  339.     int listLen, objc, result;
  340.     Tcl_Obj **objv;
  341.     if (Tcl_IsShared(listPtr)) {
  342. panic("Tcl_ListObjAppendList called with shared object");
  343.     }
  344.     if (listPtr->typePtr != &tclListType) {
  345. result = SetListFromAny(interp, listPtr);
  346. if (result != TCL_OK) {
  347.     return result;
  348. }
  349.     }
  350.     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  351.     listLen = listRepPtr->elemCount;
  352.     result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
  353.     if (result != TCL_OK) {
  354. return result;
  355.     }
  356.     /*
  357.      * Insert objc new elements starting after the lists's last element.
  358.      * Delete zero existing elements.
  359.      */
  360.     
  361.     return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
  362. }
  363. /*
  364.  *----------------------------------------------------------------------
  365.  *
  366.  * Tcl_ListObjAppendElement --
  367.  *
  368.  * This procedure is a special purpose version of
  369.  * Tcl_ListObjAppendList: it appends a single object referenced by
  370.  * objPtr to the list object referenced by listPtr. If listPtr is not
  371.  * already a list object, an attempt will be made to convert it to one.
  372.  *
  373.  * Results:
  374.  * The return value is normally TCL_OK; in this case objPtr is added
  375.  * to the end of listPtr's list. If listPtr does not refer to a list
  376.  * object and the object can not be converted to one, TCL_ERROR is
  377.  * returned and an error message will be left in the interpreter's
  378.  * result if interp is not NULL.
  379.  *
  380.  * Side effects:
  381.  * The ref count of objPtr is incremented since the list now refers 
  382.  * to it. listPtr will be converted, if necessary, to a list object.
  383.  * Also, appending the new element may cause listObj's array of element
  384.  * pointers to grow. listPtr's old string representation, if any,
  385.  * is invalidated.
  386.  *
  387.  *----------------------------------------------------------------------
  388.  */
  389. int
  390. Tcl_ListObjAppendElement(interp, listPtr, objPtr)
  391.     Tcl_Interp *interp; /* Used to report errors if not NULL. */
  392.     Tcl_Obj *listPtr; /* List object to append objPtr to. */
  393.     Tcl_Obj *objPtr; /* Object to append to listPtr's list. */
  394. {
  395.     register List *listRepPtr;
  396.     register Tcl_Obj **elemPtrs;
  397.     int numElems, numRequired;
  398.     
  399.     if (Tcl_IsShared(listPtr)) {
  400. panic("Tcl_ListObjAppendElement called with shared object");
  401.     }
  402.     if (listPtr->typePtr != &tclListType) {
  403. int result = SetListFromAny(interp, listPtr);
  404. if (result != TCL_OK) {
  405.     return result;
  406. }
  407.     }
  408.     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  409.     elemPtrs = listRepPtr->elements;
  410.     numElems = listRepPtr->elemCount;
  411.     numRequired = numElems + 1 ;
  412.     
  413.     /*
  414.      * If there is no room in the current array of element pointers,
  415.      * allocate a new, larger array and copy the pointers to it.
  416.      */
  417.     if (numRequired > listRepPtr->maxElemCount) {
  418. int newMax = (2 * numRequired);
  419. Tcl_Obj **newElemPtrs = (Tcl_Obj **)
  420.     ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
  421. memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
  422.        (size_t) (numElems * sizeof(Tcl_Obj *)));
  423. listRepPtr->maxElemCount = newMax;
  424. listRepPtr->elements = newElemPtrs;
  425. ckfree((char *) elemPtrs);
  426. elemPtrs = newElemPtrs;
  427.     }
  428.     /*
  429.      * Add objPtr to the end of listPtr's array of element
  430.      * pointers. Increment the ref count for the (now shared) objPtr.
  431.      */
  432.     elemPtrs[numElems] = objPtr;
  433.     Tcl_IncrRefCount(objPtr);
  434.     listRepPtr->elemCount++;
  435.     /*
  436.      * Invalidate any old string representation since the list's internal
  437.      * representation has changed.
  438.      */
  439.     Tcl_InvalidateStringRep(listPtr);
  440.     return TCL_OK;
  441. }
  442. /*
  443.  *----------------------------------------------------------------------
  444.  *
  445.  * Tcl_ListObjIndex --
  446.  *
  447.  * This procedure returns a pointer to the index'th object from the
  448.  * list referenced by listPtr. The first element has index 0. If index
  449.  * is negative or greater than or equal to the number of elements in
  450.  * the list, a NULL is returned. If listPtr is not a list object, an
  451.  * attempt will be made to convert it to a list.
  452.  *
  453.  * Results:
  454.  * The return value is normally TCL_OK; in this case objPtrPtr is set
  455.  * to the Tcl_Obj pointer for the index'th list element or NULL if
  456.  * index is out of range. This object should be treated as readonly and
  457.  * its ref count is _not_ incremented; the caller must do that if it
  458.  * holds on to the reference. If listPtr does not refer to a list and
  459.  * can't be converted to one, TCL_ERROR is returned and an error
  460.  * message is left in the interpreter's result if interp is not NULL.
  461.  *
  462.  * Side effects:
  463.  * listPtr will be converted, if necessary, to a list object.
  464.  *
  465.  *----------------------------------------------------------------------
  466.  */
  467. int
  468. Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
  469.     Tcl_Interp *interp; /* Used to report errors if not NULL. */
  470.     register Tcl_Obj *listPtr; /* List object to index into. */
  471.     register int index; /* Index of element to return. */
  472.     Tcl_Obj **objPtrPtr; /* The resulting Tcl_Obj* is stored here. */
  473. {
  474.     register List *listRepPtr;
  475.     
  476.     if (listPtr->typePtr != &tclListType) {
  477. int result = SetListFromAny(interp, listPtr);
  478. if (result != TCL_OK) {
  479.     return result;
  480. }
  481.     }
  482.     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  483.     if ((index < 0) || (index >= listRepPtr->elemCount)) {
  484. *objPtrPtr = NULL;
  485.     } else {
  486. *objPtrPtr = listRepPtr->elements[index];
  487.     }
  488.     
  489.     return TCL_OK;
  490. }
  491. /*
  492.  *----------------------------------------------------------------------
  493.  *
  494.  * Tcl_ListObjLength --
  495.  *
  496.  * This procedure returns the number of elements in a list object. If
  497.  * the object is not already a list object, an attempt will be made to
  498.  * convert it to one.
  499.  *
  500.  * Results:
  501.  * The return value is normally TCL_OK; in this case *intPtr will be
  502.  * set to the integer count of list elements. If listPtr does not refer
  503.  * to a list object and the object can not be converted to one,
  504.  * TCL_ERROR is returned and an error message will be left in
  505.  * the interpreter's result if interp is not NULL.
  506.  *
  507.  * Side effects:
  508.  * The possible conversion of the argument object to a list object.
  509.  *
  510.  *----------------------------------------------------------------------
  511.  */
  512. int
  513. Tcl_ListObjLength(interp, listPtr, intPtr)
  514.     Tcl_Interp *interp; /* Used to report errors if not NULL. */
  515.     register Tcl_Obj *listPtr; /* List object whose #elements to return. */
  516.     register int *intPtr; /* The resulting int is stored here. */
  517. {
  518.     register List *listRepPtr;
  519.     
  520.     if (listPtr->typePtr != &tclListType) {
  521. int result = SetListFromAny(interp, listPtr);
  522. if (result != TCL_OK) {
  523.     return result;
  524. }
  525.     }
  526.     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  527.     *intPtr = listRepPtr->elemCount;
  528.     return TCL_OK;
  529. }
  530. /*
  531.  *----------------------------------------------------------------------
  532.  *
  533.  * Tcl_ListObjReplace --
  534.  * 
  535.  * This procedure replaces zero or more elements of the list referenced
  536.  * by listPtr with the objects from an (objc,objv) array. 
  537.  * The objc elements of the array referenced by objv replace the
  538.  * count elements in listPtr starting at first.
  539.  *
  540.  * If the argument first is zero or negative, it refers to the first
  541.  * element. If first is greater than or equal to the number of elements
  542.  * in the list, then no elements are deleted; the new elements are
  543.  * appended to the list. Count gives the number of elements to
  544.  * replace. If count is zero or negative then no elements are deleted;
  545.  * the new elements are simply inserted before first.
  546.  *
  547.  * The argument objv refers to an array of objc pointers to the new
  548.  * elements to be added to listPtr in place of those that were
  549.  * deleted. If objv is NULL, no new elements are added. If listPtr is
  550.  * not a list object, an attempt will be made to convert it to one.
  551.  *
  552.  * Results:
  553.  * The return value is normally TCL_OK. If listPtr does
  554.  * not refer to a list object and can not be converted to one,
  555.  * TCL_ERROR is returned and an error message will be left in
  556.  * the interpreter's result if interp is not NULL.
  557.  *
  558.  * Side effects:
  559.  * The ref counts of the objc elements in objv are incremented since
  560.  * the resulting list now refers to them. Similarly, the ref counts for
  561.  * replaced objects are decremented. listPtr is converted, if
  562.  * necessary, to a list object. listPtr's old string representation, if
  563.  * any, is freed. 
  564.  *
  565.  *----------------------------------------------------------------------
  566.  */
  567. int
  568. Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
  569.     Tcl_Interp *interp; /* Used for error reporting if not NULL. */
  570.     Tcl_Obj *listPtr; /* List object whose elements to replace. */
  571.     int first; /* Index of first element to replace. */
  572.     int count; /* Number of elements to replace. */
  573.     int objc; /* Number of objects to insert. */
  574.     Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects
  575.  * to insert. */
  576. {
  577.     List *listRepPtr;
  578.     register Tcl_Obj **elemPtrs, **newPtrs;
  579.     Tcl_Obj *victimPtr;
  580.     int numElems, numRequired, numAfterLast;
  581.     int start, shift, newMax, i, j, result;
  582.      
  583.     if (Tcl_IsShared(listPtr)) {
  584. panic("Tcl_ListObjReplace called with shared object");
  585.     }
  586.     if (listPtr->typePtr != &tclListType) {
  587. result = SetListFromAny(interp, listPtr);
  588. if (result != TCL_OK) {
  589.     return result;
  590. }
  591.     }
  592.     listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  593.     elemPtrs = listRepPtr->elements;
  594.     numElems = listRepPtr->elemCount;
  595.     if (first < 0)  {
  596.      first = 0;
  597.     }
  598.     if (first >= numElems) {
  599. first = numElems; /* so we'll insert after last element */
  600.     }
  601.     if (count < 0) {
  602. count = 0;
  603.     }
  604.     
  605.     numRequired = (numElems - count + objc);
  606.     if (numRequired <= listRepPtr->maxElemCount) {
  607. /*
  608.  * Enough room in the current array. First "delete" count
  609.  * elements starting at first.
  610.  */
  611. for (i = 0, j = first;  i < count;  i++, j++) {
  612.     victimPtr = elemPtrs[j];
  613.     TclDecrRefCount(victimPtr);
  614. }
  615. /*
  616.  * Shift the elements after the last one removed to their
  617.  * new locations.
  618.  */
  619. start = (first + count);
  620. numAfterLast = (numElems - start);
  621. shift = (objc - count); /* numNewElems - numDeleted */
  622. if ((numAfterLast > 0) && (shift != 0)) {
  623.     Tcl_Obj **src, **dst;
  624.     src = elemPtrs + start; dst = src + shift;
  625.     memmove((VOID*) dst, (VOID*) src, 
  626.             (size_t) (numAfterLast * sizeof(Tcl_Obj*)));
  627. }
  628. /*
  629.  * Insert the new elements into elemPtrs before "first".
  630.  */
  631. for (i = 0, j = first;  i < objc;  i++, j++) {
  632.             elemPtrs[j] = objv[i];
  633.             Tcl_IncrRefCount(objv[i]);
  634.         }
  635. /*
  636.  * Update the count of elements.
  637.  */
  638. listRepPtr->elemCount = numRequired;
  639.     } else {
  640. /*
  641.  * Not enough room in the current array. Allocate a larger array and
  642.  * insert elements into it. 
  643.  */
  644. newMax = (2 * numRequired);
  645. newPtrs = (Tcl_Obj **)
  646.     ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
  647. /*
  648.  * Copy over the elements before "first".
  649.  */
  650. if (first > 0) {
  651.     memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
  652.     (size_t) (first * sizeof(Tcl_Obj *)));
  653. }
  654. /*
  655.  * "Delete" count elements starting at first.
  656.  */
  657. for (i = 0, j = first;  i < count;  i++, j++) {
  658.     victimPtr = elemPtrs[j];
  659.     TclDecrRefCount(victimPtr);
  660. }
  661. /*
  662.  * Copy the elements after the last one removed, shifted to
  663.  * their new locations.
  664.  */
  665. start = (first + count);
  666. numAfterLast = (numElems - start);
  667. if (numAfterLast > 0) {
  668.     memcpy((VOID *) &(newPtrs[first + objc]),
  669.     (VOID *) &(elemPtrs[start]),
  670.     (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
  671. }
  672. /*
  673.  * Insert the new elements before "first" and update the
  674.  * count of elements.
  675.  */
  676. for (i = 0, j = first;  i < objc;  i++, j++) {
  677.     newPtrs[j] = objv[i];
  678.     Tcl_IncrRefCount(objv[i]);
  679. }
  680. listRepPtr->elemCount = numRequired;
  681. listRepPtr->maxElemCount = newMax;
  682. listRepPtr->elements = newPtrs;
  683. ckfree((char *) elemPtrs);
  684.     }
  685.     
  686.     /*
  687.      * Invalidate and free any old string representation since it no longer
  688.      * reflects the list's internal representation.
  689.      */
  690.     Tcl_InvalidateStringRep(listPtr);
  691.     return TCL_OK;
  692. }
  693. /*
  694.  *----------------------------------------------------------------------
  695.  *
  696.  * TclLsetList --
  697.  *
  698.  * Core of the 'lset' command when objc == 4.  Objv[2] may be
  699.  * either a scalar index or a list of indices.
  700.  *
  701.  * Results:
  702.  * Returns the new value of the list variable, or NULL if an
  703.  * error occurs.
  704.  *
  705.  * Side effects:
  706.  * Surgery is performed on the list value to produce the
  707.  * result.
  708.  *
  709.  * On entry, the reference count of the variable value does not reflect
  710.  * any references held on the stack.  The first action of this function
  711.  * is to determine whether the object is shared, and to duplicate it if
  712.  * it is.  The reference count of the duplicate is incremented.
  713.  * At this point, the reference count will be 1 for either case, so that
  714.  * the object will appear to be unshared.
  715.  *
  716.  * If an error occurs, and the object has been duplicated, the reference
  717.  * count on the duplicate is decremented so that it is now 0: this dismisses
  718.  * any memory that was allocated by this procedure.
  719.  *
  720.  * If no error occurs, the reference count of the original object is
  721.  * incremented if the object has not been duplicated, and nothing is
  722.  * done to a reference count of the duplicate.  Now the reference count
  723.  * of an unduplicated object is 2 (the returned pointer, plus the one
  724.  * stored in the variable).  The reference count of a duplicate object
  725.  * is 1, reflecting that the returned pointer is the only active
  726.  * reference.  The caller is expected to store the returned value back
  727.  * in the variable and decrement its reference count.  (INST_STORE_*
  728.  * does exactly this.)
  729.  *
  730.  * Tcl_LsetFlat and related functions maintain a linked list of
  731.  * Tcl_Obj's whose string representations must be spoilt by threading
  732.  * via 'ptr2' of the two-pointer internal representation.  On entry
  733.  * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
  734.  * the 'ptr2' field of any Tcl_Obj that has been modified is set to
  735.  * NULL.
  736.  *
  737.  *----------------------------------------------------------------------
  738.  */
  739. Tcl_Obj*
  740. TclLsetList( interp, listPtr, indexArgPtr, valuePtr )
  741.     Tcl_Interp* interp; /* Tcl interpreter */
  742.     Tcl_Obj* listPtr; /* Pointer to the list being modified */
  743.     Tcl_Obj* indexArgPtr; /* Index or index-list arg to 'lset' */
  744.     Tcl_Obj* valuePtr; /* Value arg to 'lset' */
  745. {
  746.     int indexCount; /* Number of indices in the index list */
  747.     Tcl_Obj** indices; /* Vector of indices in the index list*/
  748.     int duplicated; /* Flag == 1 if the obj has been
  749.  * duplicated, 0 otherwise */
  750.     Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
  751.     int index; /* Current index in the list - discarded */
  752.     int result; /* Status return from library calls */
  753.     Tcl_Obj* subListPtr; /* Pointer to the current sublist */
  754.     int elemCount; /* Count of elements in the current sublist */
  755.     Tcl_Obj** elemPtrs; /* Pointers to elements of current sublist  */
  756.     Tcl_Obj* chainPtr; /* Pointer to the enclosing sublist
  757.  * of the current sublist */
  758.     int i;
  759.     /*
  760.      * Determine whether the index arg designates a list or a single
  761.      * index.  We have to be careful about the order of the checks to
  762.      * avoid repeated shimmering; see TIP #22 and #23 for details.
  763.      */
  764.     if ( indexArgPtr->typePtr != &tclListType
  765.  && TclGetIntForIndex( NULL, indexArgPtr, 0, &index ) == TCL_OK ) {
  766. /*
  767.  * indexArgPtr designates a single index.
  768.  */
  769. return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
  770.     } else if ( Tcl_ListObjGetElements( NULL, indexArgPtr,
  771. &indexCount, &indices ) != TCL_OK ) {
  772. /*
  773.  * indexArgPtr designates something that is neither an index nor a
  774.  * well formed list.  Report the error via TclLsetFlat.
  775.  */
  776. return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
  777.     }
  778.     /*
  779.      * At this point, we know that argPtr designates a well formed list,
  780.      * and the 'else if' above has parsed it into indexCount and indices.
  781.      * If there are no indices, simply return 'valuePtr', counting the
  782.      * returned pointer as a reference.
  783.      */
  784.     if ( indexCount == 0 ) {
  785. Tcl_IncrRefCount( valuePtr );
  786. return valuePtr;
  787.     }
  788.     /*
  789.      * Duplicate the list arg if necessary.
  790.      */
  791.     if ( Tcl_IsShared( listPtr ) ) {
  792. duplicated = 1;
  793. listPtr = Tcl_DuplicateObj( listPtr );
  794. Tcl_IncrRefCount( listPtr );
  795.     } else {
  796. duplicated = 0;
  797.     }
  798.     /*
  799.      * It would be tempting simply to go off to TclLsetFlat to finish the
  800.      * processing.  Alas, it is also incorrect!  The problem is that
  801.      * 'indexArgPtr' may designate a sublist of 'listPtr' whose value
  802.      * is to be manipulated.  The fact that 'listPtr' is itself unshared
  803.      * does not guarantee that no sublist is.  Therefore, it's necessary
  804.      * to replicate all the work here, expanding the index list on each
  805.      * trip through the loop.
  806.      */
  807.     /*
  808.      * Anchor the linked list of Tcl_Obj's whose string reps must be
  809.      * invalidated if the operation succeeds.
  810.      */
  811.     retValuePtr = listPtr;
  812.     chainPtr = NULL;
  813.     /*
  814.      * Handle each index arg by diving into the appropriate sublist
  815.      */
  816.     for ( i = 0; ; ++i ) {
  817. /*
  818.  * Take the sublist apart.
  819.  */
  820. result = Tcl_ListObjGetElements( interp, listPtr,
  821.  &elemCount, &elemPtrs );
  822. if ( result != TCL_OK ) {
  823.     break;
  824. }
  825. listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
  826. /*
  827.  * Reconstitute the index array
  828.  */
  829. result = Tcl_ListObjGetElements( interp, indexArgPtr,
  830.  &indexCount, &indices );
  831. if ( result != TCL_OK ) {
  832.     /* 
  833.      * Shouldn't be able to get here, because we already
  834.      * parsed the thing successfully once.
  835.      */
  836.     break;
  837. }
  838. /*
  839.  * Determine the index of the requested element.
  840.  */
  841. result = TclGetIntForIndex( interp, indices[ i ],
  842.     (elemCount - 1), &index );
  843. if ( result != TCL_OK ) {
  844.     break;
  845. }
  846. /*
  847.  * Check that the index is in range.
  848.  */
  849. if ( ( index < 0 ) || ( index >= elemCount ) ) {
  850.     Tcl_SetObjResult( interp,
  851.       Tcl_NewStringObj( "list index out of range",
  852. -1 ) );
  853.     result = TCL_ERROR;
  854.     break;
  855. }
  856. /*
  857.  * Break the loop after extracting the innermost sublist
  858.  */
  859. if ( i >= indexCount-1 ) {
  860.     result = TCL_OK;
  861.     break;
  862. }
  863. /*
  864.  * Extract the appropriate sublist, and make sure that it is unshared.
  865.  */
  866. subListPtr = elemPtrs[ index ];
  867. if ( Tcl_IsShared( subListPtr ) ) {
  868.     subListPtr = Tcl_DuplicateObj( subListPtr );
  869.     result = TclListObjSetElement( interp, listPtr, index,
  870.     subListPtr );
  871.     if ( result != TCL_OK ) {
  872. /* 
  873.  * We actually shouldn't be able to get here, because
  874.  * we've already checked everything that TclListObjSetElement
  875.  * checks. If we were to get here, it would result in leaking
  876.  * subListPtr.
  877.  */
  878. break;
  879.     }
  880. }
  881. /* 
  882.  * Chain the current sublist onto the linked list of Tcl_Obj's
  883.  * whose string reps must be spoilt.
  884.  */
  885. chainPtr = listPtr;
  886. listPtr = subListPtr;
  887.     }
  888.     /*
  889.      * Store the new element into the correct slot in the innermost sublist.
  890.      */
  891.     if ( result == TCL_OK ) {
  892. result = TclListObjSetElement( interp, listPtr, index, valuePtr );
  893.     }
  894.     if ( result == TCL_OK ) {
  895. listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
  896. /* Spoil all the string reps */
  897. while ( listPtr != NULL ) {
  898.     subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
  899.     Tcl_InvalidateStringRep( listPtr );
  900.     listPtr->internalRep.twoPtrValue.ptr2 = NULL;
  901.     listPtr = subListPtr;
  902. }
  903. /* Return the new list if everything worked. */
  904. if ( !duplicated ) {
  905.     Tcl_IncrRefCount( retValuePtr );
  906. }
  907. return retValuePtr;
  908.     }
  909.     /* Clean up the one dangling reference otherwise */
  910.     if ( duplicated ) {
  911. Tcl_DecrRefCount( retValuePtr );
  912.     }
  913.     return NULL;
  914. }
  915. /*
  916.  *----------------------------------------------------------------------
  917.  *
  918.  * TclLsetFlat --
  919.  *
  920.  * Core of the 'lset' command when objc>=5.  Objv[2], ... ,
  921.  * objv[objc-2] contain scalar indices.
  922.  *
  923.  * Results:
  924.  * Returns the new value of the list variable, or NULL if an
  925.  * error occurs.
  926.  *
  927.  * Side effects:
  928.  * Surgery is performed on the list value to produce the
  929.  * result.
  930.  *
  931.  * On entry, the reference count of the variable value does not reflect
  932.  * any references held on the stack.  The first action of this function
  933.  * is to determine whether the object is shared, and to duplicate it if
  934.  * it is.  The reference count of the duplicate is incremented.
  935.  * At this point, the reference count will be 1 for either case, so that
  936.  * the object will appear to be unshared.
  937.  *
  938.  * If an error occurs, and the object has been duplicated, the reference
  939.  * count on the duplicate is decremented so that it is now 0: this dismisses
  940.  * any memory that was allocated by this procedure.
  941.  *
  942.  * If no error occurs, the reference count of the original object is
  943.  * incremented if the object has not been duplicated, and nothing is
  944.  * done to a reference count of the duplicate.  Now the reference count
  945.  * of an unduplicated object is 2 (the returned pointer, plus the one
  946.  * stored in the variable).  The reference count of a duplicate object
  947.  * is 1, reflecting that the returned pointer is the only active
  948.  * reference.  The caller is expected to store the returned value back
  949.  * in the variable and decrement its reference count.  (INST_STORE_*
  950.  * does exactly this.)
  951.  *
  952.  * Tcl_LsetList and related functions maintain a linked list of
  953.  * Tcl_Obj's whose string representations must be spoilt by threading
  954.  * via 'ptr2' of the two-pointer internal representation.  On entry
  955.  * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit,
  956.  * the 'ptr2' field of any Tcl_Obj that has been modified is set to
  957.  * NULL.
  958.  *
  959.  *----------------------------------------------------------------------
  960.  */
  961. Tcl_Obj*
  962. TclLsetFlat( interp, listPtr, indexCount, indexArray, valuePtr )
  963.     Tcl_Interp* interp; /* Tcl interpreter */
  964.     Tcl_Obj* listPtr; /* Pointer to the list being modified */
  965.     int indexCount; /* Number of index args */
  966.     Tcl_Obj *CONST indexArray[];
  967. /* Index args */
  968.     Tcl_Obj* valuePtr; /* Value arg to 'lset' */
  969. {
  970.     int duplicated; /* Flag == 1 if the obj has been
  971.  * duplicated, 0 otherwise */
  972.     Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
  973.     int elemCount; /* Length of one sublist being changed */
  974.     Tcl_Obj** elemPtrs; /* Pointers to the elements of a sublist */
  975.     Tcl_Obj* subListPtr; /* Pointer to the current sublist */
  976.     int index; /* Index of the element to replace in the
  977.  * current sublist */
  978.     Tcl_Obj* chainPtr; /* Pointer to the enclosing list of
  979.  * the current sublist. */
  980.     int result; /* Status return from library calls */
  981.     int i;
  982.     /*
  983.      * If there are no indices, then simply return the new value,
  984.      * counting the returned pointer as a reference
  985.      */
  986.     if ( indexCount == 0 ) {
  987. Tcl_IncrRefCount( valuePtr );
  988. return valuePtr;
  989.     }
  990.     /*
  991.      * If the list is shared, make a private copy.
  992.      */
  993.     if ( Tcl_IsShared( listPtr ) ) {
  994. duplicated = 1;
  995. listPtr = Tcl_DuplicateObj( listPtr );
  996. Tcl_IncrRefCount( listPtr );
  997.     } else {
  998. duplicated = 0;
  999.     }
  1000.     /*
  1001.      * Anchor the linked list of Tcl_Obj's whose string reps must be
  1002.      * invalidated if the operation succeeds.
  1003.      */
  1004.     retValuePtr = listPtr;
  1005.     chainPtr = NULL;
  1006.     /*
  1007.      * Handle each index arg by diving into the appropriate sublist
  1008.      */
  1009.     for ( i = 0; ; ++i ) {
  1010. /*
  1011.  * Take the sublist apart.
  1012.  */
  1013. result = Tcl_ListObjGetElements( interp, listPtr,
  1014.  &elemCount, &elemPtrs );
  1015. if ( result != TCL_OK ) {
  1016.     break;
  1017. }
  1018. listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
  1019. /*
  1020.  * Determine the index of the requested element.
  1021.  */
  1022. result = TclGetIntForIndex( interp, indexArray[ i ],
  1023.     (elemCount - 1), &index );
  1024. if ( result != TCL_OK ) {
  1025.     break;
  1026. }
  1027. /*
  1028.  * Check that the index is in range.
  1029.  */
  1030. if ( ( index < 0 ) || ( index >= elemCount ) ) {
  1031.     Tcl_SetObjResult( interp,
  1032.       Tcl_NewStringObj( "list index out of range",
  1033. -1 ) );
  1034.     result = TCL_ERROR;
  1035.     break;
  1036. }
  1037. /*
  1038.  * Break the loop after extracting the innermost sublist
  1039.  */
  1040. if ( i >= indexCount-1 ) {
  1041.     result = TCL_OK;
  1042.     break;
  1043. }
  1044. /*
  1045.  * Extract the appropriate sublist, and make sure that it is unshared.
  1046.  */
  1047. subListPtr = elemPtrs[ index ];
  1048. if ( Tcl_IsShared( subListPtr ) ) {
  1049.     subListPtr = Tcl_DuplicateObj( subListPtr );
  1050.     result = TclListObjSetElement( interp, listPtr, index,
  1051.     subListPtr );
  1052.     if ( result != TCL_OK ) {
  1053. /* 
  1054.  * We actually shouldn't be able to get here.
  1055.  * If we do, it would result in leaking subListPtr,
  1056.  * but everything's been validated already; the error
  1057.  * exit from TclListObjSetElement should never happen.
  1058.  */
  1059. break;
  1060.     }
  1061. }
  1062. /* 
  1063.  * Chain the current sublist onto the linked list of Tcl_Obj's
  1064.  * whose string reps must be spoilt.
  1065.  */
  1066. chainPtr = listPtr;
  1067. listPtr = subListPtr;
  1068.     }
  1069.     /* Store the result in the list element */
  1070.     if ( result == TCL_OK ) {
  1071. result = TclListObjSetElement( interp, listPtr, index, valuePtr );
  1072.     }
  1073.     if ( result == TCL_OK ) {
  1074. listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
  1075. /* Spoil all the string reps */
  1076. while ( listPtr != NULL ) {
  1077.     subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
  1078.     Tcl_InvalidateStringRep( listPtr );
  1079.     listPtr->internalRep.twoPtrValue.ptr2 = NULL;
  1080.     listPtr = subListPtr;
  1081. }
  1082. /* Return the new list if everything worked. */
  1083. if ( !duplicated ) {
  1084.     Tcl_IncrRefCount( retValuePtr );
  1085. }
  1086. return retValuePtr;
  1087.     }
  1088.     /* Clean up the one dangling reference otherwise */
  1089.     if ( duplicated ) {
  1090. Tcl_DecrRefCount( retValuePtr );
  1091.     }
  1092.     return NULL;
  1093. }
  1094. /*
  1095.  *----------------------------------------------------------------------
  1096.  *
  1097.  * TclListObjSetElement --
  1098.  *
  1099.  * Set a single element of a list to a specified value
  1100.  *
  1101.  * Results:
  1102.  *
  1103.  * The return value is normally TCL_OK.  If listPtr does not
  1104.  * refer to a list object and cannot be converted to one, TCL_ERROR
  1105.  * is returned and an error message will be left in the interpreter
  1106.  * result if interp is not NULL.  Similarly, if index designates
  1107.  * an element outside the range [0..listLength-1], where
  1108.  * listLength is the count of elements in the list object designated
  1109.  * by listPtr, TCL_ERROR is returned and an error message is left
  1110.  * in the interpreter result.
  1111.  *
  1112.  * Side effects:
  1113.  *
  1114.  * Panics if listPtr designates a shared object.  Otherwise, attempts
  1115.  * to convert it to a list.  Decrements the ref count of the object
  1116.  * at the specified index within the list, replaces with the
  1117.  * object designated by valuePtr, and increments the ref count
  1118.  * of the replacement object.  
  1119.  *
  1120.  * It is the caller's responsibility to invalidate the string
  1121.  * representation of the object.
  1122.  *
  1123.  *----------------------------------------------------------------------
  1124.  */
  1125. int
  1126. TclListObjSetElement( interp, listPtr, index, valuePtr )
  1127.     Tcl_Interp* interp; /* Tcl interpreter; used for error reporting
  1128.  * if not NULL */
  1129.     Tcl_Obj* listPtr; /* List object in which element should be
  1130.  * stored */
  1131.     int index; /* Index of element to store */
  1132.     Tcl_Obj* valuePtr; /* Tcl object to store in the designated
  1133.  * list element */
  1134. {
  1135.     int result; /* Return value from this function */
  1136.     List* listRepPtr; /* Internal representation of the list
  1137.  * being modified */
  1138.     Tcl_Obj** elemPtrs; /* Pointers to elements of the list */
  1139.     int elemCount; /* Number of elements in the list */
  1140.     /* Ensure that the listPtr parameter designates an unshared list */
  1141.     if ( Tcl_IsShared( listPtr ) ) {
  1142. panic( "Tcl_ListObjSetElement called with shared object" );
  1143.     }
  1144.     if ( listPtr->typePtr != &tclListType ) {
  1145. result = SetListFromAny( interp, listPtr );
  1146. if ( result != TCL_OK ) {
  1147.     return result;
  1148. }
  1149.     }
  1150.     listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
  1151.     elemPtrs = listRepPtr->elements;
  1152.     elemCount = listRepPtr->elemCount;
  1153.     /* Ensure that the index is in bounds */
  1154.     if ( index < 0 || index >= elemCount ) {
  1155. if ( interp != NULL ) {
  1156.     Tcl_SetObjResult( interp,
  1157.       Tcl_NewStringObj( "list index out of range",
  1158. -1 ) );
  1159.     return TCL_ERROR;
  1160. }
  1161.     }
  1162.     /* Add a reference to the new list element */
  1163.     Tcl_IncrRefCount( valuePtr );
  1164.     /* Remove a reference from the old list element */
  1165.     Tcl_DecrRefCount( elemPtrs[ index ] );
  1166.     /* Stash the new object in the list */
  1167.     elemPtrs[ index ] = valuePtr;
  1168.     return TCL_OK;
  1169.     
  1170. }
  1171. /*
  1172.  *----------------------------------------------------------------------
  1173.  *
  1174.  * FreeListInternalRep --
  1175.  *
  1176.  * Deallocate the storage associated with a list object's internal
  1177.  * representation.
  1178.  *
  1179.  * Results:
  1180.  * None.
  1181.  *
  1182.  * Side effects:
  1183.  * Frees listPtr's List* internal representation and sets listPtr's
  1184.  * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts
  1185.  * of all element objects, which may free them.
  1186.  *
  1187.  *----------------------------------------------------------------------
  1188.  */
  1189. static void
  1190. FreeListInternalRep(listPtr)
  1191.     Tcl_Obj *listPtr; /* List object with internal rep to free. */
  1192. {
  1193.     register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  1194.     register Tcl_Obj **elemPtrs = listRepPtr->elements;
  1195.     register Tcl_Obj *objPtr;
  1196.     int numElems = listRepPtr->elemCount;
  1197.     int i;
  1198.     
  1199.     for (i = 0;  i < numElems;  i++) {
  1200. objPtr = elemPtrs[i];
  1201. Tcl_DecrRefCount(objPtr);
  1202.     }
  1203.     ckfree((char *) elemPtrs);
  1204.     ckfree((char *) listRepPtr);
  1205.     listPtr->internalRep.twoPtrValue.ptr1 = NULL;
  1206.     listPtr->internalRep.twoPtrValue.ptr2 = NULL;
  1207. }
  1208. /*
  1209.  *----------------------------------------------------------------------
  1210.  *
  1211.  * DupListInternalRep --
  1212.  *
  1213.  * Initialize the internal representation of a list Tcl_Obj to a
  1214.  * copy of the internal representation of an existing list object. 
  1215.  *
  1216.  * Results:
  1217.  * None.
  1218.  *
  1219.  * Side effects:
  1220.  * "srcPtr"s list internal rep pointer should not be NULL and we assume
  1221.  * it is not NULL. We set "copyPtr"s internal rep to a pointer to a
  1222.  * newly allocated List structure that, in turn, points to "srcPtr"s
  1223.  * element objects. Those element objects are not actually copied but
  1224.  * are shared between "srcPtr" and "copyPtr". The ref count of each
  1225.  * element object is incremented.
  1226.  *
  1227.  *----------------------------------------------------------------------
  1228.  */
  1229. static void
  1230. DupListInternalRep(srcPtr, copyPtr)
  1231.     Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
  1232.     Tcl_Obj *copyPtr; /* Object with internal rep to set. */
  1233. {
  1234.     List *srcListRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
  1235.     int numElems = srcListRepPtr->elemCount;
  1236.     int maxElems = srcListRepPtr->maxElemCount;
  1237.     register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
  1238.     register Tcl_Obj **copyElemPtrs;
  1239.     register List *copyListRepPtr;
  1240.     int i;
  1241.     /*
  1242.      * Allocate a new List structure that points to "srcPtr"s element
  1243.      * objects. Increment the ref counts for those (now shared) element
  1244.      * objects.
  1245.      */
  1246.     
  1247.     copyElemPtrs = (Tcl_Obj **)
  1248. ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
  1249.     for (i = 0;  i < numElems;  i++) {
  1250. copyElemPtrs[i] = srcElemPtrs[i];
  1251. Tcl_IncrRefCount(copyElemPtrs[i]);
  1252.     }
  1253.     
  1254.     copyListRepPtr = (List *) ckalloc(sizeof(List));
  1255.     copyListRepPtr->maxElemCount = maxElems;
  1256.     copyListRepPtr->elemCount    = numElems;
  1257.     copyListRepPtr->elements     = copyElemPtrs;
  1258.     
  1259.     copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
  1260.     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
  1261.     copyPtr->typePtr = &tclListType;
  1262. }
  1263. /*
  1264.  *----------------------------------------------------------------------
  1265.  *
  1266.  * SetListFromAny --
  1267.  *
  1268.  * Attempt to generate a list internal form for the Tcl object
  1269.  * "objPtr".
  1270.  *
  1271.  * Results:
  1272.  * The return value is TCL_OK or TCL_ERROR. If an error occurs during
  1273.  * conversion, an error message is left in the interpreter's result
  1274.  * unless "interp" is NULL.
  1275.  *
  1276.  * Side effects:
  1277.  * If no error occurs, a list is stored as "objPtr"s internal
  1278.  * representation.
  1279.  *
  1280.  *----------------------------------------------------------------------
  1281.  */
  1282. static int
  1283. SetListFromAny(interp, objPtr)
  1284.     Tcl_Interp *interp; /* Used for error reporting if not NULL. */
  1285.     Tcl_Obj *objPtr; /* The object to convert. */
  1286. {
  1287.     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
  1288.     char *string, *s;
  1289.     CONST char *elemStart, *nextElem;
  1290.     int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
  1291.     char *limit; /* Points just after string's last byte. */
  1292.     register CONST char *p;
  1293.     register Tcl_Obj **elemPtrs;
  1294.     register Tcl_Obj *elemPtr;
  1295.     List *listRepPtr;
  1296.     /*
  1297.      * Get the string representation. Make it up-to-date if necessary.
  1298.      */
  1299.     string = Tcl_GetStringFromObj(objPtr, &length);
  1300.     /*
  1301.      * Parse the string into separate string objects, and create a List
  1302.      * structure that points to the element string objects. We use a
  1303.      * modified version of Tcl_SplitList's implementation to avoid one
  1304.      * malloc and a string copy for each list element. First, estimate the
  1305.      * number of elements by counting the number of space characters in the
  1306.      * list.
  1307.      */
  1308.     limit = (string + length);
  1309.     estCount = 1;
  1310.     for (p = string;  p < limit;  p++) {
  1311. if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
  1312.     estCount++;
  1313. }
  1314.     }
  1315.     /*
  1316.      * Allocate a new List structure with enough room for "estCount"
  1317.      * elements. Each element is a pointer to a Tcl_Obj with the appropriate
  1318.      * string rep. The initial "estCount" elements are set using the
  1319.      * corresponding "argv" strings.
  1320.      */
  1321.     elemPtrs = (Tcl_Obj **)
  1322.     ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
  1323.     for (p = string, lenRemain = length, i = 0;
  1324.     lenRemain > 0;
  1325.     p = nextElem, lenRemain = (limit - nextElem), i++) {
  1326. result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
  1327. &elemSize, &hasBrace);
  1328. if (result != TCL_OK) {
  1329.     for (j = 0;  j < i;  j++) {
  1330. elemPtr = elemPtrs[j];
  1331. Tcl_DecrRefCount(elemPtr);
  1332.     }
  1333.     ckfree((char *) elemPtrs);
  1334.     return result;
  1335. }
  1336. if (elemStart >= limit) {
  1337.     break;
  1338. }
  1339. if (i > estCount) {
  1340.     panic("SetListFromAny: bad size estimate for list");
  1341. }
  1342. /*
  1343.  * Allocate a Tcl object for the element and initialize it from the
  1344.  * "elemSize" bytes starting at "elemStart".
  1345.  */
  1346. s = ckalloc((unsigned) elemSize + 1);
  1347. if (hasBrace) {
  1348.     memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);
  1349.     s[elemSize] = 0;
  1350. } else {
  1351.     elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
  1352. }
  1353. TclNewObj(elemPtr);
  1354.         elemPtr->bytes  = s;
  1355.         elemPtr->length = elemSize;
  1356.         elemPtrs[i] = elemPtr;
  1357. Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
  1358.     }
  1359.     listRepPtr = (List *) ckalloc(sizeof(List));
  1360.     listRepPtr->maxElemCount = estCount;
  1361.     listRepPtr->elemCount    = i;
  1362.     listRepPtr->elements     = elemPtrs;
  1363.     /*
  1364.      * Free the old internalRep before setting the new one. We do this as
  1365.      * late as possible to allow the conversion code, in particular
  1366.      * Tcl_GetStringFromObj, to use that old internalRep.
  1367.      */
  1368.     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
  1369. oldTypePtr->freeIntRepProc(objPtr);
  1370.     }
  1371.     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
  1372.     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
  1373.     objPtr->typePtr = &tclListType;
  1374.     return TCL_OK;
  1375. }
  1376. /*
  1377.  *----------------------------------------------------------------------
  1378.  *
  1379.  * UpdateStringOfList --
  1380.  *
  1381.  * Update the string representation for a list object.
  1382.  * Note: This procedure does not invalidate an existing old string rep
  1383.  * so storage will be lost if this has not already been done. 
  1384.  *
  1385.  * Results:
  1386.  * None.
  1387.  *
  1388.  * Side effects:
  1389.  * The object's string is set to a valid string that results from
  1390.  * the list-to-string conversion. This string will be empty if the
  1391.  * list has no elements. The list internal representation
  1392.  * should not be NULL and we assume it is not NULL.
  1393.  *
  1394.  *----------------------------------------------------------------------
  1395.  */
  1396. static void
  1397. UpdateStringOfList(listPtr)
  1398.     Tcl_Obj *listPtr; /* List object with string rep to update. */
  1399. {
  1400. #   define LOCAL_SIZE 20
  1401.     int localFlags[LOCAL_SIZE], *flagPtr;
  1402.     List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
  1403.     int numElems = listRepPtr->elemCount;
  1404.     register int i;
  1405.     char *elem, *dst;
  1406.     int length;
  1407.     /*
  1408.      * Convert each element of the list to string form and then convert it
  1409.      * to proper list element form, adding it to the result buffer.
  1410.      */
  1411.     /*
  1412.      * Pass 1: estimate space, gather flags.
  1413.      */
  1414.     if (numElems <= LOCAL_SIZE) {
  1415. flagPtr = localFlags;
  1416.     } else {
  1417. flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
  1418.     }
  1419.     listPtr->length = 1;
  1420.     for (i = 0; i < numElems; i++) {
  1421. elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
  1422. listPtr->length += Tcl_ScanCountedElement(elem, length,
  1423. &flagPtr[i]) + 1;
  1424. /*
  1425.  * Check for continued sanity. [Bug 1267380]
  1426.  */
  1427. if (listPtr->length < 1) {
  1428.     Tcl_Panic("string representation size exceeds sane bounds");
  1429. }
  1430.     }
  1431.     /*
  1432.      * Pass 2: copy into string rep buffer.
  1433.      */
  1434.     listPtr->bytes = ckalloc((unsigned) listPtr->length);
  1435.     dst = listPtr->bytes;
  1436.     for (i = 0; i < numElems; i++) {
  1437. elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
  1438. dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
  1439. *dst = ' ';
  1440. dst++;
  1441.     }
  1442.     if (flagPtr != localFlags) {
  1443. ckfree((char *) flagPtr);
  1444.     }
  1445.     if (dst == listPtr->bytes) {
  1446. *dst = 0;
  1447.     } else {
  1448. dst--;
  1449. *dst = 0;
  1450.     }
  1451.     listPtr->length = dst - listPtr->bytes;
  1452. }