Fork me on GitHub

source: git/external/tcl/tclListObj.c@ 3731158

ImprovedOutputFile Timing dual_readout llp
Last change on this file since 3731158 was d7d2da3, checked in by pavel <pavel@…>, 12 years ago

move branches/ModularDelphes to trunk

  • Property mode set to 100644
File size: 31.5 KB
RevLine 
[d7d2da3]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 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
72Tcl_Obj *
73Tcl_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
82Tcl_Obj *
83Tcl_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 *
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
148Tcl_Obj *
149Tcl_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
187Tcl_Obj *
188Tcl_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 *
204 * Tcl_SetListObj --
205 *
206 * Modify an object to be a list containing each of the objc elements
207 * of the object array referenced by objv.
208 *
209 * Results:
210 * None.
211 *
212 * Side effects:
213 * The object is made a list object and is initialized from the object
214 * pointers in objv. If objc is less than or equal to zero, an empty
215 * object is returned. The new object's string representation
216 * is left NULL. The ref counts of the elements in objv are incremented
217 * since the list now refers to them. The object's old string and
218 * internal representations are freed and its type is set NULL.
219 *
220 *----------------------------------------------------------------------
221 */
222
223void
224Tcl_SetListObj(objPtr, objc, objv)
225 Tcl_Obj *objPtr; /* Object whose internal rep to init. */
226 int objc; /* Count of objects referenced by objv. */
227 Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
228{
229 register Tcl_Obj **elemPtrs;
230 register List *listRepPtr;
231 Tcl_ObjType *oldTypePtr = objPtr->typePtr;
232 int i;
233
234 if (Tcl_IsShared(objPtr)) {
235 panic("Tcl_SetListObj called with shared object");
236 }
237
238 /*
239 * Free any old string rep and any internal rep for the old type.
240 */
241
242 Tcl_InvalidateStringRep(objPtr);
243 if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
244 oldTypePtr->freeIntRepProc(objPtr);
245 objPtr->typePtr = NULL;
246 }
247
248 /*
249 * Set the object's type to "list" and initialize the internal rep.
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 *
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
303int
304Tcl_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 *
331 * Tcl_ListObjAppendList --
332 *
333 * This procedure appends the objects in the list referenced by
334 * elemListPtr to the list object referenced by listPtr. If listPtr is
335 * not already a list object, an attempt will be made to convert it to
336 * one.
337 *
338 * Results:
339 * The return value is normally TCL_OK. If listPtr or elemListPtr do
340 * not refer to list objects and they can not be converted to one,
341 * TCL_ERROR is returned and an error message is left in
342 * the interpreter's result if interp is not NULL.
343 *
344 * Side effects:
345 * The reference counts of the elements in elemListPtr are incremented
346 * since the list now refers to them. listPtr and elemListPtr are
347 * converted, if necessary, to list objects. Also, appending the
348 * new elements may cause listObj's array of element pointers to grow.
349 * listPtr's old string representation, if any, is invalidated.
350 *
351 *----------------------------------------------------------------------
352 */
353
354int
355Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
356 Tcl_Interp *interp; /* Used to report errors if not NULL. */
357 register Tcl_Obj *listPtr; /* List object to append elements to. */
358 Tcl_Obj *elemListPtr; /* List obj with elements to append. */
359{
360 register List *listRepPtr;
361 int listLen, objc, result;
362 Tcl_Obj **objv;
363
364 if (Tcl_IsShared(listPtr)) {
365 panic("Tcl_ListObjAppendList called with shared object");
366 }
367 if (listPtr->typePtr != &tclListType) {
368 result = SetListFromAny(interp, listPtr);
369 if (result != TCL_OK) {
370 return result;
371 }
372 }
373 listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
374 listLen = listRepPtr->elemCount;
375
376 result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
377 if (result != TCL_OK) {
378 return result;
379 }
380
381 /*
382 * Insert objc new elements starting after the lists's last element.
383 * Delete zero existing elements.
384 */
385
386 return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
387}
388
389
390/*
391 *----------------------------------------------------------------------
392 *
393 * Tcl_ListObjAppendElement --
394 *
395 * This procedure is a special purpose version of
396 * Tcl_ListObjAppendList: it appends a single object referenced by
397 * objPtr to the list object referenced by listPtr. If listPtr is not
398 * already a list object, an attempt will be made to convert it to one.
399 *
400 * Results:
401 * The return value is normally TCL_OK; in this case objPtr is added
402 * to the end of listPtr's list. If listPtr does not refer to a list
403 * object and the object can not be converted to one, TCL_ERROR is
404 * returned and an error message will be left in the interpreter's
405 * result if interp is not NULL.
406 *
407 * Side effects:
408 * The ref count of objPtr is incremented since the list now refers
409 * to it. listPtr will be converted, if necessary, to a list object.
410 * Also, appending the new element may cause listObj's array of element
411 * pointers to grow. listPtr's old string representation, if any,
412 * is invalidated.
413 *
414 *----------------------------------------------------------------------
415 */
416
417int
418Tcl_ListObjAppendElement(interp, listPtr, objPtr)
419 Tcl_Interp *interp; /* Used to report errors if not NULL. */
420 Tcl_Obj *listPtr; /* List object to append objPtr to. */
421 Tcl_Obj *objPtr; /* Object to append to listPtr's list. */
422{
423 register List *listRepPtr;
424 register Tcl_Obj **elemPtrs;
425 int numElems, numRequired;
426
427 if (Tcl_IsShared(listPtr)) {
428 panic("Tcl_ListObjAppendElement called with shared object");
429 }
430 if (listPtr->typePtr != &tclListType) {
431 int result = SetListFromAny(interp, listPtr);
432 if (result != TCL_OK) {
433 return result;
434 }
435 }
436
437 listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
438 elemPtrs = listRepPtr->elements;
439 numElems = listRepPtr->elemCount;
440 numRequired = numElems + 1 ;
441
442 /*
443 * If there is no room in the current array of element pointers,
444 * allocate a new, larger array and copy the pointers to it.
445 */
446
447 if (numRequired > listRepPtr->maxElemCount) {
448 int newMax = (2 * numRequired);
449 Tcl_Obj **newElemPtrs = (Tcl_Obj **)
450 ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
451
452 memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
453 (size_t) (numElems * sizeof(Tcl_Obj *)));
454
455 listRepPtr->maxElemCount = newMax;
456 listRepPtr->elements = newElemPtrs;
457 ckfree((char *) elemPtrs);
458 elemPtrs = newElemPtrs;
459 }
460
461 /*
462 * Add objPtr to the end of listPtr's array of element
463 * pointers. Increment the ref count for the (now shared) objPtr.
464 */
465
466 elemPtrs[numElems] = objPtr;
467 Tcl_IncrRefCount(objPtr);
468 listRepPtr->elemCount++;
469
470 /*
471 * Invalidate any old string representation since the list's internal
472 * representation has changed.
473 */
474
475 Tcl_InvalidateStringRep(listPtr);
476 return TCL_OK;
477}
478
479
480/*
481 *----------------------------------------------------------------------
482 *
483 * Tcl_ListObjIndex --
484 *
485 * This procedure returns a pointer to the index'th object from the
486 * list referenced by listPtr. The first element has index 0. If index
487 * is negative or greater than or equal to the number of elements in
488 * the list, a NULL is returned. If listPtr is not a list object, an
489 * attempt will be made to convert it to a list.
490 *
491 * Results:
492 * The return value is normally TCL_OK; in this case objPtrPtr is set
493 * to the Tcl_Obj pointer for the index'th list element or NULL if
494 * index is out of range. This object should be treated as readonly and
495 * its ref count is _not_ incremented; the caller must do that if it
496 * holds on to the reference. If listPtr does not refer to a list and
497 * can't be converted to one, TCL_ERROR is returned and an error
498 * message is left in the interpreter's result if interp is not NULL.
499 *
500 * Side effects:
501 * listPtr will be converted, if necessary, to a list object.
502 *
503 *----------------------------------------------------------------------
504 */
505
506int
507Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
508 Tcl_Interp *interp; /* Used to report errors if not NULL. */
509 register Tcl_Obj *listPtr; /* List object to index into. */
510 register int index; /* Index of element to return. */
511 Tcl_Obj **objPtrPtr; /* The resulting Tcl_Obj* is stored here. */
512{
513 register List *listRepPtr;
514
515 if (listPtr->typePtr != &tclListType) {
516 int result = SetListFromAny(interp, listPtr);
517 if (result != TCL_OK) {
518 return result;
519 }
520 }
521
522 listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
523 if ((index < 0) || (index >= listRepPtr->elemCount)) {
524 *objPtrPtr = NULL;
525 } else {
526 *objPtrPtr = listRepPtr->elements[index];
527 }
528
529 return TCL_OK;
530}
531
532
533/*
534 *----------------------------------------------------------------------
535 *
536 * Tcl_ListObjLength --
537 *
538 * This procedure returns the number of elements in a list object. If
539 * the object is not already a list object, an attempt will be made to
540 * convert it to one.
541 *
542 * Results:
543 * The return value is normally TCL_OK; in this case *intPtr will be
544 * set to the integer count of list elements. If listPtr does not refer
545 * to a list object and the object can not be converted to one,
546 * TCL_ERROR is returned and an error message will be left in
547 * the interpreter's result if interp is not NULL.
548 *
549 * Side effects:
550 * The possible conversion of the argument object to a list object.
551 *
552 *----------------------------------------------------------------------
553 */
554
555int
556Tcl_ListObjLength(interp, listPtr, intPtr)
557 Tcl_Interp *interp; /* Used to report errors if not NULL. */
558 register Tcl_Obj *listPtr; /* List object whose #elements to return. */
559 register int *intPtr; /* The resulting int is stored here. */
560{
561 register List *listRepPtr;
562
563 if (listPtr->typePtr != &tclListType) {
564 int result = SetListFromAny(interp, listPtr);
565 if (result != TCL_OK) {
566 return result;
567 }
568 }
569
570 listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
571 *intPtr = listRepPtr->elemCount;
572 return TCL_OK;
573}
574
575
576/*
577 *----------------------------------------------------------------------
578 *
579 * Tcl_ListObjReplace --
580 *
581 * This procedure replaces zero or more elements of the list referenced
582 * by listPtr with the objects from an (objc,objv) array.
583 * The objc elements of the array referenced by objv replace the
584 * count elements in listPtr starting at first.
585 *
586 * If the argument first is zero or negative, it refers to the first
587 * element. If first is greater than or equal to the number of elements
588 * in the list, then no elements are deleted; the new elements are
589 * appended to the list. Count gives the number of elements to
590 * replace. If count is zero or negative then no elements are deleted;
591 * the new elements are simply inserted before first.
592 *
593 * The argument objv refers to an array of objc pointers to the new
594 * elements to be added to listPtr in place of those that were
595 * deleted. If objv is NULL, no new elements are added. If listPtr is
596 * not a list object, an attempt will be made to convert it to one.
597 *
598 * Results:
599 * The return value is normally TCL_OK. If listPtr does
600 * not refer to a list object and can not be converted to one,
601 * TCL_ERROR is returned and an error message will be left in
602 * the interpreter's result if interp is not NULL.
603 *
604 * Side effects:
605 * The ref counts of the objc elements in objv are incremented since
606 * the resulting list now refers to them. Similarly, the ref counts for
607 * replaced objects are decremented. listPtr is converted, if
608 * necessary, to a list object. listPtr's old string representation, if
609 * any, is freed.
610 *
611 *----------------------------------------------------------------------
612 */
613
614int
615Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
616 Tcl_Interp *interp; /* Used for error reporting if not NULL. */
617 Tcl_Obj *listPtr; /* List object whose elements to replace. */
618 int first; /* Index of first element to replace. */
619 int count; /* Number of elements to replace. */
620 int objc; /* Number of objects to insert. */
621 Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects
622 * to insert. */
623{
624 List *listRepPtr;
625 register Tcl_Obj **elemPtrs, **newPtrs;
626 Tcl_Obj *victimPtr;
627 int numElems, numRequired, numAfterLast;
628 int start, shift, newMax, i, j, result;
629
630 if (Tcl_IsShared(listPtr)) {
631 panic("Tcl_ListObjReplace called with shared object");
632 }
633 if (listPtr->typePtr != &tclListType) {
634 result = SetListFromAny(interp, listPtr);
635 if (result != TCL_OK) {
636 return result;
637 }
638 }
639 listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
640 elemPtrs = listRepPtr->elements;
641 numElems = listRepPtr->elemCount;
642
643 if (first < 0) {
644 first = 0;
645 }
646 if (first >= numElems) {
647 first = numElems; /* so we'll insert after last element */
648 }
649 if (count < 0) {
650 count = 0;
651 }
652
653 numRequired = (numElems - count + objc);
654 if (numRequired <= listRepPtr->maxElemCount) {
655 /*
656 * Enough room in the current array. First "delete" count
657 * elements starting at first.
658 */
659
660 for (i = 0, j = first; i < count; i++, j++) {
661 victimPtr = elemPtrs[j];
662 TclDecrRefCount(victimPtr);
663 }
664
665 /*
666 * Shift the elements after the last one removed to their
667 * new locations.
668 */
669
670 start = (first + count);
671 numAfterLast = (numElems - start);
672 shift = (objc - count); /* numNewElems - numDeleted */
673 if ((numAfterLast > 0) && (shift != 0)) {
674 Tcl_Obj **src, **dst;
675
676 if (shift < 0) {
677 for (src = elemPtrs + start, dst = src + shift;
678 numAfterLast > 0; numAfterLast--, src++, dst++) {
679 *dst = *src;
680 }
681 } else {
682 for (src = elemPtrs + numElems - 1, dst = src + shift;
683 numAfterLast > 0; numAfterLast--, src--, dst--) {
684 *dst = *src;
685 }
686 }
687 }
688
689 /*
690 * Insert the new elements into elemPtrs before "first".
691 */
692
693 for (i = 0, j = first; i < objc; i++, j++) {
694 elemPtrs[j] = objv[i];
695 Tcl_IncrRefCount(objv[i]);
696 }
697
698 /*
699 * Update the count of elements.
700 */
701
702 listRepPtr->elemCount = numRequired;
703 } else {
704 /*
705 * Not enough room in the current array. Allocate a larger array and
706 * insert elements into it.
707 */
708
709 newMax = (2 * numRequired);
710 newPtrs = (Tcl_Obj **)
711 ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
712
713 /*
714 * Copy over the elements before "first".
715 */
716
717 if (first > 0) {
718 memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
719 (size_t) (first * sizeof(Tcl_Obj *)));
720 }
721
722 /*
723 * "Delete" count elements starting at first.
724 */
725
726 for (i = 0, j = first; i < count; i++, j++) {
727 victimPtr = elemPtrs[j];
728 TclDecrRefCount(victimPtr);
729 }
730
731 /*
732 * Copy the elements after the last one removed, shifted to
733 * their new locations.
734 */
735
736 start = (first + count);
737 numAfterLast = (numElems - start);
738 if (numAfterLast > 0) {
739 memcpy((VOID *) &(newPtrs[first + objc]),
740 (VOID *) &(elemPtrs[start]),
741 (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
742 }
743
744 /*
745 * Insert the new elements before "first" and update the
746 * count of elements.
747 */
748
749 for (i = 0, j = first; i < objc; i++, j++) {
750 newPtrs[j] = objv[i];
751 Tcl_IncrRefCount(objv[i]);
752 }
753
754 listRepPtr->elemCount = numRequired;
755 listRepPtr->maxElemCount = newMax;
756 listRepPtr->elements = newPtrs;
757 ckfree((char *) elemPtrs);
758 }
759
760 /*
761 * Invalidate and free any old string representation since it no longer
762 * reflects the list's internal representation.
763 */
764
765 Tcl_InvalidateStringRep(listPtr);
766 return TCL_OK;
767}
768
769
770/*
771 *----------------------------------------------------------------------
772 *
773 * FreeListInternalRep --
774 *
775 * Deallocate the storage associated with a list object's internal
776 * representation.
777 *
778 * Results:
779 * None.
780 *
781 * Side effects:
782 * Frees listPtr's List* internal representation and sets listPtr's
783 * internalRep.otherValuePtr to NULL. Decrements the ref counts
784 * of all element objects, which may free them.
785 *
786 *----------------------------------------------------------------------
787 */
788
789static void
790FreeListInternalRep(listPtr)
791 Tcl_Obj *listPtr; /* List object with internal rep to free. */
792{
793 register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
794 register Tcl_Obj **elemPtrs = listRepPtr->elements;
795 register Tcl_Obj *objPtr;
796 int numElems = listRepPtr->elemCount;
797 int i;
798
799 for (i = 0; i < numElems; i++) {
800 objPtr = elemPtrs[i];
801 Tcl_DecrRefCount(objPtr);
802 }
803 ckfree((char *) elemPtrs);
804 ckfree((char *) listRepPtr);
805}
806
807
808/*
809 *----------------------------------------------------------------------
810 *
811 * DupListInternalRep --
812 *
813 * Initialize the internal representation of a list Tcl_Obj to a
814 * copy of the internal representation of an existing list object.
815 *
816 * Results:
817 * None.
818 *
819 * Side effects:
820 * "srcPtr"s list internal rep pointer should not be NULL and we assume
821 * it is not NULL. We set "copyPtr"s internal rep to a pointer to a
822 * newly allocated List structure that, in turn, points to "srcPtr"s
823 * element objects. Those element objects are not actually copied but
824 * are shared between "srcPtr" and "copyPtr". The ref count of each
825 * element object is incremented.
826 *
827 *----------------------------------------------------------------------
828 */
829
830static void
831DupListInternalRep(srcPtr, copyPtr)
832 Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
833 Tcl_Obj *copyPtr; /* Object with internal rep to set. */
834{
835 List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
836 int numElems = srcListRepPtr->elemCount;
837 int maxElems = srcListRepPtr->maxElemCount;
838 register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
839 register Tcl_Obj **copyElemPtrs;
840 register List *copyListRepPtr;
841 int i;
842
843 /*
844 * Allocate a new List structure that points to "srcPtr"s element
845 * objects. Increment the ref counts for those (now shared) element
846 * objects.
847 */
848
849 copyElemPtrs = (Tcl_Obj **)
850 ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
851 for (i = 0; i < numElems; i++) {
852 copyElemPtrs[i] = srcElemPtrs[i];
853 Tcl_IncrRefCount(copyElemPtrs[i]);
854 }
855
856 copyListRepPtr = (List *) ckalloc(sizeof(List));
857 copyListRepPtr->maxElemCount = maxElems;
858 copyListRepPtr->elemCount = numElems;
859 copyListRepPtr->elements = copyElemPtrs;
860
861 copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
862 copyPtr->typePtr = &tclListType;
863}
864
865
866/*
867 *----------------------------------------------------------------------
868 *
869 * SetListFromAny --
870 *
871 * Attempt to generate a list internal form for the Tcl object
872 * "objPtr".
873 *
874 * Results:
875 * The return value is TCL_OK or TCL_ERROR. If an error occurs during
876 * conversion, an error message is left in the interpreter's result
877 * unless "interp" is NULL.
878 *
879 * Side effects:
880 * If no error occurs, a list is stored as "objPtr"s internal
881 * representation.
882 *
883 *----------------------------------------------------------------------
884 */
885
886static int
887SetListFromAny(interp, objPtr)
888 Tcl_Interp *interp; /* Used for error reporting if not NULL. */
889 Tcl_Obj *objPtr; /* The object to convert. */
890{
891 Tcl_ObjType *oldTypePtr = objPtr->typePtr;
892 char *string, *elemStart, *nextElem, *s;
893 int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
894 char *limit; /* Points just after string's last byte. */
895 register char *p;
896 register Tcl_Obj **elemPtrs;
897 register Tcl_Obj *elemPtr;
898 List *listRepPtr;
899
900 /*
901 * Get the string representation. Make it up-to-date if necessary.
902 */
903
904 string = TclGetStringFromObj(objPtr, &length);
905
906 /*
907 * Parse the string into separate string objects, and create a List
908 * structure that points to the element string objects. We use a
909 * modified version of Tcl_SplitList's implementation to avoid one
910 * malloc and a string copy for each list element. First, estimate the
911 * number of elements by counting the number of space characters in the
912 * list.
913 */
914
915 limit = (string + length);
916 estCount = 1;
917 for (p = string; p < limit; p++) {
918 if (isspace(UCHAR(*p))) {
919 estCount++;
920 }
921 }
922
923 /*
924 * Allocate a new List structure with enough room for "estCount"
925 * elements. Each element is a pointer to a Tcl_Obj with the appropriate
926 * string rep. The initial "estCount" elements are set using the
927 * corresponding "argv" strings.
928 */
929
930 elemPtrs = (Tcl_Obj **)
931 ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
932 for (p = string, lenRemain = length, i = 0;
933 lenRemain > 0;
934 p = nextElem, lenRemain = (limit - nextElem), i++) {
935 result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
936 &elemSize, &hasBrace);
937 if (result != TCL_OK) {
938 for (j = 0; j < i; j++) {
939 elemPtr = elemPtrs[j];
940 Tcl_DecrRefCount(elemPtr);
941 }
942 ckfree((char *) elemPtrs);
943 return result;
944 }
945 if (elemStart >= limit) {
946 break;
947 }
948 if (i > estCount) {
949 panic("SetListFromAny: bad size estimate for list");
950 }
951
952 /*
953 * Allocate a Tcl object for the element and initialize it from the
954 * "elemSize" bytes starting at "elemStart".
955 */
956
957 s = ckalloc((unsigned) elemSize + 1);
958 if (hasBrace) {
959 memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
960 s[elemSize] = 0;
961 } else {
962 elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
963 }
964
965 TclNewObj(elemPtr);
966 elemPtr->bytes = s;
967 elemPtr->length = elemSize;
968 elemPtrs[i] = elemPtr;
969 Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
970 }
971
972 listRepPtr = (List *) ckalloc(sizeof(List));
973 listRepPtr->maxElemCount = estCount;
974 listRepPtr->elemCount = i;
975 listRepPtr->elements = elemPtrs;
976
977 /*
978 * Free the old internalRep before setting the new one. We do this as
979 * late as possible to allow the conversion code, in particular
980 * Tcl_GetStringFromObj, to use that old internalRep.
981 */
982
983 if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
984 oldTypePtr->freeIntRepProc(objPtr);
985 }
986
987 objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
988 objPtr->typePtr = &tclListType;
989 return TCL_OK;
990}
991
992
993/*
994 *----------------------------------------------------------------------
995 *
996 * UpdateStringOfList --
997 *
998 * Update the string representation for a list object.
999 * Note: This procedure does not invalidate an existing old string rep
1000 * so storage will be lost if this has not already been done.
1001 *
1002 * Results:
1003 * None.
1004 *
1005 * Side effects:
1006 * The object's string is set to a valid string that results from
1007 * the list-to-string conversion. This string will be empty if the
1008 * list has no elements. The list internal representation
1009 * should not be NULL and we assume it is not NULL.
1010 *
1011 *----------------------------------------------------------------------
1012 */
1013
1014static void
1015UpdateStringOfList(listPtr)
1016 Tcl_Obj *listPtr; /* List object with string rep to update. */
1017{
1018# define LOCAL_SIZE 20
1019 int localFlags[LOCAL_SIZE], *flagPtr;
1020 List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
1021 int numElems = listRepPtr->elemCount;
1022 register int i;
1023 char *elem, *dst;
1024 int length;
1025
1026 /*
1027 * Convert each element of the list to string form and then convert it
1028 * to proper list element form, adding it to the result buffer.
1029 */
1030
1031 /*
1032 * Pass 1: estimate space, gather flags.
1033 */
1034
1035 if (numElems <= LOCAL_SIZE) {
1036 flagPtr = localFlags;
1037 } else {
1038 flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
1039 }
1040 listPtr->length = 1;
1041 for (i = 0; i < numElems; i++) {
1042 elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1043 listPtr->length += Tcl_ScanCountedElement(elem, length,
1044 &flagPtr[i]) + 1;
1045 }
1046
1047 /*
1048 * Pass 2: copy into string rep buffer.
1049 */
1050
1051 listPtr->bytes = ckalloc((unsigned) listPtr->length);
1052 dst = listPtr->bytes;
1053 for (i = 0; i < numElems; i++) {
1054 elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1055 dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
1056 *dst = ' ';
1057 dst++;
1058 }
1059 if (flagPtr != localFlags) {
1060 ckfree((char *) flagPtr);
1061 }
1062 if (dst == listPtr->bytes) {
1063 *dst = 0;
1064 } else {
1065 dst--;
1066 *dst = 0;
1067 }
1068 listPtr->length = dst - listPtr->bytes;
1069}
Note: See TracBrowser for help on using the repository browser.