Fork me on GitHub

source: git/external/tcl/tclListObj.c

Last change on this file was adeddd8, checked in by Pavel Demin <pavel-demin@…>, 5 years ago

remove debug code from Tcl

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