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 */ |