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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25