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