/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tcllistobj.c

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tcllistobj.c

Parent Directory | Revision Log | View Patch Patch

-revision 70 by dashley,
Sun Oct 30 21:57:38 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * tclListObj.c --
   *
   *      This file contains procedures that implement the Tcl list object
   *      type.
   *
   * Copyright (c) 1995-1997 Sun Microsystems, Inc.
   * Copyright (c) 1998 by Scriptics Corporation.
   *
   * 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.1.1.1 2001/06/13 04:42:36 dtashley Exp $
   */
  #include "tclInt.h"
  /*
   * Prototypes for procedures defined later in this file:
   */
  static void             DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
                              Tcl_Obj *copyPtr));
  static void             FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
  static int              SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
                              Tcl_Obj *objPtr));
  static void             UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
  /*
   * The structure below defines the list Tcl object type by means of
   * procedures that can be invoked by generic object code.
   */
  Tcl_ObjType tclListType = {
      "list",                             /* name */
      FreeListInternalRep,                /* freeIntRepProc */
      DupListInternalRep,                 /* dupIntRepProc */
      UpdateStringOfList,                 /* updateStringProc */
      SetListFromAny                      /* setFromAnyProc */
  };
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_NewListObj --
   *
   *      This procedure is normally called when not debugging: i.e., when
   *      TCL_MEM_DEBUG is not defined. It creates a new list object from an
   *      (objc,objv) array: that is, each of the objc elements of the array
   *      referenced by objv is inserted as an element into a new Tcl object.
   *
   *      When TCL_MEM_DEBUG is defined, this procedure just returns the
   *      result of calling the debugging version Tcl_DbNewListObj.
   *
   * 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. 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 Tcl_NewListObj
  Tcl_Obj *
  Tcl_NewListObj(objc, objv)
      int objc;                   /* Count of objects referenced by objv. */
      Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
  {
      return Tcl_DbNewListObj(objc, objv, "unknown", 0);
  }
  #else /* if not TCL_MEM_DEBUG */
  Tcl_Obj *
  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;
      TclNewObj(listPtr);
      if (objc > 0) {
          Tcl_InvalidateStringRep(listPtr);
          elemPtrs = (Tcl_Obj **)
              ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
          for (i = 0;  i < objc;  i++) {
              elemPtrs[i] = objv[i];
              Tcl_IncrRefCount(elemPtrs[i]);
          }
          listRepPtr = (List *) ckalloc(sizeof(List));
          listRepPtr->maxElemCount = objc;
          listRepPtr->elemCount    = objc;
          listRepPtr->elements     = elemPtrs;
          listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
          listPtr->typePtr = &tclListType;
      }
      return listPtr;
  }
  #endif /* if TCL_MEM_DEBUG */
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_DbNewListObj --
   *
   *      This procedure is normally called when debugging: i.e., when
   *      TCL_MEM_DEBUG is defined. It creates new list objects. It is the
   *      same as the Tcl_NewListObj procedure above except that it calls
   *      Tcl_DbCkalloc directly with the file name and line number from its
   *      caller. This simplifies debugging since then the checkmem command
   *      will report the correct file name and line number when reporting
   *      objects that haven't been freed.
   *
   *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
   *      result of calling Tcl_NewListObj.
   *
   * 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. The new object's string representation
   *      is left NULL. The 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
  Tcl_Obj *
  Tcl_DbNewListObj(objc, objv, file, line)
      int objc;                   /* Count of objects referenced by objv. */
      Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
      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;
      register Tcl_Obj **elemPtrs;
      register List *listRepPtr;
      int i;
      TclDbNewObj(listPtr, file, line);
      if (objc > 0) {
          Tcl_InvalidateStringRep(listPtr);
          elemPtrs = (Tcl_Obj **)
              ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
          for (i = 0;  i < objc;  i++) {
              elemPtrs[i] = objv[i];
              Tcl_IncrRefCount(elemPtrs[i]);
          }
          listRepPtr = (List *) ckalloc(sizeof(List));
          listRepPtr->maxElemCount = objc;
          listRepPtr->elemCount    = objc;
          listRepPtr->elements     = elemPtrs;
          listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
          listPtr->typePtr = &tclListType;
      }
      return listPtr;
  }
  #else /* if not TCL_MEM_DEBUG */
  Tcl_Obj *
  Tcl_DbNewListObj(objc, objv, file, line)
      int objc;                   /* Count of objects referenced by objv. */
      Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
      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 Tcl_NewListObj(objc, objv);
  }
  #endif /* TCL_MEM_DEBUG */
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_SetListObj --
   *
   *      Modify an object to be a list containing each of the objc elements
   *      of the object array referenced by objv.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      The object is made a list object and is initialized from the object
   *      pointers in objv. If objc is less than or equal to zero, an empty
   *      object is returned. The new object's string representation
   *      is left NULL. The ref counts of the elements in objv are incremented
   *      since the list now refers to them. The object's old string and
   *      internal representations are freed and its type is set NULL.
   *
   *----------------------------------------------------------------------
   */
  void
  Tcl_SetListObj(objPtr, objc, objv)
      Tcl_Obj *objPtr;            /* Object whose internal rep to init. */
      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;
      Tcl_ObjType *oldTypePtr = objPtr->typePtr;
      int i;
      if (Tcl_IsShared(objPtr)) {
          panic("Tcl_SetListObj called with shared object");
      }
      /*
       * Free any old string rep and any internal rep for the old type.
       */
      if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
          oldTypePtr->freeIntRepProc(objPtr);
      }
      objPtr->typePtr = NULL;
      Tcl_InvalidateStringRep(objPtr);
      /*
       * Set the object's type to "list" and initialize the internal rep.
       * However, if there are no elements to put in the list, just give
       * the object an empty string rep and a NULL type.
       */
      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 = (List *) ckalloc(sizeof(List));
          listRepPtr->maxElemCount = objc;
          listRepPtr->elemCount    = objc;
          listRepPtr->elements     = elemPtrs;
          objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
          objPtr->typePtr = &tclListType;
      } else {
          objPtr->bytes = tclEmptyStringRep;
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_ListObjGetElements --
   *
   *      This procedure returns an (objc,objv) array of the elements in a
   *      list object.
   *
   * Results:
   *      The return value is normally TCL_OK; in this case *objcPtr is set to
   *      the count of list elements and *objvPtr is set to a pointer to an
   *      array of (*objcPtr) pointers to each list element. If listPtr does
   *      not refer to a list object and the object can not be converted to
   *      one, TCL_ERROR is returned and an error message will be left in
   *      the interpreter's result if interp is not NULL.
   *
   *      The objects referenced by the returned array should be treated as
   *      readonly and their ref counts are _not_ incremented; the caller must
   *      do that if it holds on to a reference. Furthermore, the pointer
   *      and length returned by this procedure may change as soon as any
   *      procedure is called on the list object; be careful about retaining
   *      the pointer in a local data structure.
   *
   * Side effects:
   *      The possible conversion of the object referenced by listPtr
   *      to a list object.
   *
   *----------------------------------------------------------------------
   */
  int
  Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
      Tcl_Interp *interp;         /* Used to report errors if not NULL. */
      register Tcl_Obj *listPtr;  /* List object for which an element array
                                   * is to be returned. */
      int *objcPtr;               /* Where to store the count of objects
                                   * referenced by objv. */
      Tcl_Obj ***objvPtr;         /* Where to store the pointer to an array
                                   * of pointers to the list's objects. */
  {
      register List *listRepPtr;
      if (listPtr->typePtr != &tclListType) {
          int result = SetListFromAny(interp, listPtr);
          if (result != TCL_OK) {
              return result;
          }
      }
      listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      *objcPtr = listRepPtr->elemCount;
      *objvPtr = listRepPtr->elements;
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_ListObjAppendList --
   *
   *      This procedure appends the objects in the list referenced by
   *      elemListPtr to the list object referenced by listPtr. If listPtr is
   *      not already a list object, an attempt will be made to convert it to
   *      one.
   *
   * Results:
   *      The return value is normally TCL_OK. If listPtr or elemListPtr do
   *      not refer to list objects and they can not be converted to one,
   *      TCL_ERROR is returned and an error message is left in
   *      the interpreter's result if interp is not NULL.
   *
   * Side effects:
   *      The reference counts of the elements in elemListPtr are incremented
   *      since the list now refers to them. listPtr and elemListPtr are
   *      converted, if necessary, to list objects. Also, appending the
   *      new elements may cause listObj's array of element pointers to grow.
   *      listPtr's old string representation, if any, is invalidated.
   *
   *----------------------------------------------------------------------
   */
  int
  Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
      Tcl_Interp *interp;         /* Used to report errors if not NULL. */
      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)) {
          panic("Tcl_ListObjAppendList called with shared object");
      }
      if (listPtr->typePtr != &tclListType) {
          result = SetListFromAny(interp, listPtr);
          if (result != TCL_OK) {
              return result;
          }
      }
      listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      listLen = listRepPtr->elemCount;
      result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
      if (result != TCL_OK) {
          return result;
      }
      /*
       * Insert objc new elements starting after the lists's last element.
       * Delete zero existing elements.
       */
      return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_ListObjAppendElement --
   *
   *      This procedure is a special purpose version of
   *      Tcl_ListObjAppendList: it appends a single object referenced by
   *      objPtr to the list object referenced by listPtr. If listPtr is not
   *      already a list object, an attempt will be made to convert it to one.
   *
   * Results:
   *      The return value is normally TCL_OK; in this case objPtr is added
   *      to the end of listPtr's list. If listPtr does not refer to a list
   *      object and the object can not be converted to one, TCL_ERROR is
   *      returned and an error message will be left in the interpreter's
   *      result if interp is not NULL.
   *
   * Side effects:
   *      The ref count of objPtr is incremented since the list now refers
   *      to it. listPtr will be converted, if necessary, to a list object.
   *      Also, appending the new element may cause listObj's array of element
   *      pointers to grow. listPtr's old string representation, if any,
   *      is invalidated.
   *
   *----------------------------------------------------------------------
   */
  int
  Tcl_ListObjAppendElement(interp, listPtr, objPtr)
      Tcl_Interp *interp;         /* Used to report errors if not NULL. */
      Tcl_Obj *listPtr;           /* List object to append objPtr to. */
      Tcl_Obj *objPtr;            /* Object to append to listPtr's list. */
  {
      register List *listRepPtr;
      register Tcl_Obj **elemPtrs;
      int numElems, numRequired;
      if (Tcl_IsShared(listPtr)) {
          panic("Tcl_ListObjAppendElement called with shared object");
      }
      if (listPtr->typePtr != &tclListType) {
          int result = SetListFromAny(interp, listPtr);
          if (result != TCL_OK) {
              return result;
          }
      }
      listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      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.
       */
      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;
      }
      /*
       * Add objPtr to the end of listPtr's array of element
       * pointers. Increment the ref count for the (now shared) objPtr.
       */
      elemPtrs[numElems] = objPtr;
      Tcl_IncrRefCount(objPtr);
      listRepPtr->elemCount++;
      /*
       * Invalidate any old string representation since the list's internal
       * representation has changed.
       */
      Tcl_InvalidateStringRep(listPtr);
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_ListObjIndex --
   *
   *      This procedure returns a pointer to the index'th object from the
   *      list referenced by listPtr. The first element has index 0. If index
   *      is negative or greater than or equal to the number of elements in
   *      the list, a NULL is returned. If listPtr is not a list object, an
   *      attempt will be made to convert it to a list.
   *
   * Results:
   *      The return value is normally TCL_OK; in this case objPtrPtr is set
   *      to the Tcl_Obj pointer for the index'th list element or NULL if
   *      index is out of range. This object should be treated as readonly and
   *      its ref count is _not_ incremented; the caller must do that if it
   *      holds on to the reference. If listPtr does not refer to a list and
   *      can't be converted to one, TCL_ERROR is returned and an error
   *      message is left in the interpreter's result if interp is not NULL.
   *
   * Side effects:
   *      listPtr will be converted, if necessary, to a list object.
   *
   *----------------------------------------------------------------------
   */
  int
  Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
      Tcl_Interp *interp;         /* Used to report errors if not NULL. */
      register Tcl_Obj *listPtr;  /* List object to index into. */
      register int index;         /* Index of element to return. */
      Tcl_Obj **objPtrPtr;        /* The resulting Tcl_Obj* is stored here. */
  {
      register List *listRepPtr;
      if (listPtr->typePtr != &tclListType) {
          int result = SetListFromAny(interp, listPtr);
          if (result != TCL_OK) {
              return result;
          }
      }
      listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      if ((index < 0) || (index >= listRepPtr->elemCount)) {
          *objPtrPtr = NULL;
      } else {
          *objPtrPtr = listRepPtr->elements[index];
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_ListObjLength --
   *
   *      This procedure returns the number of elements in a list object. If
   *      the object is not already a list object, an attempt will be made to
   *      convert it to one.
   *
   * Results:
   *      The return value is normally TCL_OK; in this case *intPtr will be
   *      set to the integer count of list elements. If listPtr does not refer
   *      to a list object and the object can not be converted to one,
   *      TCL_ERROR is returned and an error message will be left in
   *      the interpreter's result if interp is not NULL.
   *
   * Side effects:
   *      The possible conversion of the argument object to a list object.
   *
   *----------------------------------------------------------------------
   */
  int
  Tcl_ListObjLength(interp, listPtr, intPtr)
      Tcl_Interp *interp;         /* Used to report errors if not NULL. */
      register Tcl_Obj *listPtr;  /* List object whose #elements to return. */
      register int *intPtr;       /* The resulting int is stored here. */
  {
      register List *listRepPtr;
      if (listPtr->typePtr != &tclListType) {
          int result = SetListFromAny(interp, listPtr);
          if (result != TCL_OK) {
              return result;
          }
      }
      listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      *intPtr = listRepPtr->elemCount;
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_ListObjReplace --
   *
   *      This procedure replaces zero or more elements of the list referenced
   *      by listPtr with the objects from an (objc,objv) array.
   *      The objc elements of the array referenced by objv replace the
   *      count elements in listPtr starting at first.
   *
   *      If the argument first is zero or negative, it refers to the first
   *      element. If first is greater than or equal to the number of elements
   *      in the list, then no elements are deleted; the new elements are
   *      appended to the list. Count gives the number of elements to
   *      replace. If count is zero or negative then no elements are deleted;
   *      the new elements are simply inserted before first.
   *
   *      The argument objv refers to an array of objc pointers to the new
   *      elements to be added to listPtr in place of those that were
   *      deleted. If objv is NULL, no new elements are added. If listPtr is
   *      not a list object, an attempt will be made to convert it to one.
   *
   * Results:
   *      The return value is normally TCL_OK. If listPtr does
   *      not refer to a list object and can not be converted to one,
   *      TCL_ERROR is returned and an error message will be left in
   *      the interpreter's result if interp is not NULL.
   *
   * Side effects:
   *      The ref counts of the objc elements in objv are incremented since
   *      the resulting list now refers to them. Similarly, the ref counts for
   *      replaced objects are decremented. listPtr is converted, if
   *      necessary, to a list object. listPtr's old string representation, if
   *      any, is freed.
   *
   *----------------------------------------------------------------------
   */
  int
  Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
      Tcl_Obj *listPtr;           /* List object whose elements to replace. */
      int first;                  /* Index of first element to replace. */
      int count;                  /* Number of elements to replace. */
      int objc;                   /* Number of objects to insert. */
      Tcl_Obj *CONST objv[];      /* An array of objc pointers to Tcl objects
                                   * to insert. */
  {
      List *listRepPtr;
      register Tcl_Obj **elemPtrs, **newPtrs;
      Tcl_Obj *victimPtr;
      int numElems, numRequired, numAfterLast;
      int start, shift, newMax, i, j, result;
      if (Tcl_IsShared(listPtr)) {
          panic("Tcl_ListObjReplace called with shared object");
      }
      if (listPtr->typePtr != &tclListType) {
          result = SetListFromAny(interp, listPtr);
          if (result != TCL_OK) {
              return result;
          }
      }
      listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      elemPtrs = listRepPtr->elements;
      numElems = listRepPtr->elemCount;
      if (first < 0)  {
          first = 0;
      }
      if (first >= numElems) {
          first = numElems;       /* so we'll insert after last element */
      }
      if (count < 0) {
          count = 0;
      }
      numRequired = (numElems - count + objc);
      if (numRequired <= listRepPtr->maxElemCount) {
          /*
           * Enough room in the current array. First "delete" count
           * elements starting at first.
           */
          for (i = 0, j = first;  i < count;  i++, j++) {
              victimPtr = elemPtrs[j];
              TclDecrRefCount(victimPtr);
          }
          /*
           * Shift the elements after the last one removed to their
           * new locations.
           */
          start = (first + count);
          numAfterLast = (numElems - start);
          shift = (objc - count); /* numNewElems - numDeleted */
          if ((numAfterLast > 0) && (shift != 0)) {
              Tcl_Obj **src, **dst;
              if (shift < 0) {
                  for (src = elemPtrs + start, dst = src + shift;
                          numAfterLast > 0; numAfterLast--, src++, dst++) {
                      *dst = *src;
                  }
              } else {
                  for (src = elemPtrs + numElems - 1, dst = src + shift;
                          numAfterLast > 0; numAfterLast--, src--, dst--) {
                      *dst = *src;
                  }
              }
          }
          /*
           * 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.
           */
          newMax = (2 * numRequired);
          newPtrs = (Tcl_Obj **)
              ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
          /*
           * Copy over the elements before "first".
           */
          if (first > 0) {
              memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
                      (size_t) (first * sizeof(Tcl_Obj *)));
          }
          /*
           * "Delete" count elements starting at first.
           */
          for (i = 0, j = first;  i < count;  i++, j++) {
              victimPtr = elemPtrs[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 *) &(newPtrs[first + objc]),
                      (VOID *) &(elemPtrs[start]),
                      (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
          }
          /*
           * Insert the new elements before "first" and update the
           * count of elements.
           */
          for (i = 0, j = first;  i < objc;  i++, j++) {
              newPtrs[j] = objv[i];
              Tcl_IncrRefCount(objv[i]);
          }
          listRepPtr->elemCount = numRequired;
          listRepPtr->maxElemCount = newMax;
          listRepPtr->elements = newPtrs;
          ckfree((char *) elemPtrs);
      }
      /*
       * Invalidate and free any old string representation since it no longer
       * reflects the list's internal representation.
       */
      Tcl_InvalidateStringRep(listPtr);
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * FreeListInternalRep --
   *
   *      Deallocate the storage associated with a list object's internal
   *      representation.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Frees listPtr's List* internal representation and sets listPtr's
   *      internalRep.otherValuePtr to NULL. Decrements the ref counts
   *      of all element objects, which may free them.
   *
   *----------------------------------------------------------------------
   */
  static void
  FreeListInternalRep(listPtr)
      Tcl_Obj *listPtr;           /* List object with internal rep to free. */
  {
      register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      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);
      }
      ckfree((char *) elemPtrs);
      ckfree((char *) listRepPtr);
  }
  /*
   *----------------------------------------------------------------------
   *
   * DupListInternalRep --
   *
   *      Initialize the internal representation of a list Tcl_Obj to a
   *      copy of 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.
   *
   *----------------------------------------------------------------------
   */
  static void
  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.otherValuePtr;
      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]);
      }
      copyListRepPtr = (List *) ckalloc(sizeof(List));
      copyListRepPtr->maxElemCount = maxElems;
      copyListRepPtr->elemCount    = numElems;
      copyListRepPtr->elements     = copyElemPtrs;
      copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
      copyPtr->typePtr = &tclListType;
  }
  /*
   *----------------------------------------------------------------------
   *
   * SetListFromAny --
   *
   *      Attempt to generate a list internal form for the Tcl object
   *      "objPtr".
   *
   * Results:
   *      The return value is TCL_OK or TCL_ERROR. If an error occurs during
   *      conversion, an error message is left in the interpreter's result
   *      unless "interp" is NULL.
   *
   * Side effects:
   *      If no error occurs, a list is stored as "objPtr"s internal
   *      representation.
   *
   *----------------------------------------------------------------------
   */
  static int
  SetListFromAny(interp, objPtr)
      Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
      Tcl_Obj *objPtr;            /* The object to convert. */
  {
      Tcl_ObjType *oldTypePtr = objPtr->typePtr;
      char *string, *s;
      CONST char *elemStart, *nextElem;
      int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
      char *limit;                /* Points just after string's last byte. */
      register CONST char *p;
      register Tcl_Obj **elemPtrs;
      register Tcl_Obj *elemPtr;
      List *listRepPtr;
      /*
       * Get the string representation. Make it up-to-date if necessary.
       */
      string = Tcl_GetStringFromObj(objPtr, &length);
      /*
       * Parse the string into separate string objects, and create a List
       * structure that points to the element string objects. We use a
       * modified version of Tcl_SplitList's implementation to avoid one
       * malloc and a string copy for each list element. First, estimate the
       * number of elements by counting the number of space characters in the
       * list.
       */
      limit = (string + length);
      estCount = 1;
      for (p = string;  p < limit;  p++) {
          if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
              estCount++;
          }
      }
      /*
       * Allocate a new List structure with enough room for "estCount"
       * elements. Each element is a pointer to a Tcl_Obj with the appropriate
       * string rep. The initial "estCount" elements are set using the
       * corresponding "argv" strings.
       */
      elemPtrs = (Tcl_Obj **)
              ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
      for (p = string, lenRemain = length, i = 0;
              lenRemain > 0;
              p = nextElem, lenRemain = (limit - nextElem), i++) {
          result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
                                  &elemSize, &hasBrace);
          if (result != TCL_OK) {
              for (j = 0;  j < i;  j++) {
                  elemPtr = elemPtrs[j];
                  Tcl_DecrRefCount(elemPtr);
              }
              ckfree((char *) elemPtrs);
              return result;
          }
          if (elemStart >= limit) {
              break;
          }
          if (i > estCount) {
              panic("SetListFromAny: bad size estimate for list");
          }
          /*
           * Allocate a Tcl object for the element and initialize it from the
           * "elemSize" bytes starting at "elemStart".
           */
          s = ckalloc((unsigned) elemSize + 1);
          if (hasBrace) {
              memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);
              s[elemSize] = 0;
          } else {
              elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
          }
          TclNewObj(elemPtr);
          elemPtr->bytes  = s;
          elemPtr->length = elemSize;
          elemPtrs[i] = elemPtr;
          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
       * late as possible to allow the conversion code, in particular
       * Tcl_GetStringFromObj, to use that old internalRep.
       */
      if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
          oldTypePtr->freeIntRepProc(objPtr);
      }
      objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
      objPtr->typePtr = &tclListType;
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * UpdateStringOfList --
   *
   *      Update the string representation for a list object.
   *      Note: This procedure does not invalidate an existing old string rep
   *      so storage will be lost if this has not already been done.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      The object's string is set to a valid string that results from
   *      the list-to-string conversion. This string will be empty if the
   *      list has no elements. The list internal representation
   *      should not be NULL and we assume it is not NULL.
   *
   *----------------------------------------------------------------------
   */
  static void
  UpdateStringOfList(listPtr)
      Tcl_Obj *listPtr;           /* List object with string rep to update. */
  {
  #   define LOCAL_SIZE 20
      int localFlags[LOCAL_SIZE], *flagPtr;
      List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
      int numElems = listRepPtr->elemCount;
      register int i;
      char *elem, *dst;
      int length;
      /*
       * Convert each element of the list to string form and then convert it
       * to proper list element form, adding it to the result buffer.
       */
      /*
       * Pass 1: estimate space, gather flags.
       */
      if (numElems <= LOCAL_SIZE) {
          flagPtr = localFlags;
      } else {
          flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
      }
      listPtr->length = 1;
      for (i = 0; i < numElems; i++) {
          elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
          listPtr->length += Tcl_ScanCountedElement(elem, length,
                  &flagPtr[i]) + 1;
      }
      /*
       * Pass 2: copy into string rep buffer.
       */
      listPtr->bytes = ckalloc((unsigned) listPtr->length);
      dst = listPtr->bytes;
      for (i = 0; i < numElems; i++) {
          elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
          dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
          *dst = ' ';
          dst++;
      }
      if (flagPtr != localFlags) {
          ckfree((char *) flagPtr);
      }
      if (dst == listPtr->bytes) {
          *dst = 0;
      } else {
          dst--;
          *dst = 0;
      }
      listPtr->length = dst - listPtr->bytes;
  }
  /* End of tcllistobj.c */

 Legend:



Removed from v.70
 


changed lines


 
Added in v.71
 Legend:



Removed from v.70
 


changed lines


 
Added in v.71
-Removed from v.70
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25