/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcllistobj.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcllistobj.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 25 - (hide annotations) (download)
Sat Oct 8 06:43:03 2016 UTC (7 years, 7 months ago) by dashley
Original Path: sf_code/esrgpcpj/shared/tcl_base/tcllistobj.c
File MIME type: text/plain
File size: 33924 byte(s)
Initial commit.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tcllistobj.c,v 1.1.1.1 2001/06/13 04:42:36 dtashley Exp $ */
2    
3     /*
4     * tclListObj.c --
5     *
6     * This file contains procedures that implement the Tcl list object
7     * type.
8     *
9     * Copyright (c) 1995-1997 Sun Microsystems, Inc.
10     * Copyright (c) 1998 by Scriptics Corporation.
11     *
12     * See the file "license.terms" for information on usage and redistribution
13     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14     *
15     * RCS: @(#) $Id: tcllistobj.c,v 1.1.1.1 2001/06/13 04:42:36 dtashley Exp $
16     */
17    
18     #include "tclInt.h"
19    
20     /*
21     * Prototypes for procedures defined later in this file:
22     */
23    
24     static void DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
25     Tcl_Obj *copyPtr));
26     static void FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
27     static int SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
28     Tcl_Obj *objPtr));
29     static void UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
30    
31     /*
32     * The structure below defines the list Tcl object type by means of
33     * procedures that can be invoked by generic object code.
34     */
35    
36     Tcl_ObjType tclListType = {
37     "list", /* name */
38     FreeListInternalRep, /* freeIntRepProc */
39     DupListInternalRep, /* dupIntRepProc */
40     UpdateStringOfList, /* updateStringProc */
41     SetListFromAny /* setFromAnyProc */
42     };
43    
44     /*
45     *----------------------------------------------------------------------
46     *
47     * Tcl_NewListObj --
48     *
49     * This procedure is normally called when not debugging: i.e., when
50     * TCL_MEM_DEBUG is not defined. It creates a new list object from an
51     * (objc,objv) array: that is, each of the objc elements of the array
52     * referenced by objv is inserted as an element into a new Tcl object.
53     *
54     * When TCL_MEM_DEBUG is defined, this procedure just returns the
55     * result of calling the debugging version Tcl_DbNewListObj.
56     *
57     * Results:
58     * A new list object is returned that is initialized from the object
59     * pointers in objv. If objc is less than or equal to zero, an empty
60     * object is returned. The new object's string representation
61     * is left NULL. The resulting new list object has ref count 0.
62     *
63     * Side effects:
64     * The ref counts of the elements in objv are incremented since the
65     * resulting list now refers to them.
66     *
67     *----------------------------------------------------------------------
68     */
69    
70     #ifdef TCL_MEM_DEBUG
71     #undef Tcl_NewListObj
72    
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    
81     #else /* if not TCL_MEM_DEBUG */
82    
83     Tcl_Obj *
84     Tcl_NewListObj(objc, objv)
85     int objc; /* Count of objects referenced by objv. */
86     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
87     {
88     register Tcl_Obj *listPtr;
89     register Tcl_Obj **elemPtrs;
90     register List *listRepPtr;
91     int i;
92    
93     TclNewObj(listPtr);
94    
95     if (objc > 0) {
96     Tcl_InvalidateStringRep(listPtr);
97    
98     elemPtrs = (Tcl_Obj **)
99     ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
100     for (i = 0; i < objc; i++) {
101     elemPtrs[i] = objv[i];
102     Tcl_IncrRefCount(elemPtrs[i]);
103     }
104    
105     listRepPtr = (List *) ckalloc(sizeof(List));
106     listRepPtr->maxElemCount = objc;
107     listRepPtr->elemCount = objc;
108     listRepPtr->elements = elemPtrs;
109    
110     listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
111     listPtr->typePtr = &tclListType;
112     }
113     return listPtr;
114     }
115     #endif /* if TCL_MEM_DEBUG */
116    
117     /*
118     *----------------------------------------------------------------------
119     *
120     * Tcl_DbNewListObj --
121     *
122     * This procedure is normally called when debugging: i.e., when
123     * TCL_MEM_DEBUG is defined. It creates new list objects. It is the
124     * same as the Tcl_NewListObj procedure above except that it calls
125     * Tcl_DbCkalloc directly with the file name and line number from its
126     * caller. This simplifies debugging since then the checkmem command
127     * will report the correct file name and line number when reporting
128     * objects that haven't been freed.
129     *
130     * When TCL_MEM_DEBUG is not defined, this procedure just returns the
131     * result of calling Tcl_NewListObj.
132     *
133     * Results:
134     * A new list object is returned that is initialized from the object
135     * pointers in objv. If objc is less than or equal to zero, an empty
136     * object is returned. The new object's string representation
137     * is left NULL. The new list object has ref count 0.
138     *
139     * Side effects:
140     * The ref counts of the elements in objv are incremented since the
141     * resulting list now refers to them.
142     *
143     *----------------------------------------------------------------------
144     */
145    
146     #ifdef TCL_MEM_DEBUG
147    
148     Tcl_Obj *
149     Tcl_DbNewListObj(objc, objv, file, line)
150     int objc; /* Count of objects referenced by objv. */
151     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
152     char *file; /* The name of the source file calling this
153     * procedure; used for debugging. */
154     int line; /* Line number in the source file; used
155     * for debugging. */
156     {
157     register Tcl_Obj *listPtr;
158     register Tcl_Obj **elemPtrs;
159     register List *listRepPtr;
160     int i;
161    
162     TclDbNewObj(listPtr, file, line);
163    
164     if (objc > 0) {
165     Tcl_InvalidateStringRep(listPtr);
166    
167     elemPtrs = (Tcl_Obj **)
168     ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
169     for (i = 0; i < objc; i++) {
170     elemPtrs[i] = objv[i];
171     Tcl_IncrRefCount(elemPtrs[i]);
172     }
173    
174     listRepPtr = (List *) ckalloc(sizeof(List));
175     listRepPtr->maxElemCount = objc;
176     listRepPtr->elemCount = objc;
177     listRepPtr->elements = elemPtrs;
178    
179     listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
180     listPtr->typePtr = &tclListType;
181     }
182     return listPtr;
183     }
184    
185     #else /* if not TCL_MEM_DEBUG */
186    
187     Tcl_Obj *
188     Tcl_DbNewListObj(objc, objv, file, line)
189     int objc; /* Count of objects referenced by objv. */
190     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
191     char *file; /* The name of the source file calling this
192     * procedure; used for debugging. */
193     int line; /* Line number in the source file; used
194     * for debugging. */
195     {
196     return Tcl_NewListObj(objc, objv);
197     }
198     #endif /* TCL_MEM_DEBUG */
199    
200     /*
201     *----------------------------------------------------------------------
202     *
203     * Tcl_SetListObj --
204     *
205     * Modify an object to be a list containing each of the objc elements
206     * of the object array referenced by objv.
207     *
208     * Results:
209     * None.
210     *
211     * Side effects:
212     * The object is made a list object and is initialized from the object
213     * pointers in objv. If objc is less than or equal to zero, an empty
214     * object is returned. The new object's string representation
215     * is left NULL. The ref counts of the elements in objv are incremented
216     * since the list now refers to them. The object's old string and
217     * internal representations are freed and its type is set NULL.
218     *
219     *----------------------------------------------------------------------
220     */
221    
222     void
223     Tcl_SetListObj(objPtr, objc, objv)
224     Tcl_Obj *objPtr; /* Object whose internal rep to init. */
225     int objc; /* Count of objects referenced by objv. */
226     Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
227     {
228     register Tcl_Obj **elemPtrs;
229     register List *listRepPtr;
230     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
231     int i;
232    
233     if (Tcl_IsShared(objPtr)) {
234     panic("Tcl_SetListObj called with shared object");
235     }
236    
237     /*
238     * Free any old string rep and any internal rep for the old type.
239     */
240    
241     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
242     oldTypePtr->freeIntRepProc(objPtr);
243     }
244     objPtr->typePtr = NULL;
245     Tcl_InvalidateStringRep(objPtr);
246    
247     /*
248     * Set the object's type to "list" and initialize the internal rep.
249     * However, if there are no elements to put in the list, just give
250     * the object an empty string rep and a NULL type.
251     */
252    
253     if (objc > 0) {
254     elemPtrs = (Tcl_Obj **)
255     ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
256     for (i = 0; i < objc; i++) {
257     elemPtrs[i] = objv[i];
258     Tcl_IncrRefCount(elemPtrs[i]);
259     }
260    
261     listRepPtr = (List *) ckalloc(sizeof(List));
262     listRepPtr->maxElemCount = objc;
263     listRepPtr->elemCount = objc;
264     listRepPtr->elements = elemPtrs;
265    
266     objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
267     objPtr->typePtr = &tclListType;
268     } else {
269     objPtr->bytes = tclEmptyStringRep;
270     }
271     }
272    
273     /*
274     *----------------------------------------------------------------------
275     *
276     * Tcl_ListObjGetElements --
277     *
278     * This procedure returns an (objc,objv) array of the elements in a
279     * list object.
280     *
281     * Results:
282     * The return value is normally TCL_OK; in this case *objcPtr is set to
283     * the count of list elements and *objvPtr is set to a pointer to an
284     * array of (*objcPtr) pointers to each list element. If listPtr does
285     * not refer to a list object and the object can not be converted to
286     * one, TCL_ERROR is returned and an error message will be left in
287     * the interpreter's result if interp is not NULL.
288     *
289     * The objects referenced by the returned array should be treated as
290     * readonly and their ref counts are _not_ incremented; the caller must
291     * do that if it holds on to a reference. Furthermore, the pointer
292     * and length returned by this procedure may change as soon as any
293     * procedure is called on the list object; be careful about retaining
294     * the pointer in a local data structure.
295     *
296     * Side effects:
297     * The possible conversion of the object referenced by listPtr
298     * to a list object.
299     *
300     *----------------------------------------------------------------------
301     */
302    
303     int
304     Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
305     Tcl_Interp *interp; /* Used to report errors if not NULL. */
306     register Tcl_Obj *listPtr; /* List object for which an element array
307     * is to be returned. */
308     int *objcPtr; /* Where to store the count of objects
309     * referenced by objv. */
310     Tcl_Obj ***objvPtr; /* Where to store the pointer to an array
311     * of pointers to the list's objects. */
312     {
313     register List *listRepPtr;
314    
315     if (listPtr->typePtr != &tclListType) {
316     int result = SetListFromAny(interp, listPtr);
317     if (result != TCL_OK) {
318     return result;
319     }
320     }
321     listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
322     *objcPtr = listRepPtr->elemCount;
323     *objvPtr = listRepPtr->elements;
324     return TCL_OK;
325     }
326    
327     /*
328     *----------------------------------------------------------------------
329     *
330     * Tcl_ListObjAppendList --
331     *
332     * This procedure appends the objects in the list referenced by
333     * elemListPtr to the list object referenced by listPtr. If listPtr is
334     * not already a list object, an attempt will be made to convert it to
335     * one.
336     *
337     * Results:
338     * The return value is normally TCL_OK. If listPtr or elemListPtr do
339     * not refer to list objects and they can not be converted to one,
340     * TCL_ERROR is returned and an error message is left in
341     * the interpreter's result if interp is not NULL.
342     *
343     * Side effects:
344     * The reference counts of the elements in elemListPtr are incremented
345     * since the list now refers to them. listPtr and elemListPtr are
346     * converted, if necessary, to list objects. Also, appending the
347     * new elements may cause listObj's array of element pointers to grow.
348     * listPtr's old string representation, if any, is invalidated.
349     *
350     *----------------------------------------------------------------------
351     */
352    
353     int
354     Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
355     Tcl_Interp *interp; /* Used to report errors if not NULL. */
356     register Tcl_Obj *listPtr; /* List object to append elements to. */
357     Tcl_Obj *elemListPtr; /* List obj with elements to append. */
358     {
359     register List *listRepPtr;
360     int listLen, objc, result;
361     Tcl_Obj **objv;
362    
363     if (Tcl_IsShared(listPtr)) {
364     panic("Tcl_ListObjAppendList called with shared object");
365     }
366     if (listPtr->typePtr != &tclListType) {
367     result = SetListFromAny(interp, listPtr);
368     if (result != TCL_OK) {
369     return result;
370     }
371     }
372     listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
373     listLen = listRepPtr->elemCount;
374    
375     result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
376     if (result != TCL_OK) {
377     return result;
378     }
379    
380     /*
381     * Insert objc new elements starting after the lists's last element.
382     * Delete zero existing elements.
383     */
384    
385     return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
386     }
387    
388     /*
389     *----------------------------------------------------------------------
390     *
391     * Tcl_ListObjAppendElement --
392     *
393     * This procedure is a special purpose version of
394     * Tcl_ListObjAppendList: it appends a single object referenced by
395     * objPtr to the list object referenced by listPtr. If listPtr is not
396     * already a list object, an attempt will be made to convert it to one.
397     *
398     * Results:
399     * The return value is normally TCL_OK; in this case objPtr is added
400     * to the end of listPtr's list. If listPtr does not refer to a list
401     * object and the object can not be converted to one, TCL_ERROR is
402     * returned and an error message will be left in the interpreter's
403     * result if interp is not NULL.
404     *
405     * Side effects:
406     * The ref count of objPtr is incremented since the list now refers
407     * to it. listPtr will be converted, if necessary, to a list object.
408     * Also, appending the new element may cause listObj's array of element
409     * pointers to grow. listPtr's old string representation, if any,
410     * is invalidated.
411     *
412     *----------------------------------------------------------------------
413     */
414    
415     int
416     Tcl_ListObjAppendElement(interp, listPtr, objPtr)
417     Tcl_Interp *interp; /* Used to report errors if not NULL. */
418     Tcl_Obj *listPtr; /* List object to append objPtr to. */
419     Tcl_Obj *objPtr; /* Object to append to listPtr's list. */
420     {
421     register List *listRepPtr;
422     register Tcl_Obj **elemPtrs;
423     int numElems, numRequired;
424    
425     if (Tcl_IsShared(listPtr)) {
426     panic("Tcl_ListObjAppendElement called with shared object");
427     }
428     if (listPtr->typePtr != &tclListType) {
429     int result = SetListFromAny(interp, listPtr);
430     if (result != TCL_OK) {
431     return result;
432     }
433     }
434    
435     listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
436     elemPtrs = listRepPtr->elements;
437     numElems = listRepPtr->elemCount;
438     numRequired = numElems + 1 ;
439    
440     /*
441     * If there is no room in the current array of element pointers,
442     * allocate a new, larger array and copy the pointers to it.
443     */
444    
445     if (numRequired > listRepPtr->maxElemCount) {
446     int newMax = (2 * numRequired);
447     Tcl_Obj **newElemPtrs = (Tcl_Obj **)
448     ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
449    
450     memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
451     (size_t) (numElems * sizeof(Tcl_Obj *)));
452    
453     listRepPtr->maxElemCount = newMax;
454     listRepPtr->elements = newElemPtrs;
455     ckfree((char *) elemPtrs);
456     elemPtrs = newElemPtrs;
457     }
458    
459     /*
460     * Add objPtr to the end of listPtr's array of element
461     * pointers. Increment the ref count for the (now shared) objPtr.
462     */
463    
464     elemPtrs[numElems] = objPtr;
465     Tcl_IncrRefCount(objPtr);
466     listRepPtr->elemCount++;
467    
468     /*
469     * Invalidate any old string representation since the list's internal
470     * representation has changed.
471     */
472    
473     Tcl_InvalidateStringRep(listPtr);
474     return TCL_OK;
475     }
476    
477     /*
478     *----------------------------------------------------------------------
479     *
480     * Tcl_ListObjIndex --
481     *
482     * This procedure returns a pointer to the index'th object from the
483     * list referenced by listPtr. The first element has index 0. If index
484     * is negative or greater than or equal to the number of elements in
485     * the list, a NULL is returned. If listPtr is not a list object, an
486     * attempt will be made to convert it to a list.
487     *
488     * Results:
489     * The return value is normally TCL_OK; in this case objPtrPtr is set
490     * to the Tcl_Obj pointer for the index'th list element or NULL if
491     * index is out of range. This object should be treated as readonly and
492     * its ref count is _not_ incremented; the caller must do that if it
493     * holds on to the reference. If listPtr does not refer to a list and
494     * can't be converted to one, TCL_ERROR is returned and an error
495     * message is left in the interpreter's result if interp is not NULL.
496     *
497     * Side effects:
498     * listPtr will be converted, if necessary, to a list object.
499     *
500     *----------------------------------------------------------------------
501     */
502    
503     int
504     Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
505     Tcl_Interp *interp; /* Used to report errors if not NULL. */
506     register Tcl_Obj *listPtr; /* List object to index into. */
507     register int index; /* Index of element to return. */
508     Tcl_Obj **objPtrPtr; /* The resulting Tcl_Obj* is stored here. */
509     {
510     register List *listRepPtr;
511    
512     if (listPtr->typePtr != &tclListType) {
513     int result = SetListFromAny(interp, listPtr);
514     if (result != TCL_OK) {
515     return result;
516     }
517     }
518    
519     listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
520     if ((index < 0) || (index >= listRepPtr->elemCount)) {
521     *objPtrPtr = NULL;
522     } else {
523     *objPtrPtr = listRepPtr->elements[index];
524     }
525    
526     return TCL_OK;
527     }
528    
529     /*
530     *----------------------------------------------------------------------
531     *
532     * Tcl_ListObjLength --
533     *
534     * This procedure returns the number of elements in a list object. If
535     * the object is not already a list object, an attempt will be made to
536     * convert it to one.
537     *
538     * Results:
539     * The return value is normally TCL_OK; in this case *intPtr will be
540     * set to the integer count of list elements. If listPtr does not refer
541     * to a list object and the object can not be converted to one,
542     * TCL_ERROR is returned and an error message will be left in
543     * the interpreter's result if interp is not NULL.
544     *
545     * Side effects:
546     * The possible conversion of the argument object to a list object.
547     *
548     *----------------------------------------------------------------------
549     */
550    
551     int
552     Tcl_ListObjLength(interp, listPtr, intPtr)
553     Tcl_Interp *interp; /* Used to report errors if not NULL. */
554     register Tcl_Obj *listPtr; /* List object whose #elements to return. */
555     register int *intPtr; /* The resulting int is stored here. */
556     {
557     register List *listRepPtr;
558    
559     if (listPtr->typePtr != &tclListType) {
560     int result = SetListFromAny(interp, listPtr);
561     if (result != TCL_OK) {
562     return result;
563     }
564     }
565    
566     listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
567     *intPtr = listRepPtr->elemCount;
568     return TCL_OK;
569     }
570    
571     /*
572     *----------------------------------------------------------------------
573     *
574     * Tcl_ListObjReplace --
575     *
576     * This procedure replaces zero or more elements of the list referenced
577     * by listPtr with the objects from an (objc,objv) array.
578     * The objc elements of the array referenced by objv replace the
579     * count elements in listPtr starting at first.
580     *
581     * If the argument first is zero or negative, it refers to the first
582     * element. If first is greater than or equal to the number of elements
583     * in the list, then no elements are deleted; the new elements are
584     * appended to the list. Count gives the number of elements to
585     * replace. If count is zero or negative then no elements are deleted;
586     * the new elements are simply inserted before first.
587     *
588     * The argument objv refers to an array of objc pointers to the new
589     * elements to be added to listPtr in place of those that were
590     * deleted. If objv is NULL, no new elements are added. If listPtr is
591     * not a list object, an attempt will be made to convert it to one.
592     *
593     * Results:
594     * The return value is normally TCL_OK. If listPtr does
595     * not refer to a list object and can not be converted to one,
596     * TCL_ERROR is returned and an error message will be left in
597     * the interpreter's result if interp is not NULL.
598     *
599     * Side effects:
600     * The ref counts of the objc elements in objv are incremented since
601     * the resulting list now refers to them. Similarly, the ref counts for
602     * replaced objects are decremented. listPtr is converted, if
603     * necessary, to a list object. listPtr's old string representation, if
604     * any, is freed.
605     *
606     *----------------------------------------------------------------------
607     */
608    
609     int
610     Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
611     Tcl_Interp *interp; /* Used for error reporting if not NULL. */
612     Tcl_Obj *listPtr; /* List object whose elements to replace. */
613     int first; /* Index of first element to replace. */
614     int count; /* Number of elements to replace. */
615     int objc; /* Number of objects to insert. */
616     Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects
617     * to insert. */
618     {
619     List *listRepPtr;
620     register Tcl_Obj **elemPtrs, **newPtrs;
621     Tcl_Obj *victimPtr;
622     int numElems, numRequired, numAfterLast;
623     int start, shift, newMax, i, j, result;
624    
625     if (Tcl_IsShared(listPtr)) {
626     panic("Tcl_ListObjReplace called with shared object");
627     }
628     if (listPtr->typePtr != &tclListType) {
629     result = SetListFromAny(interp, listPtr);
630     if (result != TCL_OK) {
631     return result;
632     }
633     }
634     listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
635     elemPtrs = listRepPtr->elements;
636     numElems = listRepPtr->elemCount;
637    
638     if (first < 0) {
639     first = 0;
640     }
641     if (first >= numElems) {
642     first = numElems; /* so we'll insert after last element */
643     }
644     if (count < 0) {
645     count = 0;
646     }
647    
648     numRequired = (numElems - count + objc);
649     if (numRequired <= listRepPtr->maxElemCount) {
650     /*
651     * Enough room in the current array. First "delete" count
652     * elements starting at first.
653     */
654    
655     for (i = 0, j = first; i < count; i++, j++) {
656     victimPtr = elemPtrs[j];
657     TclDecrRefCount(victimPtr);
658     }
659    
660     /*
661     * Shift the elements after the last one removed to their
662     * new locations.
663     */
664    
665     start = (first + count);
666     numAfterLast = (numElems - start);
667     shift = (objc - count); /* numNewElems - numDeleted */
668     if ((numAfterLast > 0) && (shift != 0)) {
669     Tcl_Obj **src, **dst;
670    
671     if (shift < 0) {
672     for (src = elemPtrs + start, dst = src + shift;
673     numAfterLast > 0; numAfterLast--, src++, dst++) {
674     *dst = *src;
675     }
676     } else {
677     for (src = elemPtrs + numElems - 1, dst = src + shift;
678     numAfterLast > 0; numAfterLast--, src--, dst--) {
679     *dst = *src;
680     }
681     }
682     }
683    
684     /*
685     * Insert the new elements into elemPtrs before "first".
686     */
687    
688     for (i = 0, j = first; i < objc; i++, j++) {
689     elemPtrs[j] = objv[i];
690     Tcl_IncrRefCount(objv[i]);
691     }
692    
693     /*
694     * Update the count of elements.
695     */
696    
697     listRepPtr->elemCount = numRequired;
698     } else {
699     /*
700     * Not enough room in the current array. Allocate a larger array and
701     * insert elements into it.
702     */
703    
704     newMax = (2 * numRequired);
705     newPtrs = (Tcl_Obj **)
706     ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
707    
708     /*
709     * Copy over the elements before "first".
710     */
711    
712     if (first > 0) {
713     memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
714     (size_t) (first * sizeof(Tcl_Obj *)));
715     }
716    
717     /*
718     * "Delete" count elements starting at first.
719     */
720    
721     for (i = 0, j = first; i < count; i++, j++) {
722     victimPtr = elemPtrs[j];
723     TclDecrRefCount(victimPtr);
724     }
725    
726     /*
727     * Copy the elements after the last one removed, shifted to
728     * their new locations.
729     */
730    
731     start = (first + count);
732     numAfterLast = (numElems - start);
733     if (numAfterLast > 0) {
734     memcpy((VOID *) &(newPtrs[first + objc]),
735     (VOID *) &(elemPtrs[start]),
736     (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
737     }
738    
739     /*
740     * Insert the new elements before "first" and update the
741     * count of elements.
742     */
743    
744     for (i = 0, j = first; i < objc; i++, j++) {
745     newPtrs[j] = objv[i];
746     Tcl_IncrRefCount(objv[i]);
747     }
748    
749     listRepPtr->elemCount = numRequired;
750     listRepPtr->maxElemCount = newMax;
751     listRepPtr->elements = newPtrs;
752     ckfree((char *) elemPtrs);
753     }
754    
755     /*
756     * Invalidate and free any old string representation since it no longer
757     * reflects the list's internal representation.
758     */
759    
760     Tcl_InvalidateStringRep(listPtr);
761     return TCL_OK;
762     }
763    
764     /*
765     *----------------------------------------------------------------------
766     *
767     * FreeListInternalRep --
768     *
769     * Deallocate the storage associated with a list object's internal
770     * representation.
771     *
772     * Results:
773     * None.
774     *
775     * Side effects:
776     * Frees listPtr's List* internal representation and sets listPtr's
777     * internalRep.otherValuePtr to NULL. Decrements the ref counts
778     * of all element objects, which may free them.
779     *
780     *----------------------------------------------------------------------
781     */
782    
783     static void
784     FreeListInternalRep(listPtr)
785     Tcl_Obj *listPtr; /* List object with internal rep to free. */
786     {
787     register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
788     register Tcl_Obj **elemPtrs = listRepPtr->elements;
789     register Tcl_Obj *objPtr;
790     int numElems = listRepPtr->elemCount;
791     int i;
792    
793     for (i = 0; i < numElems; i++) {
794     objPtr = elemPtrs[i];
795     Tcl_DecrRefCount(objPtr);
796     }
797     ckfree((char *) elemPtrs);
798     ckfree((char *) listRepPtr);
799     }
800    
801     /*
802     *----------------------------------------------------------------------
803     *
804     * DupListInternalRep --
805     *
806     * Initialize the internal representation of a list Tcl_Obj to a
807     * copy of the internal representation of an existing list object.
808     *
809     * Results:
810     * None.
811     *
812     * Side effects:
813     * "srcPtr"s list internal rep pointer should not be NULL and we assume
814     * it is not NULL. We set "copyPtr"s internal rep to a pointer to a
815     * newly allocated List structure that, in turn, points to "srcPtr"s
816     * element objects. Those element objects are not actually copied but
817     * are shared between "srcPtr" and "copyPtr". The ref count of each
818     * element object is incremented.
819     *
820     *----------------------------------------------------------------------
821     */
822    
823     static void
824     DupListInternalRep(srcPtr, copyPtr)
825     Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
826     Tcl_Obj *copyPtr; /* Object with internal rep to set. */
827     {
828     List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
829     int numElems = srcListRepPtr->elemCount;
830     int maxElems = srcListRepPtr->maxElemCount;
831     register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
832     register Tcl_Obj **copyElemPtrs;
833     register List *copyListRepPtr;
834     int i;
835    
836     /*
837     * Allocate a new List structure that points to "srcPtr"s element
838     * objects. Increment the ref counts for those (now shared) element
839     * objects.
840     */
841    
842     copyElemPtrs = (Tcl_Obj **)
843     ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
844     for (i = 0; i < numElems; i++) {
845     copyElemPtrs[i] = srcElemPtrs[i];
846     Tcl_IncrRefCount(copyElemPtrs[i]);
847     }
848    
849     copyListRepPtr = (List *) ckalloc(sizeof(List));
850     copyListRepPtr->maxElemCount = maxElems;
851     copyListRepPtr->elemCount = numElems;
852     copyListRepPtr->elements = copyElemPtrs;
853    
854     copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
855     copyPtr->typePtr = &tclListType;
856     }
857    
858     /*
859     *----------------------------------------------------------------------
860     *
861     * SetListFromAny --
862     *
863     * Attempt to generate a list internal form for the Tcl object
864     * "objPtr".
865     *
866     * Results:
867     * The return value is TCL_OK or TCL_ERROR. If an error occurs during
868     * conversion, an error message is left in the interpreter's result
869     * unless "interp" is NULL.
870     *
871     * Side effects:
872     * If no error occurs, a list is stored as "objPtr"s internal
873     * representation.
874     *
875     *----------------------------------------------------------------------
876     */
877    
878     static int
879     SetListFromAny(interp, objPtr)
880     Tcl_Interp *interp; /* Used for error reporting if not NULL. */
881     Tcl_Obj *objPtr; /* The object to convert. */
882     {
883     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
884     char *string, *s;
885     CONST char *elemStart, *nextElem;
886     int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
887     char *limit; /* Points just after string's last byte. */
888     register CONST char *p;
889     register Tcl_Obj **elemPtrs;
890     register Tcl_Obj *elemPtr;
891     List *listRepPtr;
892    
893     /*
894     * Get the string representation. Make it up-to-date if necessary.
895     */
896    
897     string = Tcl_GetStringFromObj(objPtr, &length);
898    
899     /*
900     * Parse the string into separate string objects, and create a List
901     * structure that points to the element string objects. We use a
902     * modified version of Tcl_SplitList's implementation to avoid one
903     * malloc and a string copy for each list element. First, estimate the
904     * number of elements by counting the number of space characters in the
905     * list.
906     */
907    
908     limit = (string + length);
909     estCount = 1;
910     for (p = string; p < limit; p++) {
911     if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
912     estCount++;
913     }
914     }
915    
916     /*
917     * Allocate a new List structure with enough room for "estCount"
918     * elements. Each element is a pointer to a Tcl_Obj with the appropriate
919     * string rep. The initial "estCount" elements are set using the
920     * corresponding "argv" strings.
921     */
922    
923     elemPtrs = (Tcl_Obj **)
924     ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
925     for (p = string, lenRemain = length, i = 0;
926     lenRemain > 0;
927     p = nextElem, lenRemain = (limit - nextElem), i++) {
928     result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
929     &elemSize, &hasBrace);
930     if (result != TCL_OK) {
931     for (j = 0; j < i; j++) {
932     elemPtr = elemPtrs[j];
933     Tcl_DecrRefCount(elemPtr);
934     }
935     ckfree((char *) elemPtrs);
936     return result;
937     }
938     if (elemStart >= limit) {
939     break;
940     }
941     if (i > estCount) {
942     panic("SetListFromAny: bad size estimate for list");
943     }
944    
945     /*
946     * Allocate a Tcl object for the element and initialize it from the
947     * "elemSize" bytes starting at "elemStart".
948     */
949    
950     s = ckalloc((unsigned) elemSize + 1);
951     if (hasBrace) {
952     memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
953     s[elemSize] = 0;
954     } else {
955     elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
956     }
957    
958     TclNewObj(elemPtr);
959     elemPtr->bytes = s;
960     elemPtr->length = elemSize;
961     elemPtrs[i] = elemPtr;
962     Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
963     }
964    
965     listRepPtr = (List *) ckalloc(sizeof(List));
966     listRepPtr->maxElemCount = estCount;
967     listRepPtr->elemCount = i;
968     listRepPtr->elements = elemPtrs;
969    
970     /*
971     * Free the old internalRep before setting the new one. We do this as
972     * late as possible to allow the conversion code, in particular
973     * Tcl_GetStringFromObj, to use that old internalRep.
974     */
975    
976     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
977     oldTypePtr->freeIntRepProc(objPtr);
978     }
979    
980     objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
981     objPtr->typePtr = &tclListType;
982     return TCL_OK;
983     }
984    
985     /*
986     *----------------------------------------------------------------------
987     *
988     * UpdateStringOfList --
989     *
990     * Update the string representation for a list object.
991     * Note: This procedure does not invalidate an existing old string rep
992     * so storage will be lost if this has not already been done.
993     *
994     * Results:
995     * None.
996     *
997     * Side effects:
998     * The object's string is set to a valid string that results from
999     * the list-to-string conversion. This string will be empty if the
1000     * list has no elements. The list internal representation
1001     * should not be NULL and we assume it is not NULL.
1002     *
1003     *----------------------------------------------------------------------
1004     */
1005    
1006     static void
1007     UpdateStringOfList(listPtr)
1008     Tcl_Obj *listPtr; /* List object with string rep to update. */
1009     {
1010     # define LOCAL_SIZE 20
1011     int localFlags[LOCAL_SIZE], *flagPtr;
1012     List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
1013     int numElems = listRepPtr->elemCount;
1014     register int i;
1015     char *elem, *dst;
1016     int length;
1017    
1018     /*
1019     * Convert each element of the list to string form and then convert it
1020     * to proper list element form, adding it to the result buffer.
1021     */
1022    
1023     /*
1024     * Pass 1: estimate space, gather flags.
1025     */
1026    
1027     if (numElems <= LOCAL_SIZE) {
1028     flagPtr = localFlags;
1029     } else {
1030     flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
1031     }
1032     listPtr->length = 1;
1033     for (i = 0; i < numElems; i++) {
1034     elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1035     listPtr->length += Tcl_ScanCountedElement(elem, length,
1036     &flagPtr[i]) + 1;
1037     }
1038    
1039     /*
1040     * Pass 2: copy into string rep buffer.
1041     */
1042    
1043     listPtr->bytes = ckalloc((unsigned) listPtr->length);
1044     dst = listPtr->bytes;
1045     for (i = 0; i < numElems; i++) {
1046     elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1047     dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
1048     *dst = ' ';
1049     dst++;
1050     }
1051     if (flagPtr != localFlags) {
1052     ckfree((char *) flagPtr);
1053     }
1054     if (dst == listPtr->bytes) {
1055     *dst = 0;
1056     } else {
1057     dst--;
1058     *dst = 0;
1059     }
1060     listPtr->length = dst - listPtr->bytes;
1061     }
1062    
1063    
1064     /* $History: tcllistobj.c $
1065     *
1066     * ***************** Version 1 *****************
1067     * User: Dtashley Date: 1/02/01 Time: 1:32a
1068     * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
1069     * Initial check-in.
1070     */
1071    
1072     /* End of TCLLISTOBJ.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25