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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 64 - (show annotations) (download)
Sun Oct 30 04:21:11 2016 UTC (7 years, 11 months ago) by dashley
File MIME type: text/plain
File size: 33592 byte(s)
Adjust line endings to Windows style.
Set properties to expand the "Header" keyword.
Change header and footer.
1 /*$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:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25