tclListObj.cGo to the documentation of this file.00001 /* 00002 * tclListObj.c -- 00003 * 00004 * This file contains functions that implement the Tcl list object type. 00005 * 00006 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 00007 * Copyright (c) 1998 by Scriptics Corporation. 00008 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. 00009 * 00010 * See the file "license.terms" for information on usage and redistribution of 00011 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 00012 * 00013 * RCS: @(#) $Id: tclListObj.c,v 1.49 2007/12/13 15:23:18 dgp Exp $ 00014 */ 00015 00016 #include "tclInt.h" 00017 00018 /* 00019 * Prototypes for functions defined later in this file: 00020 */ 00021 00022 static List * NewListIntRep(int objc, Tcl_Obj *CONST objv[]); 00023 static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); 00024 static void FreeListInternalRep(Tcl_Obj *listPtr); 00025 static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); 00026 static void UpdateStringOfList(Tcl_Obj *listPtr); 00027 00028 /* 00029 * The structure below defines the list Tcl object type by means of functions 00030 * that can be invoked by generic object code. 00031 * 00032 * The internal representation of a list object is a two-pointer 00033 * representation. The first pointer designates a List structure that contains 00034 * an array of pointers to the element objects, together with integers that 00035 * represent the current element count and the allocated size of the array. 00036 * The second pointer is normally NULL; during execution of functions in this 00037 * file that operate on nested sublists, it is occasionally used as working 00038 * storage to avoid an auxiliary stack. 00039 */ 00040 00041 Tcl_ObjType tclListType = { 00042 "list", /* name */ 00043 FreeListInternalRep, /* freeIntRepProc */ 00044 DupListInternalRep, /* dupIntRepProc */ 00045 UpdateStringOfList, /* updateStringProc */ 00046 SetListFromAny /* setFromAnyProc */ 00047 }; 00048 00049 /* 00050 *---------------------------------------------------------------------- 00051 * 00052 * NewListIntRep -- 00053 * 00054 * If objc>0 and objv!=NULL, this function creates a list internal rep 00055 * with objc elements given in the array objv. If objc>0 and objv==NULL 00056 * it creates the list internal rep of a list with 0 elements, where 00057 * enough space has been preallocated to store objc elements. If objc<=0, 00058 * it returns NULL. 00059 * 00060 * Results: 00061 * A new List struct is returned. If objc<=0 or if the allocation fails 00062 * for lack of memory, NULL is returned. The list returned has refCount 00063 * 0. 00064 * 00065 * Side effects: 00066 * The ref counts of the elements in objv are incremented since the 00067 * resulting list now refers to them. 00068 * 00069 *---------------------------------------------------------------------- 00070 */ 00071 00072 static List * 00073 NewListIntRep( 00074 int objc, 00075 Tcl_Obj *CONST objv[]) 00076 { 00077 List *listRepPtr; 00078 00079 if (objc <= 0) { 00080 return NULL; 00081 } 00082 00083 /* 00084 * First check to see if we'd overflow and try to allocate an object 00085 * larger than our memory allocator allows. Note that this is actually a 00086 * fairly small value when you're on a serious 64-bit machine, but that 00087 * requires API changes to fix. See [Bug 219196] for a discussion. 00088 */ 00089 00090 if ((size_t)objc > INT_MAX/sizeof(Tcl_Obj *)) { 00091 return NULL; 00092 } 00093 00094 listRepPtr = (List *) 00095 attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))); 00096 if (listRepPtr == NULL) { 00097 return NULL; 00098 } 00099 00100 listRepPtr->canonicalFlag = 0; 00101 listRepPtr->refCount = 0; 00102 listRepPtr->maxElemCount = objc; 00103 00104 if (objv) { 00105 Tcl_Obj **elemPtrs; 00106 int i; 00107 00108 listRepPtr->elemCount = objc; 00109 elemPtrs = &listRepPtr->elements; 00110 for (i = 0; i < objc; i++) { 00111 elemPtrs[i] = objv[i]; 00112 Tcl_IncrRefCount(elemPtrs[i]); 00113 } 00114 } else { 00115 listRepPtr->elemCount = 0; 00116 } 00117 return listRepPtr; 00118 } 00119 00120 /* 00121 *---------------------------------------------------------------------- 00122 * 00123 * Tcl_NewListObj -- 00124 * 00125 * This function is normally called when not debugging: i.e., when 00126 * TCL_MEM_DEBUG is not defined. It creates a new list object from an 00127 * (objc,objv) array: that is, each of the objc elements of the array 00128 * referenced by objv is inserted as an element into a new Tcl object. 00129 * 00130 * When TCL_MEM_DEBUG is defined, this function just returns the result 00131 * of calling the debugging version Tcl_DbNewListObj. 00132 * 00133 * Results: 00134 * A new list object is returned that is initialized from the object 00135 * pointers in objv. If objc is less than or equal to zero, an empty 00136 * object is returned. The new object's string representation is left 00137 * NULL. The resulting new list object has ref count 0. 00138 * 00139 * Side effects: 00140 * The ref counts of the elements in objv are incremented since the 00141 * resulting list now refers to them. 00142 * 00143 *---------------------------------------------------------------------- 00144 */ 00145 00146 #ifdef TCL_MEM_DEBUG 00147 #undef Tcl_NewListObj 00148 00149 Tcl_Obj * 00150 Tcl_NewListObj( 00151 int objc, /* Count of objects referenced by objv. */ 00152 Tcl_Obj *CONST objv[]) /* An array of pointers to Tcl objects. */ 00153 { 00154 return Tcl_DbNewListObj(objc, objv, "unknown", 0); 00155 } 00156 00157 #else /* if not TCL_MEM_DEBUG */ 00158 00159 Tcl_Obj * 00160 Tcl_NewListObj( 00161 int objc, /* Count of objects referenced by objv. */ 00162 Tcl_Obj *CONST objv[]) /* An array of pointers to Tcl objects. */ 00163 { 00164 List *listRepPtr; 00165 Tcl_Obj *listPtr; 00166 00167 TclNewObj(listPtr); 00168 00169 if (objc <= 0) { 00170 return listPtr; 00171 } 00172 00173 /* 00174 * Create the internal rep. 00175 */ 00176 00177 listRepPtr = NewListIntRep(objc, objv); 00178 if (!listRepPtr) { 00179 Tcl_Panic("Not enough memory to allocate list"); 00180 } 00181 00182 /* 00183 * Now create the object. 00184 */ 00185 00186 Tcl_InvalidateStringRep(listPtr); 00187 listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 00188 listPtr->internalRep.twoPtrValue.ptr2 = NULL; 00189 listPtr->typePtr = &tclListType; 00190 listRepPtr->refCount++; 00191 00192 return listPtr; 00193 } 00194 #endif /* if TCL_MEM_DEBUG */ 00195 00196 /* 00197 *---------------------------------------------------------------------- 00198 * 00199 * Tcl_DbNewListObj -- 00200 * 00201 * This function is normally called when debugging: i.e., when 00202 * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same 00203 * as the Tcl_NewListObj function above except that it calls 00204 * Tcl_DbCkalloc directly with the file name and line number from its 00205 * caller. This simplifies debugging since then the [memory active] 00206 * command will report the correct file name and line number when 00207 * reporting objects that haven't been freed. 00208 * 00209 * When TCL_MEM_DEBUG is not defined, this function just returns the 00210 * result of calling Tcl_NewListObj. 00211 * 00212 * Results: 00213 * A new list object is returned that is initialized from the object 00214 * pointers in objv. If objc is less than or equal to zero, an empty 00215 * object is returned. The new object's string representation is left 00216 * NULL. The new list object has ref count 0. 00217 * 00218 * Side effects: 00219 * The ref counts of the elements in objv are incremented since the 00220 * resulting list now refers to them. 00221 * 00222 *---------------------------------------------------------------------- 00223 */ 00224 00225 #ifdef TCL_MEM_DEBUG 00226 00227 Tcl_Obj * 00228 Tcl_DbNewListObj( 00229 int objc, /* Count of objects referenced by objv. */ 00230 Tcl_Obj *CONST objv[], /* An array of pointers to Tcl objects. */ 00231 CONST char *file, /* The name of the source file calling this 00232 * function; used for debugging. */ 00233 int line) /* Line number in the source file; used for 00234 * debugging. */ 00235 { 00236 Tcl_Obj *listPtr; 00237 List *listRepPtr; 00238 00239 TclDbNewObj(listPtr, file, line); 00240 00241 if (objc <= 0) { 00242 return listPtr; 00243 } 00244 00245 /* 00246 * Create the internal rep. 00247 */ 00248 00249 listRepPtr = NewListIntRep(objc, objv); 00250 if (!listRepPtr) { 00251 Tcl_Panic("Not enough memory to allocate list"); 00252 } 00253 00254 /* 00255 * Now create the object. 00256 */ 00257 00258 Tcl_InvalidateStringRep(listPtr); 00259 listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 00260 listPtr->internalRep.twoPtrValue.ptr2 = NULL; 00261 listPtr->typePtr = &tclListType; 00262 listRepPtr->refCount++; 00263 00264 return listPtr; 00265 } 00266 00267 #else /* if not TCL_MEM_DEBUG */ 00268 00269 Tcl_Obj * 00270 Tcl_DbNewListObj( 00271 int objc, /* Count of objects referenced by objv. */ 00272 Tcl_Obj *CONST objv[], /* An array of pointers to Tcl objects. */ 00273 CONST char *file, /* The name of the source file calling this 00274 * function; used for debugging. */ 00275 int line) /* Line number in the source file; used for 00276 * debugging. */ 00277 { 00278 return Tcl_NewListObj(objc, objv); 00279 } 00280 #endif /* TCL_MEM_DEBUG */ 00281 00282 /* 00283 *---------------------------------------------------------------------- 00284 * 00285 * Tcl_SetListObj -- 00286 * 00287 * Modify an object to be a list containing each of the objc elements of 00288 * the object array referenced by objv. 00289 * 00290 * Results: 00291 * None. 00292 * 00293 * Side effects: 00294 * The object is made a list object and is initialized from the object 00295 * pointers in objv. If objc is less than or equal to zero, an empty 00296 * object is returned. The new object's string representation is left 00297 * NULL. The ref counts of the elements in objv are incremented since the 00298 * list now refers to them. The object's old string and internal 00299 * representations are freed and its type is set NULL. 00300 * 00301 *---------------------------------------------------------------------- 00302 */ 00303 00304 void 00305 Tcl_SetListObj( 00306 Tcl_Obj *objPtr, /* Object whose internal rep to init. */ 00307 int objc, /* Count of objects referenced by objv. */ 00308 Tcl_Obj *CONST objv[]) /* An array of pointers to Tcl objects. */ 00309 { 00310 List *listRepPtr; 00311 00312 if (Tcl_IsShared(objPtr)) { 00313 Tcl_Panic("%s called with shared object", "Tcl_SetListObj"); 00314 } 00315 00316 /* 00317 * Free any old string rep and any internal rep for the old type. 00318 */ 00319 00320 TclFreeIntRep(objPtr); 00321 objPtr->typePtr = NULL; 00322 Tcl_InvalidateStringRep(objPtr); 00323 00324 /* 00325 * Set the object's type to "list" and initialize the internal rep. 00326 * However, if there are no elements to put in the list, just give the 00327 * object an empty string rep and a NULL type. 00328 */ 00329 00330 if (objc > 0) { 00331 listRepPtr = NewListIntRep(objc, objv); 00332 if (!listRepPtr) { 00333 Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj"); 00334 } 00335 objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 00336 objPtr->internalRep.twoPtrValue.ptr2 = NULL; 00337 objPtr->typePtr = &tclListType; 00338 listRepPtr->refCount++; 00339 } else { 00340 objPtr->bytes = tclEmptyStringRep; 00341 objPtr->length = 0; 00342 } 00343 } 00344 00345 /* 00346 *---------------------------------------------------------------------- 00347 * 00348 * TclListObjCopy -- 00349 * 00350 * Makes a "pure list" copy of a list value. This provides for the C 00351 * level a counterpart of the [lrange $list 0 end] command, while using 00352 * internals details to be as efficient as possible. 00353 * 00354 * Results: 00355 * Normally returns a pointer to a new Tcl_Obj, that contains the same 00356 * list value as *listPtr does. The returned Tcl_Obj has a refCount of 00357 * zero. If *listPtr does not hold a list, NULL is returned, and if 00358 * interp is non-NULL, an error message is recorded there. 00359 * 00360 * Side effects: 00361 * None. 00362 * 00363 *---------------------------------------------------------------------- 00364 */ 00365 00366 Tcl_Obj * 00367 TclListObjCopy( 00368 Tcl_Interp *interp, /* Used to report errors if not NULL. */ 00369 Tcl_Obj *listPtr) /* List object for which an element array is 00370 * to be returned. */ 00371 { 00372 Tcl_Obj *copyPtr; 00373 00374 if (listPtr->typePtr != &tclListType) { 00375 if (SetListFromAny(interp, listPtr) != TCL_OK) { 00376 return NULL; 00377 } 00378 } 00379 00380 TclNewObj(copyPtr); 00381 TclInvalidateStringRep(copyPtr); 00382 DupListInternalRep(listPtr, copyPtr); 00383 return copyPtr; 00384 } 00385 00386 /* 00387 *---------------------------------------------------------------------- 00388 * 00389 * Tcl_ListObjGetElements -- 00390 * 00391 * This function returns an (objc,objv) array of the elements in a list 00392 * object. 00393 * 00394 * Results: 00395 * The return value is normally TCL_OK; in this case *objcPtr is set to 00396 * the count of list elements and *objvPtr is set to a pointer to an 00397 * array of (*objcPtr) pointers to each list element. If listPtr does not 00398 * refer to a list object and the object can not be converted to one, 00399 * TCL_ERROR is returned and an error message will be left in the 00400 * interpreter's result if interp is not NULL. 00401 * 00402 * The objects referenced by the returned array should be treated as 00403 * readonly and their ref counts are _not_ incremented; the caller must 00404 * do that if it holds on to a reference. Furthermore, the pointer and 00405 * length returned by this function may change as soon as any function is 00406 * called on the list object; be careful about retaining the pointer in a 00407 * local data structure. 00408 * 00409 * Side effects: 00410 * The possible conversion of the object referenced by listPtr 00411 * to a list object. 00412 * 00413 *---------------------------------------------------------------------- 00414 */ 00415 00416 int 00417 Tcl_ListObjGetElements( 00418 Tcl_Interp *interp, /* Used to report errors if not NULL. */ 00419 register Tcl_Obj *listPtr, /* List object for which an element array is 00420 * to be returned. */ 00421 int *objcPtr, /* Where to store the count of objects 00422 * referenced by objv. */ 00423 Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of 00424 * pointers to the list's objects. */ 00425 { 00426 register List *listRepPtr; 00427 00428 if (listPtr->typePtr != &tclListType) { 00429 int result, length; 00430 00431 (void) TclGetStringFromObj(listPtr, &length); 00432 if (!length) { 00433 *objcPtr = 0; 00434 *objvPtr = NULL; 00435 return TCL_OK; 00436 } 00437 00438 result = SetListFromAny(interp, listPtr); 00439 if (result != TCL_OK) { 00440 return result; 00441 } 00442 } 00443 listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 00444 *objcPtr = listRepPtr->elemCount; 00445 *objvPtr = &listRepPtr->elements; 00446 return TCL_OK; 00447 } 00448 00449 /* 00450 *---------------------------------------------------------------------- 00451 * 00452 * Tcl_ListObjAppendList -- 00453 * 00454 * This function appends the objects in the list referenced by 00455 * elemListPtr to the list object referenced by listPtr. If listPtr is 00456 * not already a list object, an attempt will be made to convert it to 00457 * one. 00458 * 00459 * Results: 00460 * The return value is normally TCL_OK. If listPtr or elemListPtr do not 00461 * refer to list objects and they can not be converted to one, TCL_ERROR 00462 * is returned and an error message is left in the interpreter's result 00463 * if interp is not NULL. 00464 * 00465 * Side effects: 00466 * The reference counts of the elements in elemListPtr are incremented 00467 * since the list now refers to them. listPtr and elemListPtr are 00468 * converted, if necessary, to list objects. Also, appending the new 00469 * elements may cause listObj's array of element pointers to grow. 00470 * listPtr's old string representation, if any, is invalidated. 00471 * 00472 *---------------------------------------------------------------------- 00473 */ 00474 00475 int 00476 Tcl_ListObjAppendList( 00477 Tcl_Interp *interp, /* Used to report errors if not NULL. */ 00478 register Tcl_Obj *listPtr, /* List object to append elements to. */ 00479 Tcl_Obj *elemListPtr) /* List obj with elements to append. */ 00480 { 00481 int listLen, objc, result; 00482 Tcl_Obj **objv; 00483 00484 if (Tcl_IsShared(listPtr)) { 00485 Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); 00486 } 00487 00488 result = TclListObjLength(interp, listPtr, &listLen); 00489 if (result != TCL_OK) { 00490 return result; 00491 } 00492 00493 result = TclListObjGetElements(interp, elemListPtr, &objc, &objv); 00494 if (result != TCL_OK) { 00495 return result; 00496 } 00497 00498 /* 00499 * Insert objc new elements starting after the lists's last element. 00500 * Delete zero existing elements. 00501 */ 00502 00503 return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv); 00504 } 00505 00506 /* 00507 *---------------------------------------------------------------------- 00508 * 00509 * Tcl_ListObjAppendElement -- 00510 * 00511 * This function is a special purpose version of Tcl_ListObjAppendList: 00512 * it appends a single object referenced by objPtr to the list object 00513 * referenced by listPtr. If listPtr is not already a list object, an 00514 * attempt will be made to convert it to one. 00515 * 00516 * Results: 00517 * The return value is normally TCL_OK; in this case objPtr is added to 00518 * the end of listPtr's list. If listPtr does not refer to a list object 00519 * and the object can not be converted to one, TCL_ERROR is returned and 00520 * an error message will be left in the interpreter's result if interp is 00521 * not NULL. 00522 * 00523 * Side effects: 00524 * The ref count of objPtr is incremented since the list now refers to 00525 * it. listPtr will be converted, if necessary, to a list object. Also, 00526 * appending the new element may cause listObj's array of element 00527 * pointers to grow. listPtr's old string representation, if any, is 00528 * invalidated. 00529 * 00530 *---------------------------------------------------------------------- 00531 */ 00532 00533 int 00534 Tcl_ListObjAppendElement( 00535 Tcl_Interp *interp, /* Used to report errors if not NULL. */ 00536 Tcl_Obj *listPtr, /* List object to append objPtr to. */ 00537 Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ 00538 { 00539 register List *listRepPtr; 00540 register Tcl_Obj **elemPtrs; 00541 int numElems, numRequired, newMax, newSize, i; 00542 00543 if (Tcl_IsShared(listPtr)) { 00544 Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement"); 00545 } 00546 if (listPtr->typePtr != &tclListType) { 00547 int result, length; 00548 00549 (void) TclGetStringFromObj(listPtr, &length); 00550 if (!length) { 00551 Tcl_SetListObj(listPtr, 1, &objPtr); 00552 return TCL_OK; 00553 } 00554 00555 result = SetListFromAny(interp, listPtr); 00556 if (result != TCL_OK) { 00557 return result; 00558 } 00559 } 00560 00561 listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 00562 numElems = listRepPtr->elemCount; 00563 numRequired = numElems + 1 ; 00564 00565 /* 00566 * If there is no room in the current array of element pointers, allocate 00567 * a new, larger array and copy the pointers to it. If the List struct is 00568 * shared, allocate a new one. 00569 */ 00570 00571 if (numRequired > listRepPtr->maxElemCount){ 00572 newMax = 2 * numRequired; 00573 newSize = sizeof(List) + ((newMax-1) * sizeof(Tcl_Obj *)); 00574 } else { 00575 newMax = listRepPtr->maxElemCount; 00576 newSize = 0; 00577 } 00578 00579 if (listRepPtr->refCount > 1) { 00580 List *oldListRepPtr = listRepPtr; 00581 Tcl_Obj **oldElems; 00582 00583 listRepPtr = NewListIntRep(newMax, NULL); 00584 if (!listRepPtr) { 00585 Tcl_Panic("Not enough memory to allocate list"); 00586 } 00587 oldElems = &oldListRepPtr->elements; 00588 elemPtrs = &listRepPtr->elements; 00589 for (i=0; i<numElems; i++) { 00590 elemPtrs[i] = oldElems[i]; 00591 Tcl_IncrRefCount(elemPtrs[i]); 00592 } 00593 listRepPtr->elemCount = numElems; 00594 listRepPtr->refCount++; 00595 oldListRepPtr->refCount--; 00596 listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 00597 } else if (newSize) { 00598 listRepPtr = (List *) ckrealloc((char *)listRepPtr, (size_t)newSize); 00599 listRepPtr->maxElemCount = newMax; 00600 listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 00601 } 00602 00603 /* 00604 * Add objPtr to the end of listPtr's array of element pointers. Increment 00605 * the ref count for the (now shared) objPtr. 00606 */ 00607 00608 elemPtrs = &listRepPtr->elements; 00609 elemPtrs[numElems] = objPtr; 00610 Tcl_IncrRefCount(objPtr); 00611 listRepPtr->elemCount++; 00612 00613 /* 00614 * Invalidate any old string representation since the list's internal 00615 * representation has changed. 00616 */ 00617 00618 Tcl_InvalidateStringRep(listPtr); 00619 return TCL_OK; 00620 } 00621 00622 /* 00623 *---------------------------------------------------------------------- 00624 * 00625 * Tcl_ListObjIndex -- 00626 * 00627 * This function returns a pointer to the index'th object from the list 00628 * referenced by listPtr. The first element has index 0. If index is 00629 * negative or greater than or equal to the number of elements in the 00630 * list, a NULL is returned. If listPtr is not a list object, an attempt 00631 * will be made to convert it to a list. 00632 * 00633 * Results: 00634 * The return value is normally TCL_OK; in this case objPtrPtr is set to 00635 * the Tcl_Obj pointer for the index'th list element or NULL if index is 00636 * out of range. This object should be treated as readonly and its ref 00637 * count is _not_ incremented; the caller must do that if it holds on to 00638 * the reference. If listPtr does not refer to a list and can't be 00639 * converted to one, TCL_ERROR is returned and an error message is left 00640 * in the interpreter's result if interp is not NULL. 00641 * 00642 * Side effects: 00643 * listPtr will be converted, if necessary, to a list object. 00644 * 00645 *---------------------------------------------------------------------- 00646 */ 00647 00648 int 00649 Tcl_ListObjIndex( 00650 Tcl_Interp *interp, /* Used to report errors if not NULL. */ 00651 register Tcl_Obj *listPtr, /* List object to index into. */ 00652 register int index, /* Index of element to return. */ 00653 Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ 00654 { 00655 register List *listRepPtr; 00656 00657 if (listPtr->typePtr != &tclListType) { 00658 int result, length; 00659 00660 (void) TclGetStringFromObj(listPtr, &length); 00661 if (!length) { 00662 *objPtrPtr = NULL; 00663 return TCL_OK; 00664 } 00665 00666 result = SetListFromAny(interp, listPtr); 00667 if (result != TCL_OK) { 00668 return result; 00669 } 00670 } 00671 00672 listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 00673 if ((index < 0) || (index >= listRepPtr->elemCount)) { 00674 *objPtrPtr = NULL; 00675 } else { 00676 *objPtrPtr = (&listRepPtr->elements)[index]; 00677 } 00678 00679 return TCL_OK; 00680 } 00681 00682 /* 00683 *---------------------------------------------------------------------- 00684 * 00685 * Tcl_ListObjLength -- 00686 * 00687 * This function returns the number of elements in a list object. If the 00688 * object is not already a list object, an attempt will be made to 00689 * convert it to one. 00690 * 00691 * Results: 00692 * The return value is normally TCL_OK; in this case *intPtr will be set 00693 * to the integer count of list elements. If listPtr does not refer to a 00694 * list object and the object can not be converted to one, TCL_ERROR is 00695 * returned and an error message will be left in the interpreter's result 00696 * if interp is not NULL. 00697 * 00698 * Side effects: 00699 * The possible conversion of the argument object to a list object. 00700 * 00701 *---------------------------------------------------------------------- 00702 */ 00703 00704 int 00705 Tcl_ListObjLength( 00706 Tcl_Interp *interp, /* Used to report errors if not NULL. */ 00707 register Tcl_Obj *listPtr, /* List object whose #elements to return. */ 00708 register int *intPtr) /* The resulting int is stored here. */ 00709 { 00710 register List *listRepPtr; 00711 00712 if (listPtr->typePtr != &tclListType) { 00713 int result, length; 00714 00715 (void) TclGetStringFromObj(listPtr, &length); 00716 if (!length) { 00717 *intPtr = 0; 00718 return TCL_OK; 00719 } 00720 00721 result = SetListFromAny(interp, listPtr); 00722 if (result != TCL_OK) { 00723 return result; 00724 } 00725 } 00726 00727 listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 00728 *intPtr = listRepPtr->elemCount; 00729 return TCL_OK; 00730 } 00731 00732 /* 00733 *---------------------------------------------------------------------- 00734 * 00735 * Tcl_ListObjReplace -- 00736 * 00737 * This function replaces zero or more elements of the list referenced by 00738 * listPtr with the objects from an (objc,objv) array. The objc elements 00739 * of the array referenced by objv replace the count elements in listPtr 00740 * starting at first. 00741 * 00742 * If the argument first is zero or negative, it refers to the first 00743 * element. If first is greater than or equal to the number of elements 00744 * in the list, then no elements are deleted; the new elements are 00745 * appended to the list. Count gives the number of elements to replace. 00746 * If count is zero or negative then no elements are deleted; the new 00747 * elements are simply inserted before first. 00748 * 00749 * The argument objv refers to an array of objc pointers to the new 00750 * elements to be added to listPtr in place of those that were deleted. 00751 * If objv is NULL, no new elements are added. If listPtr is not a list 00752 * object, an attempt will be made to convert it to one. 00753 * 00754 * Results: 00755 * The return value is normally TCL_OK. If listPtr does not refer to a 00756 * list object and can not be converted to one, TCL_ERROR is returned and 00757 * an error message will be left in the interpreter's result if interp is 00758 * not NULL. 00759 * 00760 * Side effects: 00761 * The ref counts of the objc elements in objv are incremented since the 00762 * resulting list now refers to them. Similarly, the ref counts for 00763 * replaced objects are decremented. listPtr is converted, if necessary, 00764 * to a list object. listPtr's old string representation, if any, is 00765 * freed. 00766 * 00767 *---------------------------------------------------------------------- 00768 */ 00769 00770 int 00771 Tcl_ListObjReplace( 00772 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 00773 Tcl_Obj *listPtr, /* List object whose elements to replace. */ 00774 int first, /* Index of first element to replace. */ 00775 int count, /* Number of elements to replace. */ 00776 int objc, /* Number of objects to insert. */ 00777 Tcl_Obj *CONST objv[]) /* An array of objc pointers to Tcl objects to 00778 * insert. */ 00779 { 00780 List *listRepPtr; 00781 register Tcl_Obj **elemPtrs; 00782 int numElems, numRequired, numAfterLast, start, i, j, isShared; 00783 00784 if (Tcl_IsShared(listPtr)) { 00785 Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); 00786 } 00787 if (listPtr->typePtr != &tclListType) { 00788 int length; 00789 00790 (void) TclGetStringFromObj(listPtr, &length); 00791 if (!length) { 00792 if (objc) { 00793 Tcl_SetListObj(listPtr, objc, NULL); 00794 } else { 00795 return TCL_OK; 00796 } 00797 } else { 00798 int result = SetListFromAny(interp, listPtr); 00799 00800 if (result != TCL_OK) { 00801 return result; 00802 } 00803 } 00804 } 00805 00806 /* 00807 * Note that when count == 0 and objc == 0, this routine is logically a 00808 * no-op, removing and adding no elements to the list. However, by flowing 00809 * through this routine anyway, we get the important side effect that the 00810 * resulting listPtr is a list in canoncial form. This is important. 00811 * Resist any temptation to optimize this case. 00812 */ 00813 00814 listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 00815 elemPtrs = &listRepPtr->elements; 00816 numElems = listRepPtr->elemCount; 00817 00818 if (first < 0) { 00819 first = 0; 00820 } 00821 if (first >= numElems) { 00822 first = numElems; /* So we'll insert after last element. */ 00823 } 00824 if (count < 0) { 00825 count = 0; 00826 } else if (numElems < first+count) { 00827 count = numElems - first; 00828 } 00829 00830 isShared = (listRepPtr->refCount > 1); 00831 numRequired = numElems - count + objc; 00832 00833 if ((numRequired <= listRepPtr->maxElemCount) && !isShared) { 00834 int shift; 00835 00836 /* 00837 * Can use the current List struct. First "delete" count elements 00838 * starting at first. 00839 */ 00840 00841 for (j = first; j < first + count; j++) { 00842 Tcl_Obj *victimPtr = elemPtrs[j]; 00843 00844 TclDecrRefCount(victimPtr); 00845 } 00846 00847 /* 00848 * Shift the elements after the last one removed to their new 00849 * locations. 00850 */ 00851 00852 start = first + count; 00853 numAfterLast = numElems - start; 00854 shift = objc - count; /* numNewElems - numDeleted */ 00855 if ((numAfterLast > 0) && (shift != 0)) { 00856 Tcl_Obj **src = elemPtrs + start; 00857 00858 memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*)); 00859 } 00860 } else { 00861 /* 00862 * Cannot use the current List struct; it is shared, too small, or 00863 * both. Allocate a new struct and insert elements into it. 00864 */ 00865 00866 List *oldListRepPtr = listRepPtr; 00867 Tcl_Obj **oldPtrs = elemPtrs; 00868 int newMax; 00869 00870 if (numRequired > listRepPtr->maxElemCount){ 00871 newMax = 2 * numRequired; 00872 } else { 00873 newMax = listRepPtr->maxElemCount; 00874 } 00875 00876 listRepPtr = NewListIntRep(newMax, NULL); 00877 if (!listRepPtr) { 00878 Tcl_Panic("Not enough memory to allocate list"); 00879 } 00880 00881 listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 00882 listRepPtr->refCount++; 00883 00884 elemPtrs = &listRepPtr->elements; 00885 00886 if (isShared) { 00887 /* 00888 * The old struct will remain in place; need new refCounts for the 00889 * new List struct references. Copy over only the surviving 00890 * elements. 00891 */ 00892 00893 for (i=0; i < first; i++) { 00894 elemPtrs[i] = oldPtrs[i]; 00895 Tcl_IncrRefCount(elemPtrs[i]); 00896 } 00897 for (i = first + count, j = first + objc; 00898 j < numRequired; i++, j++) { 00899 elemPtrs[j] = oldPtrs[i]; 00900 Tcl_IncrRefCount(elemPtrs[j]); 00901 } 00902 00903 oldListRepPtr->refCount--; 00904 } else { 00905 /* 00906 * The old struct will be removed; use its inherited refCounts. 00907 */ 00908 00909 if (first > 0) { 00910 memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *)); 00911 } 00912 00913 /* 00914 * "Delete" count elements starting at first. 00915 */ 00916 00917 for (j = first; j < first + count; j++) { 00918 Tcl_Obj *victimPtr = oldPtrs[j]; 00919 00920 TclDecrRefCount(victimPtr); 00921 } 00922 00923 /* 00924 * Copy the elements after the last one removed, shifted to their 00925 * new locations. 00926 */ 00927 00928 start = first + count; 00929 numAfterLast = numElems - start; 00930 if (numAfterLast > 0) { 00931 memcpy(elemPtrs + first + objc, oldPtrs + start, 00932 (size_t) numAfterLast * sizeof(Tcl_Obj *)); 00933 } 00934 00935 ckfree((char *) oldListRepPtr); 00936 } 00937 } 00938 00939 /* 00940 * Insert the new elements into elemPtrs before "first". We don't do a 00941 * memcpy here because we must increment the reference counts for the 00942 * added elements, so we must explicitly loop anyway. 00943 */ 00944 00945 for (i=0,j=first ; i<objc ; i++,j++) { 00946 elemPtrs[j] = objv[i]; 00947 Tcl_IncrRefCount(objv[i]); 00948 } 00949 00950 /* 00951 * Update the count of elements. 00952 */ 00953 00954 listRepPtr->elemCount = numRequired; 00955 00956 /* 00957 * Invalidate and free any old string representation since it no longer 00958 * reflects the list's internal representation. 00959 */ 00960 00961 Tcl_InvalidateStringRep(listPtr); 00962 return TCL_OK; 00963 } 00964 00965 /* 00966 *---------------------------------------------------------------------- 00967 * 00968 * TclLindexList -- 00969 * 00970 * This procedure handles the 'lindex' command when objc==3. 00971 * 00972 * Results: 00973 * Returns a pointer to the object extracted, or NULL if an error 00974 * occurred. The returned object already includes one reference count for 00975 * the pointer returned. 00976 * 00977 * Side effects: 00978 * None. 00979 * 00980 * Notes: 00981 * This procedure is implemented entirely as a wrapper around 00982 * TclLindexFlat. All it does is reconfigure the argument format into the 00983 * form required by TclLindexFlat, while taking care to manage shimmering 00984 * in such a way that we tend to keep the most useful intreps and/or 00985 * avoid the most expensive conversions. 00986 * 00987 *---------------------------------------------------------------------- 00988 */ 00989 00990 Tcl_Obj * 00991 TclLindexList( 00992 Tcl_Interp *interp, /* Tcl interpreter. */ 00993 Tcl_Obj *listPtr, /* List being unpacked. */ 00994 Tcl_Obj *argPtr) /* Index or index list. */ 00995 { 00996 00997 int index; /* Index into the list. */ 00998 Tcl_Obj **indices; /* Array of list indices. */ 00999 int indexCount; /* Size of the array of list indices. */ 01000 Tcl_Obj *indexListCopy; 01001 01002 /* 01003 * Determine whether argPtr designates a list or a single index. We have 01004 * to be careful about the order of the checks to avoid repeated 01005 * shimmering; see TIP#22 and TIP#33 for the details. 01006 */ 01007 01008 if (argPtr->typePtr != &tclListType 01009 && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) { 01010 /* 01011 * argPtr designates a single index. 01012 */ 01013 01014 return TclLindexFlat(interp, listPtr, 1, &argPtr); 01015 } 01016 01017 /* 01018 * Here we make a private copy of the index list argument to avoid any 01019 * shimmering issues that might invalidate the indices array below while 01020 * we are still using it. This is probably unnecessary. It does not appear 01021 * that any damaging shimmering is possible, and no test has been devised 01022 * to show any error when this private copy is not made. But it's cheap, 01023 * and it offers some future-proofing insurance in case the TclLindexFlat 01024 * implementation changes in some unexpected way, or some new form of 01025 * trace or callback permits things to happen that the current 01026 * implementation does not. 01027 */ 01028 01029 indexListCopy = TclListObjCopy(NULL, argPtr); 01030 if (indexListCopy == NULL) { 01031 /* 01032 * argPtr designates something that is neither an index nor a 01033 * well-formed list. Report the error via TclLindexFlat. 01034 */ 01035 01036 return TclLindexFlat(interp, listPtr, 1, &argPtr); 01037 } 01038 01039 TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices); 01040 listPtr = TclLindexFlat(interp, listPtr, indexCount, indices); 01041 Tcl_DecrRefCount(indexListCopy); 01042 return listPtr; 01043 } 01044 01045 /* 01046 *---------------------------------------------------------------------- 01047 * 01048 * TclLindexFlat -- 01049 * 01050 * This procedure is the core of the 'lindex' command, with all index 01051 * arguments presented as a flat list. 01052 * 01053 * Results: 01054 * Returns a pointer to the object extracted, or NULL if an error 01055 * occurred. The returned object already includes one reference count for 01056 * the pointer returned. 01057 * 01058 * Side effects: 01059 * None. 01060 * 01061 * Notes: 01062 * The reference count of the returned object includes one reference 01063 * corresponding to the pointer returned. Thus, the calling code will 01064 * usually do something like: 01065 * Tcl_SetObjResult(interp, result); 01066 * Tcl_DecrRefCount(result); 01067 * 01068 *---------------------------------------------------------------------- 01069 */ 01070 01071 Tcl_Obj * 01072 TclLindexFlat( 01073 Tcl_Interp *interp, /* Tcl interpreter. */ 01074 Tcl_Obj *listPtr, /* Tcl object representing the list. */ 01075 int indexCount, /* Count of indices. */ 01076 Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that 01077 * represent the indices in the list. */ 01078 { 01079 int i; 01080 01081 Tcl_IncrRefCount(listPtr); 01082 01083 for (i=0 ; i<indexCount && listPtr ; i++) { 01084 int index, listLen; 01085 Tcl_Obj **elemPtrs, *sublistCopy; 01086 01087 /* 01088 * Here we make a private copy of the current sublist, so we avoid any 01089 * shimmering issues that might invalidate the elemPtr array below 01090 * while we are still using it. See test lindex-8.4. 01091 */ 01092 01093 sublistCopy = TclListObjCopy(interp, listPtr); 01094 Tcl_DecrRefCount(listPtr); 01095 listPtr = NULL; 01096 01097 if (sublistCopy == NULL) { 01098 /* 01099 * The sublist is not a list at all => error. 01100 */ 01101 01102 break; 01103 } 01104 TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs); 01105 01106 if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, 01107 &index) == TCL_OK) { 01108 if (index<0 || index>=listLen) { 01109 /* 01110 * Index is out of range. Break out of loop with empty result. 01111 * First check remaining indices for validity 01112 */ 01113 01114 while (++i < indexCount) { 01115 if (TclGetIntForIndexM(interp, indexArray[i], -1, &index) 01116 != TCL_OK) { 01117 Tcl_DecrRefCount(sublistCopy); 01118 return NULL; 01119 } 01120 } 01121 listPtr = Tcl_NewObj(); 01122 } else { 01123 /* 01124 * Extract the pointer to the appropriate element. 01125 */ 01126 01127 listPtr = elemPtrs[index]; 01128 } 01129 Tcl_IncrRefCount(listPtr); 01130 } 01131 Tcl_DecrRefCount(sublistCopy); 01132 } 01133 01134 return listPtr; 01135 } 01136 01137 /* 01138 *---------------------------------------------------------------------- 01139 * 01140 * TclLsetList -- 01141 * 01142 * Core of the 'lset' command when objc == 4. Objv[2] may be either a 01143 * scalar index or a list of indices. 01144 * 01145 * Results: 01146 * Returns the new value of the list variable, or NULL if there was an 01147 * error. The returned object includes one reference count for the 01148 * pointer returned. 01149 * 01150 * Side effects: 01151 * None. 01152 * 01153 * Notes: 01154 * This procedure is implemented entirely as a wrapper around 01155 * TclLsetFlat. All it does is reconfigure the argument format into the 01156 * form required by TclLsetFlat, while taking care to manage shimmering 01157 * in such a way that we tend to keep the most useful intreps and/or 01158 * avoid the most expensive conversions. 01159 * 01160 *---------------------------------------------------------------------- 01161 */ 01162 01163 Tcl_Obj * 01164 TclLsetList( 01165 Tcl_Interp *interp, /* Tcl interpreter. */ 01166 Tcl_Obj *listPtr, /* Pointer to the list being modified. */ 01167 Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */ 01168 Tcl_Obj *valuePtr) /* Value arg to 'lset'. */ 01169 { 01170 int indexCount; /* Number of indices in the index list. */ 01171 Tcl_Obj **indices; /* Vector of indices in the index list. */ 01172 Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */ 01173 int index; /* Current index in the list - discarded. */ 01174 Tcl_Obj *indexListCopy; 01175 01176 /* 01177 * Determine whether the index arg designates a list or a single index. 01178 * We have to be careful about the order of the checks to avoid repeated 01179 * shimmering; see TIP #22 and #23 for details. 01180 */ 01181 01182 if (indexArgPtr->typePtr != &tclListType 01183 && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) { 01184 /* 01185 * indexArgPtr designates a single index. 01186 */ 01187 01188 return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr); 01189 01190 } 01191 01192 indexListCopy = TclListObjCopy(NULL, indexArgPtr); 01193 if (indexListCopy == NULL) { 01194 /* 01195 * indexArgPtr designates something that is neither an index nor a 01196 * well formed list. Report the error via TclLsetFlat. 01197 */ 01198 01199 return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr); 01200 } 01201 TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices); 01202 01203 /* 01204 * Let TclLsetFlat handle the actual lset'ting. 01205 */ 01206 01207 retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr); 01208 01209 Tcl_DecrRefCount(indexListCopy); 01210 return retValuePtr; 01211 } 01212 01213 /* 01214 *---------------------------------------------------------------------- 01215 * 01216 * TclLsetFlat -- 01217 * 01218 * Core engine of the 'lset' command. 01219 * 01220 * Results: 01221 * Returns the new value of the list variable, or NULL if an error 01222 * occurred. The returned object includes one reference count for 01223 * the pointer returned. 01224 * 01225 * Side effects: 01226 * On entry, the reference count of the variable value does not reflect 01227 * any references held on the stack. The first action of this function is 01228 * to determine whether the object is shared, and to duplicate it if it 01229 * is. The reference count of the duplicate is incremented. At this 01230 * point, the reference count will be 1 for either case, so that the 01231 * object will appear to be unshared. 01232 * 01233 * If an error occurs, and the object has been duplicated, the reference 01234 * count on the duplicate is decremented so that it is now 0: this 01235 * dismisses any memory that was allocated by this function. 01236 * 01237 * If no error occurs, the reference count of the original object is 01238 * incremented if the object has not been duplicated, and nothing is done 01239 * to a reference count of the duplicate. Now the reference count of an 01240 * unduplicated object is 2 (the returned pointer, plus the one stored in 01241 * the variable). The reference count of a duplicate object is 1, 01242 * reflecting that the returned pointer is the only active reference. The 01243 * caller is expected to store the returned value back in the variable 01244 * and decrement its reference count. (INST_STORE_* does exactly this.) 01245 * 01246 * Surgery is performed on the unshared list value to produce the result. 01247 * TclLsetFlat maintains a linked list of Tcl_Obj's whose string 01248 * representations must be spoilt by threading via 'ptr2' of the 01249 * two-pointer internal representation. On entry to TclLsetFlat, the 01250 * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any 01251 * Tcl_Obj that has been modified is set to NULL. 01252 * 01253 *---------------------------------------------------------------------- 01254 */ 01255 01256 Tcl_Obj * 01257 TclLsetFlat( 01258 Tcl_Interp *interp, /* Tcl interpreter. */ 01259 Tcl_Obj *listPtr, /* Pointer to the list being modified. */ 01260 int indexCount, /* Number of index args. */ 01261 Tcl_Obj *const indexArray[], 01262 /* Index args. */ 01263 Tcl_Obj *valuePtr) /* Value arg to 'lset'. */ 01264 { 01265 int index, result; 01266 Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; 01267 01268 /* 01269 * If there are no indices, simply return the new value. 01270 * (Without indices, [lset] is a synonym for [set]. 01271 */ 01272 01273 if (indexCount == 0) { 01274 Tcl_IncrRefCount(valuePtr); 01275 return valuePtr; 01276 } 01277 01278 /* 01279 * If the list is shared, make a copy we can modify (copy-on-write). 01280 * We use Tcl_DuplicateObj() instead of TclListObjCopy() for a few 01281 * reasons: 1) we have not yet confirmed listPtr is actually a list; 01282 * 2) We make a verbatim copy of any existing string rep, and when 01283 * we combine that with the delayed invalidation of string reps of 01284 * modified Tcl_Obj's implemented below, the outcome is that any 01285 * error condition that causes this routine to return NULL, will 01286 * leave the string rep of listPtr and all elements to be unchanged. 01287 */ 01288 01289 subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr; 01290 01291 /* 01292 * Anchor the linked list of Tcl_Obj's whose string reps must be 01293 * invalidated if the operation succeeds. 01294 */ 01295 01296 retValuePtr = subListPtr; 01297 chainPtr = NULL; 01298 01299 /* 01300 * Loop through all the index arguments, and for each one dive 01301 * into the appropriate sublist. 01302 */ 01303 01304 do { 01305 int elemCount; 01306 Tcl_Obj *parentList, **elemPtrs; 01307 01308 /* Check for the possible error conditions... */ 01309 result = TCL_ERROR; 01310 if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs) 01311 != TCL_OK) { 01312 /* ...the sublist we're indexing into isn't a list at all. */ 01313 break; 01314 } 01315 01316 /* 01317 * WARNING: the macro TclGetIntForIndexM is not safe for 01318 * post-increments, avoid '*indexArray++' here. 01319 */ 01320 01321 if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index) 01322 != TCL_OK) { 01323 /* ...the index we're trying to use isn't an index at all. */ 01324 indexArray++; 01325 break; 01326 } 01327 indexArray++; 01328 01329 if (index < 0 || index >= elemCount) { 01330 /* ...the index points outside the sublist. */ 01331 Tcl_SetObjResult(interp, 01332 Tcl_NewStringObj("list index out of range", -1)); 01333 break; 01334 } 01335 01336 /* 01337 * No error conditions. As long as we're not yet on the last 01338 * index, determine the next sublist for the next pass through 01339 * the loop, and take steps to make sure it is an unshared copy, 01340 * as we intend to modify it. 01341 */ 01342 01343 result = TCL_OK; 01344 if (--indexCount) { 01345 parentList = subListPtr; 01346 subListPtr = elemPtrs[index]; 01347 if (Tcl_IsShared(subListPtr)) { 01348 subListPtr = Tcl_DuplicateObj(subListPtr); 01349 } 01350 01351 /* 01352 * Replace the original elemPtr[index] in parentList with a copy 01353 * we know to be unshared. This call will also deal with the 01354 * situation where parentList shares its intrep with other 01355 * Tcl_Obj's. Dealing with the shared intrep case can cause 01356 * subListPtr to become shared again, so detect that case and 01357 * make and store another copy. 01358 */ 01359 01360 TclListObjSetElement(NULL, parentList, index, subListPtr); 01361 if (Tcl_IsShared(subListPtr)) { 01362 subListPtr = Tcl_DuplicateObj(subListPtr); 01363 TclListObjSetElement(NULL, parentList, index, subListPtr); 01364 } 01365 01366 /* 01367 * The TclListObjSetElement() calls do not spoil the string 01368 * rep of parentList, and that's fine for now, since all we've 01369 * done so far is replace a list element with an unshared copy. 01370 * The list value remains the same, so the string rep. is still 01371 * valid, and unchanged, which is good because if this whole 01372 * routine returns NULL, we'd like to leave no change to the 01373 * value of the lset variable. Later on, when we set valuePtr 01374 * in its proper place, then all containing lists will have 01375 * their values changed, and will need their string reps spoiled. 01376 * We maintain a list of all those Tcl_Obj's (via a little intrep 01377 * surgery) so we can spoil them at that time. 01378 */ 01379 01380 parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr; 01381 chainPtr = parentList; 01382 } 01383 } while (indexCount > 0); 01384 01385 /* 01386 * Either we've detected and error condition, and exited the loop 01387 * with result == TCL_ERROR, or we've successfully reached the last 01388 * index, and we're ready to store valuePtr. In either case, we 01389 * need to clean up our string spoiling list of Tcl_Obj's. 01390 */ 01391 01392 while (chainPtr) { 01393 Tcl_Obj *objPtr = chainPtr; 01394 01395 if (result == TCL_OK) { 01396 01397 /* 01398 * We're going to store valuePtr, so spoil string reps 01399 * of all containing lists. 01400 */ 01401 01402 Tcl_InvalidateStringRep(objPtr); 01403 } 01404 01405 /* Clear away our intrep surgery mess */ 01406 chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2; 01407 objPtr->internalRep.twoPtrValue.ptr2 = NULL; 01408 } 01409 01410 if (result != TCL_OK) { 01411 /* 01412 * Error return; message is already in interp. Clean up 01413 * any excess memory. 01414 */ 01415 if (retValuePtr != listPtr) { 01416 Tcl_DecrRefCount(retValuePtr); 01417 } 01418 return NULL; 01419 } 01420 01421 /* Store valuePtr in proper sublist and return */ 01422 TclListObjSetElement(NULL, subListPtr, index, valuePtr); 01423 Tcl_InvalidateStringRep(subListPtr); 01424 Tcl_IncrRefCount(retValuePtr); 01425 return retValuePtr; 01426 } 01427 01428 /* 01429 *---------------------------------------------------------------------- 01430 * 01431 * TclListObjSetElement -- 01432 * 01433 * Set a single element of a list to a specified value 01434 * 01435 * Results: 01436 * The return value is normally TCL_OK. If listPtr does not refer to a 01437 * list object and cannot be converted to one, TCL_ERROR is returned and 01438 * an error message will be left in the interpreter result if interp is 01439 * not NULL. Similarly, if index designates an element outside the range 01440 * [0..listLength-1], where listLength is the count of elements in the 01441 * list object designated by listPtr, TCL_ERROR is returned and an error 01442 * message is left in the interpreter result. 01443 * 01444 * Side effects: 01445 * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts 01446 * to convert it to a list with a non-shared internal rep. Decrements the 01447 * ref count of the object at the specified index within the list, 01448 * replaces with the object designated by valuePtr, and increments the 01449 * ref count of the replacement object. 01450 * 01451 * It is the caller's responsibility to invalidate the string 01452 * representation of the object. 01453 * 01454 *---------------------------------------------------------------------- 01455 */ 01456 01457 int 01458 TclListObjSetElement( 01459 Tcl_Interp *interp, /* Tcl interpreter; used for error reporting 01460 * if not NULL. */ 01461 Tcl_Obj *listPtr, /* List object in which element should be 01462 * stored. */ 01463 int index, /* Index of element to store. */ 01464 Tcl_Obj *valuePtr) /* Tcl object to store in the designated list 01465 * element. */ 01466 { 01467 List *listRepPtr; /* Internal representation of the list being 01468 * modified. */ 01469 Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ 01470 int elemCount; /* Number of elements in the list. */ 01471 01472 /* 01473 * Ensure that the listPtr parameter designates an unshared list. 01474 */ 01475 01476 if (Tcl_IsShared(listPtr)) { 01477 Tcl_Panic("%s called with shared object", "TclListObjSetElement"); 01478 } 01479 if (listPtr->typePtr != &tclListType) { 01480 int length, result; 01481 01482 (void) TclGetStringFromObj(listPtr, &length); 01483 if (!length) { 01484 Tcl_SetObjResult(interp, 01485 Tcl_NewStringObj("list index out of range", -1)); 01486 return TCL_ERROR; 01487 } 01488 result = SetListFromAny(interp, listPtr); 01489 if (result != TCL_OK) { 01490 return result; 01491 } 01492 } 01493 01494 listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 01495 elemCount = listRepPtr->elemCount; 01496 elemPtrs = &listRepPtr->elements; 01497 01498 /* 01499 * Ensure that the index is in bounds. 01500 */ 01501 01502 if (index<0 || index>=elemCount) { 01503 if (interp != NULL) { 01504 Tcl_SetObjResult(interp, 01505 Tcl_NewStringObj("list index out of range", -1)); 01506 } 01507 return TCL_ERROR; 01508 } 01509 01510 /* 01511 * If the internal rep is shared, replace it with an unshared copy. 01512 */ 01513 01514 if (listRepPtr->refCount > 1) { 01515 List *oldListRepPtr = listRepPtr; 01516 Tcl_Obj **oldElemPtrs = elemPtrs; 01517 int i; 01518 01519 listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL); 01520 if (listRepPtr == NULL) { 01521 Tcl_Panic("Not enough memory to allocate list"); 01522 } 01523 listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag; 01524 elemPtrs = &listRepPtr->elements; 01525 for (i=0; i < elemCount; i++) { 01526 elemPtrs[i] = oldElemPtrs[i]; 01527 Tcl_IncrRefCount(elemPtrs[i]); 01528 } 01529 listRepPtr->refCount++; 01530 listRepPtr->elemCount = elemCount; 01531 listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 01532 oldListRepPtr->refCount--; 01533 } 01534 01535 /* 01536 * Add a reference to the new list element. 01537 */ 01538 01539 Tcl_IncrRefCount(valuePtr); 01540 01541 /* 01542 * Remove a reference from the old list element. 01543 */ 01544 01545 Tcl_DecrRefCount(elemPtrs[index]); 01546 01547 /* 01548 * Stash the new object in the list. 01549 */ 01550 01551 elemPtrs[index] = valuePtr; 01552 01553 return TCL_OK; 01554 } 01555 01556 /* 01557 *---------------------------------------------------------------------- 01558 * 01559 * FreeListInternalRep -- 01560 * 01561 * Deallocate the storage associated with a list object's internal 01562 * representation. 01563 * 01564 * Results: 01565 * None. 01566 * 01567 * Side effects: 01568 * Frees listPtr's List* internal representation and sets listPtr's 01569 * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all 01570 * element objects, which may free them. 01571 * 01572 *---------------------------------------------------------------------- 01573 */ 01574 01575 static void 01576 FreeListInternalRep( 01577 Tcl_Obj *listPtr) /* List object with internal rep to free. */ 01578 { 01579 register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 01580 register Tcl_Obj **elemPtrs = &listRepPtr->elements; 01581 register Tcl_Obj *objPtr; 01582 int numElems = listRepPtr->elemCount; 01583 int i; 01584 01585 if (--listRepPtr->refCount <= 0) { 01586 for (i = 0; i < numElems; i++) { 01587 objPtr = elemPtrs[i]; 01588 Tcl_DecrRefCount(objPtr); 01589 } 01590 ckfree((char *) listRepPtr); 01591 } 01592 01593 listPtr->internalRep.twoPtrValue.ptr1 = NULL; 01594 listPtr->internalRep.twoPtrValue.ptr2 = NULL; 01595 } 01596 01597 /* 01598 *---------------------------------------------------------------------- 01599 * 01600 * DupListInternalRep -- 01601 * 01602 * Initialize the internal representation of a list Tcl_Obj to share the 01603 * internal representation of an existing list object. 01604 * 01605 * Results: 01606 * None. 01607 * 01608 * Side effects: 01609 * The reference count of the List internal rep is incremented. 01610 * 01611 *---------------------------------------------------------------------- 01612 */ 01613 01614 static void 01615 DupListInternalRep( 01616 Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ 01617 Tcl_Obj *copyPtr) /* Object with internal rep to set. */ 01618 { 01619 List *listRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1; 01620 01621 listRepPtr->refCount++; 01622 copyPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 01623 copyPtr->internalRep.twoPtrValue.ptr2 = NULL; 01624 copyPtr->typePtr = &tclListType; 01625 } 01626 01627 /* 01628 *---------------------------------------------------------------------- 01629 * 01630 * SetListFromAny -- 01631 * 01632 * Attempt to generate a list internal form for the Tcl object "objPtr". 01633 * 01634 * Results: 01635 * The return value is TCL_OK or TCL_ERROR. If an error occurs during 01636 * conversion, an error message is left in the interpreter's result 01637 * unless "interp" is NULL. 01638 * 01639 * Side effects: 01640 * If no error occurs, a list is stored as "objPtr"s internal 01641 * representation. 01642 * 01643 *---------------------------------------------------------------------- 01644 */ 01645 01646 static int 01647 SetListFromAny( 01648 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 01649 Tcl_Obj *objPtr) /* The object to convert. */ 01650 { 01651 char *string, *s; 01652 const char *elemStart, *nextElem; 01653 int lenRemain, length, estCount, elemSize, hasBrace, i, j, result; 01654 const char *limit; /* Points just after string's last byte. */ 01655 register const char *p; 01656 register Tcl_Obj **elemPtrs; 01657 register Tcl_Obj *elemPtr; 01658 List *listRepPtr; 01659 01660 /* 01661 * Get the string representation. Make it up-to-date if necessary. 01662 */ 01663 01664 string = TclGetStringFromObj(objPtr, &length); 01665 01666 /* 01667 * Parse the string into separate string objects, and create a List 01668 * structure that points to the element string objects. We use a modified 01669 * version of Tcl_SplitList's implementation to avoid one malloc and a 01670 * string copy for each list element. First, estimate the number of 01671 * elements by counting the number of space characters in the list. 01672 */ 01673 01674 limit = string + length; 01675 estCount = 1; 01676 for (p = string; p < limit; p++) { 01677 if (isspace(UCHAR(*p))) { /* INTL: ISO space. */ 01678 estCount++; 01679 } 01680 } 01681 01682 /* 01683 * Allocate a new List structure with enough room for "estCount" elements. 01684 * Each element is a pointer to a Tcl_Obj with the appropriate string rep. 01685 * The initial "estCount" elements are set using the corresponding "argv" 01686 * strings. 01687 */ 01688 01689 listRepPtr = NewListIntRep(estCount, NULL); 01690 if (!listRepPtr) { 01691 Tcl_SetObjResult(interp, Tcl_NewStringObj( 01692 "Not enough memory to allocate the list internal rep", -1)); 01693 return TCL_ERROR; 01694 } 01695 elemPtrs = &listRepPtr->elements; 01696 01697 for (p=string, lenRemain=length, i=0; 01698 lenRemain > 0; 01699 p=nextElem, lenRemain=limit-nextElem, i++) { 01700 result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem, 01701 &elemSize, &hasBrace); 01702 if (result != TCL_OK) { 01703 for (j = 0; j < i; j++) { 01704 elemPtr = elemPtrs[j]; 01705 Tcl_DecrRefCount(elemPtr); 01706 } 01707 ckfree((char *) listRepPtr); 01708 return result; 01709 } 01710 if (elemStart >= limit) { 01711 break; 01712 } 01713 if (i > estCount) { 01714 Tcl_Panic("SetListFromAny: bad size estimate for list"); 01715 } 01716 01717 /* 01718 * Allocate a Tcl object for the element and initialize it from the 01719 * "elemSize" bytes starting at "elemStart". 01720 */ 01721 01722 s = ckalloc((unsigned) elemSize + 1); 01723 if (hasBrace) { 01724 memcpy(s, elemStart, (size_t) elemSize); 01725 s[elemSize] = 0; 01726 } else { 01727 elemSize = TclCopyAndCollapse(elemSize, elemStart, s); 01728 } 01729 01730 TclNewObj(elemPtr); 01731 elemPtr->bytes = s; 01732 elemPtr->length = elemSize; 01733 elemPtrs[i] = elemPtr; 01734 Tcl_IncrRefCount(elemPtr); /* Since list now holds ref to it. */ 01735 } 01736 01737 listRepPtr->elemCount = i; 01738 01739 /* 01740 * Free the old internalRep before setting the new one. We do this as late 01741 * as possible to allow the conversion code, in particular 01742 * Tcl_GetStringFromObj, to use that old internalRep. 01743 */ 01744 01745 listRepPtr->refCount++; 01746 TclFreeIntRep(objPtr); 01747 objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; 01748 objPtr->internalRep.twoPtrValue.ptr2 = NULL; 01749 objPtr->typePtr = &tclListType; 01750 return TCL_OK; 01751 } 01752 01753 /* 01754 *---------------------------------------------------------------------- 01755 * 01756 * UpdateStringOfList -- 01757 * 01758 * Update the string representation for a list object. Note: This 01759 * function does not invalidate an existing old string rep so storage 01760 * will be lost if this has not already been done. 01761 * 01762 * Results: 01763 * None. 01764 * 01765 * Side effects: 01766 * The object's string is set to a valid string that results from the 01767 * list-to-string conversion. This string will be empty if the list has 01768 * no elements. The list internal representation should not be NULL and 01769 * we assume it is not NULL. 01770 * 01771 *---------------------------------------------------------------------- 01772 */ 01773 01774 static void 01775 UpdateStringOfList( 01776 Tcl_Obj *listPtr) /* List object with string rep to update. */ 01777 { 01778 # define LOCAL_SIZE 20 01779 int localFlags[LOCAL_SIZE], *flagPtr; 01780 List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; 01781 int numElems = listRepPtr->elemCount; 01782 register int i; 01783 char *elem, *dst; 01784 int length; 01785 Tcl_Obj **elemPtrs; 01786 01787 /* 01788 * Convert each element of the list to string form and then convert it to 01789 * proper list element form, adding it to the result buffer. 01790 */ 01791 01792 /* 01793 * Pass 1: estimate space, gather flags. 01794 */ 01795 01796 if (numElems <= LOCAL_SIZE) { 01797 flagPtr = localFlags; 01798 } else { 01799 flagPtr = (int *) ckalloc((unsigned) numElems * sizeof(int)); 01800 } 01801 listPtr->length = 1; 01802 elemPtrs = &listRepPtr->elements; 01803 for (i = 0; i < numElems; i++) { 01804 elem = TclGetStringFromObj(elemPtrs[i], &length); 01805 listPtr->length += Tcl_ScanCountedElement(elem, length, flagPtr+i)+1; 01806 01807 /* 01808 * Check for continued sanity. [Bug 1267380] 01809 */ 01810 01811 if (listPtr->length < 1) { 01812 Tcl_Panic("string representation size exceeds sane bounds"); 01813 } 01814 } 01815 01816 /* 01817 * Pass 2: copy into string rep buffer. 01818 */ 01819 01820 listPtr->bytes = ckalloc((unsigned) listPtr->length); 01821 dst = listPtr->bytes; 01822 for (i = 0; i < numElems; i++) { 01823 elem = TclGetStringFromObj(elemPtrs[i], &length); 01824 dst += Tcl_ConvertCountedElement(elem, length, dst, 01825 flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH)); 01826 *dst = ' '; 01827 dst++; 01828 } 01829 if (flagPtr != localFlags) { 01830 ckfree((char *) flagPtr); 01831 } 01832 if (dst == listPtr->bytes) { 01833 *dst = 0; 01834 } else { 01835 dst--; 01836 *dst = 0; 01837 } 01838 listPtr->length = dst - listPtr->bytes; 01839 01840 /* 01841 * Mark the list as being canonical; although it has a string rep, it is 01842 * one we derived through proper "canonical" quoting and so it's known to 01843 * be free from nasties relating to [concat] and [eval]. 01844 */ 01845 01846 listRepPtr->canonicalFlag = 1; 01847 } 01848 01849 /* 01850 * Local Variables: 01851 * mode: c 01852 * c-basic-offset: 4 01853 * fill-column: 78 01854 * End: 01855 */
Generated on Wed Mar 12 12:18:19 2008 by 1.5.1 |