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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25