diff options
| -rw-r--r-- | generic/tclListObj.c | 634 | ||||
| -rw-r--r-- | generic/tclLiteral.c | 500 |
2 files changed, 566 insertions, 568 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c index aa793f4..7aaa8e0 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1,26 +1,25 @@ -/* +/* * tclListObj.c -- * - * This file contains procedures that implement the Tcl list object - * type. + * This file contains functions that implement the Tcl list object type. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1998 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclListObj.c,v 1.23 2005/05/10 18:34:44 kennykb Exp $ + * RCS: @(#) $Id: tclListObj.c,v 1.24 2005/07/19 00:09:07 dkf Exp $ */ #include "tclInt.h" /* - * Prototypes for procedures defined later in this file: + * Prototypes for functions defined later in this file: */ -static List* NewListIntRep _ANSI_ARGS_((int objc, +static List* NewListIntRep _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); static void DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); @@ -30,17 +29,16 @@ static int SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp, static void UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr)); /* - * The structure below defines the list Tcl object type by means of - * procedures that can be invoked by generic object code. + * The structure below defines the list Tcl object type by means of functions + * that can be invoked by generic object code. * * The internal representation of a list object is a two-pointer - * representation. The first pointer designates a List structure that - * contains an array of pointers to the element objects, together with - * integers that represent the current element count and the allocated - * size of the array. The second pointer is normally NULL; during - * execution of functions in this file that operate on nested sublists, - * it is occasionally used as working storage to avoid an auxiliary - * stack. + * representation. The first pointer designates a List structure that contains + * an array of pointers to the element objects, together with integers that + * represent the current element count and the allocated size of the array. + * The second pointer is normally NULL; during execution of functions in this + * file that operate on nested sublists, it is occasionally used as working + * storage to avoid an auxiliary stack. */ Tcl_ObjType tclListType = { @@ -48,7 +46,7 @@ Tcl_ObjType tclListType = { FreeListInternalRep, /* freeIntRepProc */ DupListInternalRep, /* dupIntRepProc */ UpdateStringOfList, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL /* setFromAnyProc */ }; @@ -57,17 +55,17 @@ Tcl_ObjType tclListType = { * * NewListIntRep -- * - * If objc>0 and objv!=NULL, this procedure creates a list internal rep + * If objc>0 and objv!=NULL, this function creates a list internal rep * with objc elements given in the array objv. - * If objc>0 and objv==NULL it creates the list internal rep of a list + * If objc>0 and objv==NULL it creates the list internal rep of a list * with 0 elements, where enough space has been preallocated to store * objc elements. - * If objc<=0, it returns NULL. + * If objc<=0, it returns NULL. * * Results: * A new List struct is returned. If objc<=0 or if the allocation fails - * for lack of memory, NULL is returned. - * The list returned has refCount 0. + * for lack of memory, NULL is returned. The list returned has refCount + * 0. * * Side effects: * The ref counts of the elements in objv are incremented since the @@ -89,16 +87,17 @@ NewListIntRep(objc, objv) return NULL; } - /* First check to see if we'd overflow and try to allocate an - * object larger than our memory allocator allows. Note that this - * is actually a fairly small value when you're on a serious - * 64-bit machine, but that requires API changes to fix. + /* + * First check to see if we'd overflow and try to allocate an object + * larger than our memory allocator allows. Note that this is actually a + * fairly small value when you're on a serious 64-bit machine, but that + * requires API changes to fix. */ - + if (objc > INT_MAX/sizeof(Tcl_Obj *)) { return NULL; } - + listRepPtr = (List *) attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))); if (listRepPtr == NULL) { @@ -114,7 +113,7 @@ NewListIntRep(objc, objv) for (i = 0; i < objc; i++) { elemPtrs[i] = objv[i]; Tcl_IncrRefCount(elemPtrs[i]); - } + } } else { listRepPtr->elemCount = 0; } @@ -126,19 +125,19 @@ NewListIntRep(objc, objv) * * Tcl_NewListObj -- * - * This procedure is normally called when not debugging: i.e., when + * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new list object from an * (objc,objv) array: that is, each of the objc elements of the array * referenced by objv is inserted as an element into a new Tcl object. * - * When TCL_MEM_DEBUG is defined, this procedure just returns the - * result of calling the debugging version Tcl_DbNewListObj. + * When TCL_MEM_DEBUG is defined, this function just returns the result + * of calling the debugging version Tcl_DbNewListObj. * * Results: * A new list object is returned that is initialized from the object * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation - * is left NULL. The resulting new list object has ref count 0. + * object is returned. The new object's string representation is left + * NULL. The resulting new list object has ref count 0. * * Side effects: * The ref counts of the elements in objv are incremented since the @@ -173,7 +172,7 @@ Tcl_NewListObj(objc, objv) if (objc <= 0) { return listPtr; } - + /* * Create the internal rep. */ @@ -186,7 +185,7 @@ Tcl_NewListObj(objc, objv) /* * Now create the object. */ - + Tcl_InvalidateStringRep(listPtr); listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr; listPtr->internalRep.twoPtrValue.ptr2 = NULL; @@ -202,22 +201,22 @@ Tcl_NewListObj(objc, objv) * * Tcl_DbNewListObj -- * - * This procedure is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new list objects. It is the - * same as the Tcl_NewListObj procedure above except that it calls + * This function is normally called when debugging: i.e., when + * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same + * as the Tcl_NewListObj function above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when + * command will report the correct file name and line number when * reporting objects that haven't been freed. * - * When TCL_MEM_DEBUG is not defined, this procedure just returns the + * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewListObj. * * Results: * A new list object is returned that is initialized from the object * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation - * is left NULL. The new list object has ref count 0. + * object is returned. The new object's string representation is left + * NULL. The new list object has ref count 0. * * Side effects: * The ref counts of the elements in objv are incremented since the @@ -233,9 +232,9 @@ Tcl_DbNewListObj(objc, objv, file, line) int objc; /* Count of objects referenced by objv. */ Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */ CONST char *file; /* The name of the source file calling this - * procedure; used for debugging. */ - int line; /* Line number in the source file; used - * for debugging. */ + * function; used for debugging. */ + int line; /* Line number in the source file; used for + * debugging. */ { Tcl_Obj *listPtr; List *listRepPtr; @@ -245,7 +244,7 @@ Tcl_DbNewListObj(objc, objv, file, line) if (objc <= 0) { return listPtr; } - + /* * Create the internal rep. */ @@ -258,7 +257,7 @@ Tcl_DbNewListObj(objc, objv, file, line) /* * Now create the object. */ - + Tcl_InvalidateStringRep(listPtr); listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr; listPtr->internalRep.twoPtrValue.ptr2 = NULL; @@ -275,9 +274,9 @@ Tcl_DbNewListObj(objc, objv, file, line) int objc; /* Count of objects referenced by objv. */ Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */ CONST char *file; /* The name of the source file calling this - * procedure; used for debugging. */ - int line; /* Line number in the source file; used - * for debugging. */ + * function; used for debugging. */ + int line; /* Line number in the source file; used for + * debugging. */ { return Tcl_NewListObj(objc, objv); } @@ -288,8 +287,8 @@ Tcl_DbNewListObj(objc, objv, file, line) * * Tcl_SetListObj -- * - * Modify an object to be a list containing each of the objc elements - * of the object array referenced by objv. + * Modify an object to be a list containing each of the objc elements of + * the object array referenced by objv. * * Results: * None. @@ -297,10 +296,10 @@ Tcl_DbNewListObj(objc, objv, file, line) * Side effects: * The object is made a list object and is initialized from the object * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation - * is left NULL. The ref counts of the elements in objv are incremented - * since the list now refers to them. The object's old string and - * internal representations are freed and its type is set NULL. + * object is returned. The new object's string representation is left + * NULL. The ref counts of the elements in objv are incremented since the + * list now refers to them. The object's old string and internal + * representations are freed and its type is set NULL. * *---------------------------------------------------------------------- */ @@ -327,8 +326,8 @@ Tcl_SetListObj(objPtr, objc, objv) /* * Set the object's type to "list" and initialize the internal rep. - * However, if there are no elements to put in the list, just give - * the object an empty string rep and a NULL type. + * However, if there are no elements to put in the list, just give the + * object an empty string rep and a NULL type. */ if (objc > 0) { @@ -351,23 +350,23 @@ Tcl_SetListObj(objPtr, objc, objv) * * Tcl_ListObjGetElements -- * - * This procedure returns an (objc,objv) array of the elements in a - * list object. + * This function returns an (objc,objv) array of the elements in a list + * object. * * Results: * The return value is normally TCL_OK; in this case *objcPtr is set to * the count of list elements and *objvPtr is set to a pointer to an - * array of (*objcPtr) pointers to each list element. If listPtr does - * not refer to a list object and the object can not be converted to - * one, TCL_ERROR is returned and an error message will be left in - * the interpreter's result if interp is not NULL. + * array of (*objcPtr) pointers to each list element. If listPtr does not + * refer to a list object and the object can not be converted to one, + * TCL_ERROR is returned and an error message will be left in the + * interpreter's result if interp is not NULL. * * The objects referenced by the returned array should be treated as * readonly and their ref counts are _not_ incremented; the caller must - * do that if it holds on to a reference. Furthermore, the pointer - * and length returned by this procedure may change as soon as any - * procedure is called on the list object; be careful about retaining - * the pointer in a local data structure. + * do that if it holds on to a reference. Furthermore, the pointer and + * length returned by this function may change as soon as any function is + * called on the list object; be careful about retaining the pointer in a + * local data structure. * * Side effects: * The possible conversion of the object referenced by listPtr @@ -379,12 +378,12 @@ Tcl_SetListObj(objPtr, objc, objv) int Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) Tcl_Interp *interp; /* Used to report errors if not NULL. */ - register Tcl_Obj *listPtr; /* List object for which an element array - * is to be returned. */ + register Tcl_Obj *listPtr; /* List object for which an element array is + * to be returned. */ int *objcPtr; /* Where to store the count of objects * referenced by objv. */ - Tcl_Obj ***objvPtr; /* Where to store the pointer to an array - * of pointers to the list's objects. */ + Tcl_Obj ***objvPtr; /* Where to store the pointer to an array of + * pointers to the list's objects. */ { register List *listRepPtr; @@ -414,22 +413,22 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) * * Tcl_ListObjAppendList -- * - * This procedure appends the objects in the list referenced by + * This function appends the objects in the list referenced by * elemListPtr to the list object referenced by listPtr. If listPtr is * not already a list object, an attempt will be made to convert it to * one. * * Results: - * The return value is normally TCL_OK. If listPtr or elemListPtr do - * not refer to list objects and they can not be converted to one, - * TCL_ERROR is returned and an error message is left in - * the interpreter's result if interp is not NULL. + * The return value is normally TCL_OK. If listPtr or elemListPtr do not + * refer to list objects and they can not be converted to one, TCL_ERROR + * is returned and an error message is left in the interpreter's result + * if interp is not NULL. * * Side effects: * The reference counts of the elements in elemListPtr are incremented * since the list now refers to them. listPtr and elemListPtr are - * converted, if necessary, to list objects. Also, appending the - * new elements may cause listObj's array of element pointers to grow. + * converted, if necessary, to list objects. Also, appending the new + * elements may cause listObj's array of element pointers to grow. * listPtr's old string representation, if any, is invalidated. * *---------------------------------------------------------------------- @@ -471,24 +470,24 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr) * * Tcl_ListObjAppendElement -- * - * This procedure is a special purpose version of - * Tcl_ListObjAppendList: it appends a single object referenced by - * objPtr to the list object referenced by listPtr. If listPtr is not - * already a list object, an attempt will be made to convert it to one. + * This function is a special purpose version of Tcl_ListObjAppendList: + * it appends a single object referenced by objPtr to the list object + * referenced by listPtr. If listPtr is not already a list object, an + * attempt will be made to convert it to one. * * Results: - * The return value is normally TCL_OK; in this case objPtr is added - * to the end of listPtr's list. If listPtr does not refer to a list - * object and the object can not be converted to one, TCL_ERROR is - * returned and an error message will be left in the interpreter's - * result if interp is not NULL. + * The return value is normally TCL_OK; in this case objPtr is added to + * the end of listPtr's list. If listPtr does not refer to a list object + * and the object can not be converted to one, TCL_ERROR is returned and + * an error message will be left in the interpreter's result if interp is + * not NULL. * * Side effects: - * The ref count of objPtr is incremented since the list now refers - * to it. listPtr will be converted, if necessary, to a list object. - * Also, appending the new element may cause listObj's array of element - * pointers to grow. listPtr's old string representation, if any, - * is invalidated. + * The ref count of objPtr is incremented since the list now refers to + * it. listPtr will be converted, if necessary, to a list object. Also, + * appending the new element may cause listObj's array of element + * pointers to grow. listPtr's old string representation, if any, is + * invalidated. * *---------------------------------------------------------------------- */ @@ -526,9 +525,9 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr) numRequired = numElems + 1 ; /* - * If there is no room in the current array of element pointers, - * allocate a new, larger array and copy the pointers to it. If the - * List struct is shared, allocate a new one. + * If there is no room in the current array of element pointers, allocate + * a new, larger array and copy the pointers to it. If the List struct is + * shared, allocate a new one. */ if (numRequired > listRepPtr->maxElemCount){ @@ -542,7 +541,7 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr) if (listRepPtr->refCount > 1) { List *oldListRepPtr = listRepPtr; Tcl_Obj **oldElems; - + listRepPtr = NewListIntRep(newMax, NULL); if (!listRepPtr) { Tcl_Panic("Not enough memory to allocate list"); @@ -554,7 +553,7 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr) Tcl_IncrRefCount(elemPtrs[i]); } listRepPtr->elemCount = numElems; - listRepPtr->refCount++; + listRepPtr->refCount++; oldListRepPtr->refCount--; listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr; } else if (newSize) { @@ -564,8 +563,8 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr) } /* - * Add objPtr to the end of listPtr's array of element - * pointers. Increment the ref count for the (now shared) objPtr. + * Add objPtr to the end of listPtr's array of element pointers. Increment + * the ref count for the (now shared) objPtr. */ elemPtrs = &listRepPtr->elements; @@ -587,20 +586,20 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr) * * Tcl_ListObjIndex -- * - * This procedure returns a pointer to the index'th object from the - * list referenced by listPtr. The first element has index 0. If index - * is negative or greater than or equal to the number of elements in - * the list, a NULL is returned. If listPtr is not a list object, an - * attempt will be made to convert it to a list. + * This function returns a pointer to the index'th object from the list + * referenced by listPtr. The first element has index 0. If index is + * negative or greater than or equal to the number of elements in the + * list, a NULL is returned. If listPtr is not a list object, an attempt + * will be made to convert it to a list. * * Results: - * The return value is normally TCL_OK; in this case objPtrPtr is set - * to the Tcl_Obj pointer for the index'th list element or NULL if - * index is out of range. This object should be treated as readonly and - * its ref count is _not_ incremented; the caller must do that if it - * holds on to the reference. If listPtr does not refer to a list and - * can't be converted to one, TCL_ERROR is returned and an error - * message is left in the interpreter's result if interp is not NULL. + * The return value is normally TCL_OK; in this case objPtrPtr is set to + * the Tcl_Obj pointer for the index'th list element or NULL if index is + * out of range. This object should be treated as readonly and its ref + * count is _not_ incremented; the caller must do that if it holds on to + * the reference. If listPtr does not refer to a list and can't be + * converted to one, TCL_ERROR is returned and an error message is left + * in the interpreter's result if interp is not NULL. * * Side effects: * listPtr will be converted, if necessary, to a list object. @@ -647,16 +646,16 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr) * * Tcl_ListObjLength -- * - * This procedure returns the number of elements in a list object. If - * the object is not already a list object, an attempt will be made to + * This function returns the number of elements in a list object. If the + * object is not already a list object, an attempt will be made to * convert it to one. * * Results: - * The return value is normally TCL_OK; in this case *intPtr will be - * set to the integer count of list elements. If listPtr does not refer - * to a list object and the object can not be converted to one, - * TCL_ERROR is returned and an error message will be left in - * the interpreter's result if interp is not NULL. + * The return value is normally TCL_OK; in this case *intPtr will be set + * to the integer count of list elements. If listPtr does not refer to a + * list object and the object can not be converted to one, TCL_ERROR is + * returned and an error message will be left in the interpreter's result + * if interp is not NULL. * * Side effects: * The possible conversion of the argument object to a list object. @@ -696,36 +695,36 @@ Tcl_ListObjLength(interp, listPtr, intPtr) *---------------------------------------------------------------------- * * Tcl_ListObjReplace -- - * - * This procedure replaces zero or more elements of the list referenced - * by listPtr with the objects from an (objc,objv) array. - * The objc elements of the array referenced by objv replace the - * count elements in listPtr starting at first. + * + * This function replaces zero or more elements of the list referenced by + * listPtr with the objects from an (objc,objv) array. The objc elements + * of the array referenced by objv replace the count elements in listPtr + * starting at first. * * If the argument first is zero or negative, it refers to the first * element. If first is greater than or equal to the number of elements * in the list, then no elements are deleted; the new elements are - * appended to the list. Count gives the number of elements to - * replace. If count is zero or negative then no elements are deleted; - * the new elements are simply inserted before first. + * appended to the list. Count gives the number of elements to replace. + * If count is zero or negative then no elements are deleted; the new + * elements are simply inserted before first. * * The argument objv refers to an array of objc pointers to the new - * elements to be added to listPtr in place of those that were - * deleted. If objv is NULL, no new elements are added. If listPtr is - * not a list object, an attempt will be made to convert it to one. + * elements to be added to listPtr in place of those that were deleted. + * If objv is NULL, no new elements are added. If listPtr is not a list + * object, an attempt will be made to convert it to one. * * Results: - * The return value is normally TCL_OK. If listPtr does - * not refer to a list object and can not be converted to one, - * TCL_ERROR is returned and an error message will be left in - * the interpreter's result if interp is not NULL. + * The return value is normally TCL_OK. If listPtr does not refer to a + * list object and can not be converted to one, TCL_ERROR is returned and + * an error message will be left in the interpreter's result if interp is + * not NULL. * * Side effects: - * The ref counts of the objc elements in objv are incremented since - * the resulting list now refers to them. Similarly, the ref counts for - * replaced objects are decremented. listPtr is converted, if - * necessary, to a list object. listPtr's old string representation, if - * any, is freed. + * The ref counts of the objc elements in objv are incremented since the + * resulting list now refers to them. Similarly, the ref counts for + * replaced objects are decremented. listPtr is converted, if necessary, + * to a list object. listPtr's old string representation, if any, is + * freed. * *---------------------------------------------------------------------- */ @@ -737,8 +736,8 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) int first; /* Index of first element to replace. */ int count; /* Number of elements to replace. */ int objc; /* Number of objects to insert. */ - Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects - * to insert. */ + Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects to + * insert. */ { List *listRepPtr; register Tcl_Obj **elemPtrs; @@ -746,7 +745,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) int numElems, numRequired, numAfterLast; int start, shift, newMax, i, j, result; int isShared; - + if (Tcl_IsShared(listPtr)) { Tcl_Panic("Tcl_ListObjReplace called with shared object"); } @@ -758,16 +757,16 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) if (objc) { Tcl_SetListObj(listPtr, objc, NULL); } else { - return TCL_OK; + return TCL_OK; } - } else { + } else { result = SetListFromAny(interp, listPtr); if (result != TCL_OK) { return result; } } } - + listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; elemPtrs = &listRepPtr->elements; numElems = listRepPtr->elemCount; @@ -776,7 +775,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) first = 0; } if (first >= numElems) { - first = numElems; /* so we'll insert after last element */ + first = numElems; /* So we'll insert after last element. */ } if (count < 0) { count = 0; @@ -784,14 +783,14 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) count = numElems - first; } - isShared = (listRepPtr->refCount > 1); + isShared = (listRepPtr->refCount > 1); numRequired = (numElems - count + objc); - + if ((numRequired <= listRepPtr->maxElemCount) && !isShared) { /* - * Can use the current List struct. First "delete" count - * elements starting at first. + * Can use the current List struct. First "delete" count elements + * starting at first. */ for (j = first; j < first + count; j++) { @@ -800,8 +799,8 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) } /* - * Shift the elements after the last one removed to their - * new locations. + * Shift the elements after the last one removed to their new + * locations. */ start = (first + count); @@ -811,13 +810,13 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) Tcl_Obj **src, **dst; src = elemPtrs + start; dst = src + shift; - memmove((VOID*) dst, (VOID*) src, - (size_t) (numAfterLast * sizeof(Tcl_Obj*))); + memmove((VOID*) dst, (VOID*) src, + (size_t) (numAfterLast * sizeof(Tcl_Obj*))); } } else { /* - * Cannot use the current List struct - it is shared, too small, - * or both. Allocate a new struct and insert elements into it. + * Cannot use the current List struct - it is shared, too small, or + * both. Allocate a new struct and insert elements into it. */ List *oldListRepPtr = listRepPtr; @@ -828,7 +827,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) } else { newMax = listRepPtr->maxElemCount; } - + listRepPtr = NewListIntRep(newMax, NULL); if (!listRepPtr) { Tcl_Panic("Not enough memory to allocate list"); @@ -838,11 +837,12 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) listRepPtr->refCount++; elemPtrs = &listRepPtr->elements; - + if (isShared) { /* * The old struct will remain in place; need new refCounts for the - * new List struct references. Copy over only the surviving elements. + * new List struct references. Copy over only the surviving + * elements. */ for (i=0; i < first; i++) { @@ -858,7 +858,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) oldListRepPtr->refCount--; } else { /* - * The old struct will be removed; use its inherited refCounts. + * The old struct will be removed; use its inherited refCounts. */ if (first > 0) { @@ -869,17 +869,17 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) /* * "Delete" count elements starting at first. */ - + for (j = first; j < first + count; j++) { victimPtr = oldPtrs[j]; TclDecrRefCount(victimPtr); } - + /* - * Copy the elements after the last one removed, shifted to - * their new locations. + * Copy the elements after the last one removed, shifted to their + * new locations. */ - + start = (first + count); numAfterLast = (numElems - start); if (numAfterLast > 0) { @@ -895,18 +895,18 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) /* * Insert the new elements into elemPtrs before "first". */ - + for (i=0,j=first ; i<objc ; i++,j++) { elemPtrs[j] = objv[i]; Tcl_IncrRefCount(objv[i]); } - + /* * Update the count of elements. */ - + listRepPtr->elemCount = numRequired; - + /* * Invalidate and free any old string representation since it no longer * reflects the list's internal representation. @@ -920,45 +920,43 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) *---------------------------------------------------------------------- * * TclLsetList -- - * - * Core of the 'lset' command when objc == 4. Objv[2] may be - * either a scalar index or a list of indices. + * + * Core of the 'lset' command when objc == 4. Objv[2] may be either a + * scalar index or a list of indices. * * Results: - * Returns the new value of the list variable, or NULL if an - * error occurs. + * Returns the new value of the list variable, or NULL if an error + * occurs. * * Side effects: - * Surgery is performed on the list value to produce the - * result. - * - * On entry, the reference count of the variable value does not reflect - * any references held on the stack. The first action of this function - * is to determine whether the object is shared, and to duplicate it if - * it is. The reference count of the duplicate is incremented. - * At this point, the reference count will be 1 for either case, so that - * the object will appear to be unshared. - * - * If an error occurs, and the object has been duplicated, the reference - * count on the duplicate is decremented so that it is now 0: this dismisses - * any memory that was allocated by this procedure. - * - * If no error occurs, the reference count of the original object is - * incremented if the object has not been duplicated, and nothing is - * done to a reference count of the duplicate. Now the reference count - * of an unduplicated object is 2 (the returned pointer, plus the one - * stored in the variable). The reference count of a duplicate object - * is 1, reflecting that the returned pointer is the only active - * reference. The caller is expected to store the returned value back - * in the variable and decrement its reference count. (INST_STORE_* - * does exactly this.) - * - * Tcl_LsetFlat and related functions maintain a linked list of - * Tcl_Obj's whose string representations must be spoilt by threading - * via 'ptr2' of the two-pointer internal representation. On entry - * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit, - * the 'ptr2' field of any Tcl_Obj that has been modified is set to - * NULL. + * Surgery is performed on the list value to produce the result. + * + * On entry, the reference count of the variable value does not reflect + * any references held on the stack. The first action of this function is + * to determine whether the object is shared, and to duplicate it if it + * is. The reference count of the duplicate is incremented. At this + * point, the reference count will be 1 for either case, so that the + * object will appear to be unshared. + * + * If an error occurs, and the object has been duplicated, the reference + * count on the duplicate is decremented so that it is now 0: this + * dismisses any memory that was allocated by this function. + * + * If no error occurs, the reference count of the original object is + * incremented if the object has not been duplicated, and nothing is done + * to a reference count of the duplicate. Now the reference count of an + * unduplicated object is 2 (the returned pointer, plus the one stored in + * the variable). The reference count of a duplicate object is 1, + * reflecting that the returned pointer is the only active reference. + * The caller is expected to store the returned value back in the + * variable and decrement its reference count. (INST_STORE_* does exactly + * this.) + * + * Tcl_LsetFlat and related functions maintain a linked list of Tcl_Obj's + * whose string representations must be spoilt by threading via 'ptr2' of + * the two-pointer internal representation. On entry to Tcl_LsetList, + * the values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any + * Tcl_Obj that has been modified is set to NULL. * *---------------------------------------------------------------------- */ @@ -976,11 +974,11 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr) int index; /* Current index in the list - discarded */ int i; List *indexListRepPtr; - + /* - * Determine whether the index arg designates a list or a single - * index. We have to be careful about the order of the checks to - * avoid repeated shimmering; see TIP #22 and #23 for details. + * Determine whether the index arg designates a list or a single index. + * We have to be careful about the order of the checks to avoid repeated + * shimmering; see TIP #22 and #23 for details. */ if (indexArgPtr->typePtr != &tclListType @@ -1002,11 +1000,11 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr) } /* - * At this point, we know that argPtr designates a well formed list, - * and the 'else if' above has parsed it into indexCount and indices. - * Increase the reference count of the internal rep of indexArgPtr, - * in order to insure the validity of pointers even if indexArgPtr - * shimmers to another type. + * At this point, we know that argPtr designates a well formed list, and + * the 'else if' above has parsed it into indexCount and indices. + * Increase the reference count of the internal rep of indexArgPtr, in + * order to insure the validity of pointers even if indexArgPtr shimmers + * to another type. */ if (indexCount) { @@ -1015,7 +1013,6 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr) } else { indexListRepPtr = NULL; /* avoid compiler warning*/ } - /* * Let TclLsetFlat handle the actual lset'ting. @@ -1025,9 +1022,9 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr) /* * If we are the only users of indexListRepPtr, we free it before - * returning. + * returning. */ - + if (indexCount) { if (--indexListRepPtr->refCount <= 0) { for (i=0; i<indexCount; i++) { @@ -1044,44 +1041,42 @@ TclLsetList(interp, listPtr, indexArgPtr, valuePtr) * * TclLsetFlat -- * - * Core of the 'lset' command when objc>=5. Objv[2], ... , - * objv[objc-2] contain scalar indices. + * Core of the 'lset' command when objc>=5. Objv[2], ... , objv[objc-2] + * contain scalar indices. * * Results: - * Returns the new value of the list variable, or NULL if an - * error occurs. + * Returns the new value of the list variable, or NULL if an error + * occurs. * * Side effects: - * Surgery is performed on the list value to produce the - * result. - * - * On entry, the reference count of the variable value does not reflect - * any references held on the stack. The first action of this function - * is to determine whether the object is shared, and to duplicate it if - * it is. The reference count of the duplicate is incremented. - * At this point, the reference count will be 1 for either case, so that - * the object will appear to be unshared. - * - * If an error occurs, and the object has been duplicated, the reference - * count on the duplicate is decremented so that it is now 0: this dismisses - * any memory that was allocated by this procedure. - * - * If no error occurs, the reference count of the original object is - * incremented if the object has not been duplicated, and nothing is - * done to a reference count of the duplicate. Now the reference count - * of an unduplicated object is 2 (the returned pointer, plus the one - * stored in the variable). The reference count of a duplicate object - * is 1, reflecting that the returned pointer is the only active - * reference. The caller is expected to store the returned value back - * in the variable and decrement its reference count. (INST_STORE_* - * does exactly this.) - * - * Tcl_LsetList and related functions maintain a linked list of - * Tcl_Obj's whose string representations must be spoilt by threading - * via 'ptr2' of the two-pointer internal representation. On entry - * to Tcl_LsetList, the values of 'ptr2' are immaterial; on exit, - * the 'ptr2' field of any Tcl_Obj that has been modified is set to - * NULL. + * Surgery is performed on the list value to produce the result. + * + * On entry, the reference count of the variable value does not reflect + * any references held on the stack. The first action of this function is + * to determine whether the object is shared, and to duplicate it if it + * is. The reference count of the duplicate is incremented. At this + * point, the reference count will be 1 for either case, so that the + * object will appear to be unshared. + * + * If an error occurs, and the object has been duplicated, the reference + * count on the duplicate is decremented so that it is now 0: this + * dismisses any memory that was allocated by this function. + * + * If no error occurs, the reference count of the original object is + * incremented if the object has not been duplicated, and nothing is done + * to a reference count of the duplicate. Now the reference count of an + * unduplicated object is 2 (the returned pointer, plus the one stored in + * the variable). The reference count of a duplicate object is 1, + * reflecting that the returned pointer is the only active reference. + * The caller is expected to store the returned value back in the + * variable and decrement its reference count. (INST_STORE_* does + * exactly this.) + * + * Tcl_LsetList and related functions maintain a linked list of Tcl_Obj's + * whose string representations must be spoilt by threading via 'ptr2' of + * the two-pointer internal representation. On entry to Tcl_LsetList, + * the values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any + * Tcl_Obj that has been modified is set to NULL. * *---------------------------------------------------------------------- */ @@ -1095,22 +1090,22 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) /* Index args */ Tcl_Obj* valuePtr; /* Value arg to 'lset' */ { - int duplicated; /* Flag == 1 if the obj has been - * duplicated, 0 otherwise */ + int duplicated; /* Flag == 1 if the obj has been duplicated, 0 + * otherwise */ Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */ int elemCount; /* Length of one sublist being changed */ Tcl_Obj** elemPtrs; /* Pointers to the elements of a sublist */ Tcl_Obj* subListPtr; /* Pointer to the current sublist */ int index; /* Index of the element to replace in the * current sublist */ - Tcl_Obj* chainPtr; /* Pointer to the enclosing list of - * the current sublist. */ + Tcl_Obj* chainPtr; /* Pointer to the enclosing list of the + * current sublist. */ int result; /* Status return from library calls */ int i; - + /* - * If there are no indices, then simply return the new value, - * counting the returned pointer as a reference + * If there are no indices, then simply return the new value, counting the + * returned pointer as a reference. */ if (indexCount == 0) { @@ -1139,7 +1134,7 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) chainPtr = NULL; /* - * Handle each index arg by diving into the appropriate sublist + * Handle each index arg by diving into the appropriate sublist. */ for (i=0 ; ; i++) { @@ -1197,19 +1192,20 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) subListPtr = Tcl_DuplicateObj(subListPtr); result = TclListObjSetElement(interp, listPtr, index, subListPtr); if (result != TCL_OK) { - /* - * We actually shouldn't be able to get here. - * If we do, it would result in leaking subListPtr, - * but everything's been validated already; the error - * exit from TclListObjSetElement should never happen. + /* + * We actually shouldn't be able to get here. If we do, it + * would result in leaking subListPtr, but everything's been + * validated already; the error exit from TclListObjSetElement + * should never happen. */ + break; } } - /* - * Chain the current sublist onto the linked list of Tcl_Obj's - * whose string reps must be spoilt. + /* + * Chain the current sublist onto the linked list of Tcl_Obj's whose + * string reps must be spoilt. */ chainPtr = listPtr; @@ -1258,26 +1254,23 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr) * Set a single element of a list to a specified value * * Results: - * - * The return value is normally TCL_OK. If listPtr does not - * refer to a list object and cannot be converted to one, TCL_ERROR - * is returned and an error message will be left in the interpreter - * result if interp is not NULL. Similarly, if index designates - * an element outside the range [0..listLength-1], where - * listLength is the count of elements in the list object designated - * by listPtr, TCL_ERROR is returned and an error message is left - * in the interpreter result. + * The return value is normally TCL_OK. If listPtr does not refer to a + * list object and cannot be converted to one, TCL_ERROR is returned and + * an error message will be left in the interpreter result if interp is + * not NULL. Similarly, if index designates an element outside the range + * [0..listLength-1], where listLength is the count of elements in the + * list object designated by listPtr, TCL_ERROR is returned and an error + * message is left in the interpreter result. * * Side effects: + * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts + * to convert it to a list with a non-shared internal rep. Decrements the + * ref count of the object at the specified index within the list, + * replaces with the object designated by valuePtr, and increments the + * ref count of the replacement object. * - * Tcl_Panic if listPtr designates a shared object. Otherwise, - * attempts to convert it to a list with a non-shared internal rep. - * Decrements the ref count of the object at the specified index within - * the list, replaces with the object designated by valuePtr, and - * increments the ref count of the replacement object. - * - * It is the caller's responsibility to invalidate the string - * representation of the object. + * It is the caller's responsibility to invalidate the string + * representation of the object. * *---------------------------------------------------------------------- */ @@ -1289,16 +1282,16 @@ TclListObjSetElement(interp, listPtr, index, valuePtr) Tcl_Obj* listPtr; /* List object in which element should be * stored */ int index; /* Index of element to store */ - Tcl_Obj* valuePtr; /* Tcl object to store in the designated - * list element */ + Tcl_Obj* valuePtr; /* Tcl object to store in the designated list + * element */ { int result; /* Return value from this function */ - List* listRepPtr; /* Internal representation of the list - * being modified */ + List* listRepPtr; /* Internal representation of the list being + * modified */ Tcl_Obj** elemPtrs; /* Pointers to elements of the list */ int elemCount; /* Number of elements in the list */ int i; - + /* Ensure that the listPtr parameter designates an unshared list */ if (Tcl_IsShared(listPtr)) { @@ -1318,7 +1311,7 @@ TclListObjSetElement(interp, listPtr, index, valuePtr) return result; } } - + listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1; elemCount = listRepPtr->elemCount; elemPtrs = &listRepPtr->elements; @@ -1340,7 +1333,7 @@ TclListObjSetElement(interp, listPtr, index, valuePtr) if (listRepPtr->refCount > 1) { List *oldListRepPtr = listRepPtr; Tcl_Obj **oldElemPtrs = elemPtrs; - + listRepPtr = NewListIntRep(listRepPtr->maxElemCount, NULL); elemPtrs = &listRepPtr->elements; for (i=0; i < elemCount; i++) { @@ -1381,8 +1374,8 @@ TclListObjSetElement(interp, listPtr, index, valuePtr) * * Side effects: * Frees listPtr's List* internal representation and sets listPtr's - * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts - * of all element objects, which may free them. + * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all + * element objects, which may free them. * *---------------------------------------------------------------------- */ @@ -1402,9 +1395,9 @@ FreeListInternalRep(listPtr) objPtr = elemPtrs[i]; Tcl_DecrRefCount(objPtr); } - ckfree((char *) listRepPtr); + ckfree((char *) listRepPtr); } - + listPtr->internalRep.twoPtrValue.ptr1 = NULL; listPtr->internalRep.twoPtrValue.ptr2 = NULL; } @@ -1414,14 +1407,14 @@ FreeListInternalRep(listPtr) * * DupListInternalRep -- * - * Initialize the internal representation of a list Tcl_Obj to share - * the internal representation of an existing list object. + * Initialize the internal representation of a list Tcl_Obj to share the + * internal representation of an existing list object. * * Results: * None. * * Side effects: - * The reference count of the List internal rep is incremented. + * The reference count of the List internal rep is incremented. * *---------------------------------------------------------------------- */ @@ -1444,8 +1437,7 @@ DupListInternalRep(srcPtr, copyPtr) * * SetListFromAny -- * - * Attempt to generate a list internal form for the Tcl object - * "objPtr". + * Attempt to generate a list internal form for the Tcl object "objPtr". * * Results: * The return value is TCL_OK or TCL_ERROR. If an error occurs during @@ -1505,17 +1497,17 @@ SetListFromAny(interp, objPtr) listRepPtr = NewListIntRep(estCount, NULL); if(!listRepPtr) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("Not enough memory to allocate the list internal rep",-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Not enough memory to allocate the list internal rep", -1)); return TCL_ERROR; } elemPtrs = &listRepPtr->elements; - + for (p = string, lenRemain = length, i = 0; lenRemain > 0; p = nextElem, lenRemain = (limit - nextElem), i++) { result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem, - &elemSize, &hasBrace); + &elemSize, &hasBrace); if (result != TCL_OK) { for (j = 0; j < i; j++) { elemPtr = elemPtrs[j]; @@ -1554,8 +1546,8 @@ SetListFromAny(interp, objPtr) listRepPtr->elemCount = i; /* - * Free the old internalRep before setting the new one. We do this as - * late as possible to allow the conversion code, in particular + * Free the old internalRep before setting the new one. We do this as late + * as possible to allow the conversion code, in particular * Tcl_GetStringFromObj, to use that old internalRep. */ @@ -1572,18 +1564,18 @@ SetListFromAny(interp, objPtr) * * UpdateStringOfList -- * - * Update the string representation for a list object. - * Note: This procedure does not invalidate an existing old string rep - * so storage will be lost if this has not already been done. + * Update the string representation for a list object. Note: This + * function does not invalidate an existing old string rep so storage + * will be lost if this has not already been done. * * Results: * None. * * Side effects: - * The object's string is set to a valid string that results from - * the list-to-string conversion. This string will be empty if the - * list has no elements. The list internal representation - * should not be NULL and we assume it is not NULL. + * The object's string is set to a valid string that results from the + * list-to-string conversion. This string will be empty if the list has + * no elements. The list internal representation should not be NULL and + * we assume it is not NULL. * *---------------------------------------------------------------------- */ @@ -1600,10 +1592,10 @@ UpdateStringOfList(listPtr) char *elem, *dst; int length; Tcl_Obj **elemPtrs; - + /* - * Convert each element of the list to string form and then convert it - * to proper list element form, adding it to the result buffer. + * Convert each element of the list to string form and then convert it to + * proper list element form, adding it to the result buffer. */ /* @@ -1647,3 +1639,11 @@ UpdateStringOfList(listPtr) } listPtr->length = dst - listPtr->bytes; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 962856e..c4bf5ee 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -1,26 +1,26 @@ -/* +/* * tclLiteral.c -- * - * Implementation of the global and ByteCode-local literal tables - * used to manage the Tcl objects created for literal values during - * compilation of Tcl scripts. This implementation borrows heavily - * from the more general hashtable implementation of Tcl hash tables - * that appears in tclHash.c. + * Implementation of the global and ByteCode-local literal tables used to + * manage the Tcl objects created for literal values during compilation + * of Tcl scripts. This implementation borrows heavily from the more + * general hashtable implementation of Tcl hash tables that appears in + * tclHash.c. * * Copyright (c) 1997-1998 Sun Microsystems, Inc. * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLiteral.c,v 1.24 2005/05/10 18:34:44 kennykb Exp $ + * RCS: @(#) $Id: tclLiteral.c,v 1.25 2005/07/19 00:09:07 dkf Exp $ */ #include "tclInt.h" #include "tclCompile.h" /* - * When there are this many entries per bucket, on average, rebuild - * a literal's hash table to make it larger. + * When there are this many entries per bucket, on average, rebuild a + * literal's hash table to make it larger. */ #define REBUILD_MULTIPLIER 3 @@ -51,7 +51,7 @@ static void RebuildLiteralTable _ANSI_ARGS_(( * Results: * None. * - * Side effects: + * Side effects: * The literal table is made ready for use. * *---------------------------------------------------------------------- @@ -59,14 +59,15 @@ static void RebuildLiteralTable _ANSI_ARGS_(( void TclInitLiteralTable(tablePtr) - register LiteralTable *tablePtr; /* Pointer to table structure, which - * is supplied by the caller. */ + register LiteralTable *tablePtr; + /* Pointer to table structure, which is + * supplied by the caller. */ { -#if (TCL_SMALL_HASH_TABLE != 4) +#if (TCL_SMALL_HASH_TABLE != 4) Tcl_Panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n", TCL_SMALL_HASH_TABLE); #endif - + tablePtr->buckets = tablePtr->staticBuckets; tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0; tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0; @@ -81,9 +82,9 @@ TclInitLiteralTable(tablePtr) * * TclCleanupLiteralTable -- * - * This procedure frees the internal representation of every - * literal in a literal table. It is called prior to deleting - * an interp, so that variable refs will be cleaned up properly. + * This procedure frees the internal representation of every literal in a + * literal table. It is called prior to deleting an interp, so that + * variable refs will be cleaned up properly. * * Results: * None. @@ -96,58 +97,56 @@ TclInitLiteralTable(tablePtr) void TclCleanupLiteralTable( interp, tablePtr ) - Tcl_Interp* interp; /* Interpreter containing literals to purge */ - LiteralTable* tablePtr; /* Points to the literal table being cleaned */ + Tcl_Interp* interp; /* Interpreter containing literals to + * purge. */ + LiteralTable* tablePtr; /* Points to the literal table being + * cleaned. */ { int i; - LiteralEntry* entryPtr; /* Pointer to the current entry in the - * hash table of literals */ - LiteralEntry* nextPtr; /* Pointer to the next entry in tbe - * bucket */ - Tcl_Obj* objPtr; /* Pointer to a literal object whose internal - * rep is being freed */ - Tcl_ObjType* typePtr; /* Pointer to the object's type */ - int didOne; /* Flag for whether we've removed a literal - * in the current bucket */ + LiteralEntry* entryPtr; /* Pointer to the current entry in the hash + * table of literals. */ + LiteralEntry* nextPtr; /* Pointer to the next entry in the bucket. */ + Tcl_Obj* objPtr; /* Pointer to a literal object whose internal + * rep is being freed. */ + Tcl_ObjType* typePtr; /* Pointer to the object's type. */ + int didOne; /* Flag for whether we've removed a literal in + * the current bucket. */ #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable( (Interp*) interp ); #endif /* TCL_COMPILE_DEBUG */ - for ( i = 0; i < tablePtr->numBuckets; i++ ) { - - /* - * It is tempting simply to walk each hash bucket once and - * delete the internal representations of each literal in turn. - * It's also wrong. The problem is that freeing a literal's - * internal representation can delete other literals to which - * it refers, making nextPtr invalid. So each time we free an - * internal rep, we start its bucket over again. - */ - didOne = 1; - while ( didOne ) { - didOne = 0; - entryPtr = tablePtr->buckets[i]; - while ( entryPtr != NULL ) { - objPtr = entryPtr->objPtr; - nextPtr = entryPtr->nextPtr; - typePtr = objPtr->typePtr; - if ( ( typePtr != NULL ) - && ( typePtr->freeIntRepProc != NULL ) ) { - if ( objPtr->bytes == NULL ) { - Tcl_Panic( "literal without a string rep" ); - } - objPtr->typePtr = NULL; - typePtr->freeIntRepProc( objPtr ); - didOne = 1; - } else { - entryPtr = nextPtr; - } - } - } + for (i=0 ; i<tablePtr->numBuckets ; i++) { + /* + * It is tempting simply to walk each hash bucket once and delete the + * internal representations of each literal in turn. It's also wrong. + * The problem is that freeing a literal's internal representation can + * delete other literals to which it refers, making nextPtr invalid. + * So each time we free an internal rep, we start its bucket over + * again. + */ + + do { + didOne = 0; + entryPtr = tablePtr->buckets[i]; + while (entryPtr != NULL) { + objPtr = entryPtr->objPtr; + nextPtr = entryPtr->nextPtr; + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + if (objPtr->bytes == NULL) { + Tcl_Panic( "literal without a string rep" ); + } + objPtr->typePtr = NULL; + typePtr->freeIntRepProc(objPtr); + didOne = 1; + } else { + entryPtr = nextPtr; + } + } + } while (didOne); } } - /* *---------------------------------------------------------------------- @@ -162,10 +161,9 @@ TclCleanupLiteralTable( interp, tablePtr ) * None. * * Side effects: - * Each literal in the table is released: i.e., its reference count - * in the global literal table is decremented and, if it becomes zero, - * the literal is freed. In addition, the table's bucket array is - * freed. + * Each literal in the table is released: i.e., its reference count in + * the global literal table is decremented and, if it becomes zero, the + * literal is freed. In addition, the table's bucket array is freed. * *---------------------------------------------------------------------- */ @@ -179,11 +177,11 @@ TclDeleteLiteralTable(interp, tablePtr) LiteralEntry *entryPtr, *nextPtr; Tcl_Obj *objPtr; int i; - + /* - * Release remaining literals in the table. Note that releasing a - * literal might release other literals, modifying the table, so we - * restart the search from the bucket chain we last found an entry. + * Release remaining literals in the table. Note that releasing a literal + * might release other literals, modifying the table, so we restart the + * search from the bucket chain we last found an entry. */ #ifdef TCL_COMPILE_DEBUG @@ -193,10 +191,10 @@ TclDeleteLiteralTable(interp, tablePtr) /* * We used to call TclReleaseLiteral for each literal in the table, which * is rather inefficient as it causes one lookup-by-hash for each - * reference to the literal. - * We now rely at interp-deletion on each bytecode object to release its - * references to the literal Tcl_Obj without requiring that it updates the - * global table itself, and deal here only with the table. + * reference to the literal. We now rely at interp-deletion on each + * bytecode object to release its references to the literal Tcl_Obj + * without requiring that it updates the global table itself, and deal + * here only with the table. */ for (i = 0; i < tablePtr->numBuckets; i++) { @@ -209,7 +207,7 @@ TclDeleteLiteralTable(interp, tablePtr) entryPtr = nextPtr; } } - + /* * Free up the table's bucket array if it was dynamically allocated. */ @@ -224,19 +222,18 @@ TclDeleteLiteralTable(interp, tablePtr) * * TclRegisterLiteral -- * - * Find, or if necessary create, an object in a CompileEnv literal - * array that has a string representation matching the argument string. + * Find, or if necessary create, an object in a CompileEnv literal array + * that has a string representation matching the argument string. * * Results: - * The index in the CompileEnv's literal array that references a - * shared literal matching the string. The object is created if - * necessary. + * The index in the CompileEnv's literal array that references a shared + * literal matching the string. The object is created if necessary. * * Side effects: - * To maximize sharing, we look up the string in the interpreter's - * global literal table. If not found, we create a new shared literal - * in the global table. We then add a reference to the shared - * literal in the CompileEnv's literal array. + * To maximize sharing, we look up the string in the interpreter's global + * literal table. If not found, we create a new shared literal in the + * global table. We then add a reference to the shared literal in the + * CompileEnv's literal array. * * If LITERAL_ON_HEAP is set in flags, this procedure is given ownership * of the string: if an object is created then its string representation @@ -254,9 +251,9 @@ TclRegisterLiteral(envPtr, bytes, length, flags) register char *bytes; /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - int length; /* Number of bytes in the string. If < 0, - * the string consists of all bytes up to - * the first null character. */ + int length; /* Number of bytes in the string. If < 0, the + * string consists of all bytes up to the + * first null character. */ int flags; /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to * this procedure. If LITERAL_NS_SCOPE then @@ -273,23 +270,22 @@ TclRegisterLiteral(envPtr, bytes, length, flags) Namespace *nsPtr; if (length < 0) { - length = (bytes? strlen(bytes) : 0); + length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); /* - * Is the literal already in the CompileEnv's local literal array? - * If so, just return its index. + * Is the literal already in the CompileEnv's local literal array? If so, + * just return its index. */ localHash = (hash & localTablePtr->mask); for (localPtr = localTablePtr->buckets[localHash]; - localPtr != NULL; localPtr = localPtr->nextPtr) { + localPtr != NULL; localPtr = localPtr->nextPtr) { objPtr = localPtr->objPtr; if ((objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) - && (memcmp(objPtr->bytes, bytes, (unsigned) length) - == 0)))) { + && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } @@ -321,18 +317,17 @@ TclRegisterLiteral(envPtr, bytes, length, flags) globalHash = (hash & globalTablePtr->mask); for (globalPtr = globalTablePtr->buckets[globalHash]; - globalPtr != NULL; globalPtr = globalPtr->nextPtr) { + globalPtr != NULL; globalPtr = globalPtr->nextPtr) { objPtr = globalPtr->objPtr; if ((globalPtr->nsPtr == nsPtr) && (objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) - && (memcmp(objPtr->bytes, bytes, (unsigned) length) - == 0)))) { + && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { /* * A global literal was found. Add an entry to the CompileEnv's * local literal array. */ - + if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } @@ -340,11 +335,10 @@ TclRegisterLiteral(envPtr, bytes, length, flags) #ifdef TCL_COMPILE_DEBUG if (globalPtr->refCount < 1) { Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d", - (length>60? 60 : length), bytes, - globalPtr->refCount); + (length>60? 60 : length), bytes, globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); -#endif /*TCL_COMPILE_DEBUG*/ +#endif /*TCL_COMPILE_DEBUG*/ return objIndex; } } @@ -369,8 +363,10 @@ TclRegisterLiteral(envPtr, bytes, length, flags) /* * From here we use the objPtr, because it is NULL terminated */ + long n; char buf[TCL_INTEGER_SPACE]; + if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) { TclFormatInt(buf, n); if (strcmp(objPtr->bytes, buf) == 0) { @@ -380,11 +376,11 @@ TclRegisterLiteral(envPtr, bytes, length, flags) } } #endif - + #ifdef TCL_COMPILE_DEBUG if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be", - (length>60? 60 : length), bytes); + (length>60? 60 : length), bytes); } #endif @@ -397,8 +393,8 @@ TclRegisterLiteral(envPtr, bytes, length, flags) globalTablePtr->numEntries++; /* - * If the global literal table has exceeded a decent size, rebuild it - * with more buckets. + * If the global literal table has exceeded a decent size, rebuild it with + * more buckets. */ if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) { @@ -412,28 +408,30 @@ TclRegisterLiteral(envPtr, bytes, length, flags) { LiteralEntry *entryPtr; int found, i; + found = 0; - for (i = 0; i < globalTablePtr->numBuckets; i++) { - for (entryPtr = globalTablePtr->buckets[i]; - entryPtr != NULL; entryPtr = entryPtr->nextPtr) { - if ((entryPtr == globalPtr) - && (entryPtr->objPtr == objPtr)) { + for (i=0 ; i<globalTablePtr->numBuckets ; i++) { + for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ; + entryPtr=entryPtr->nextPtr) { + if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) { found = 1; } } } if (!found) { Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global", - (length>60? 60 : length), bytes); + (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ -#ifdef TCL_COMPILE_STATS + +#ifdef TCL_COMPILE_STATS iPtr->stats.numLiteralsCreated++; - iPtr->stats.totalLitStringBytes += (double) (length + 1); + iPtr->stats.totalLitStringBytes += (double) (length + 1); iPtr->stats.currentLitStringBytes += (double) (length + 1); iPtr->stats.literalCount[TclLog2(length)]++; #endif /*TCL_COMPILE_STATS*/ + return objIndex; } @@ -443,24 +441,24 @@ TclRegisterLiteral(envPtr, bytes, length, flags) * TclLookupLiteralEntry -- * * Finds the LiteralEntry that corresponds to a literal Tcl object - * holding a literal. + * holding a literal. * * Results: - * Returns the matching LiteralEntry if found, otherwise NULL. + * Returns the matching LiteralEntry if found, otherwise NULL. * * Side effects: - * None. + * None. * *---------------------------------------------------------------------- */ LiteralEntry * TclLookupLiteralEntry(interp, objPtr) - Tcl_Interp *interp; /* Interpreter for which objPtr was created - * to hold a literal. */ - register Tcl_Obj *objPtr; /* Points to a Tcl object holding a - * literal that was previously created by a - * call to TclRegisterLiteral. */ + Tcl_Interp *interp; /* Interpreter for which objPtr was created to + * hold a literal. */ + register Tcl_Obj *objPtr; /* Points to a Tcl object holding a literal + * that was previously created by a call to + * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &(iPtr->literalTable); @@ -471,10 +469,10 @@ TclLookupLiteralEntry(interp, objPtr) bytes = Tcl_GetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr = globalTablePtr->buckets[globalHash]; - entryPtr != NULL; entryPtr = entryPtr->nextPtr) { - if (entryPtr->objPtr == objPtr) { - return entryPtr; - } + entryPtr != NULL; entryPtr = entryPtr->nextPtr) { + if (entryPtr->objPtr == objPtr) { + return entryPtr; + } } return NULL; } @@ -484,10 +482,10 @@ TclLookupLiteralEntry(interp, objPtr) * * TclHideLiteral -- * - * Remove a literal entry from the literal hash tables, leaving it in - * the literal array so existing references continue to function. - * This makes it possible to turn a shared literal into a private - * literal that cannot be shared. + * Remove a literal entry from the literal hash tables, leaving it in the + * literal array so existing references continue to function. This makes + * it possible to turn a shared literal into a private literal that + * cannot be shared. * * Results: * None. @@ -501,12 +499,12 @@ TclLookupLiteralEntry(interp, objPtr) void TclHideLiteral(interp, envPtr, index) - Tcl_Interp *interp; /* Interpreter for which objPtr was created - * to hold a literal. */ - register CompileEnv *envPtr; /* Points to CompileEnv whose literal array - * contains the entry being hidden. */ - int index; /* The index of the entry in the literal - * array. */ + Tcl_Interp *interp; /* Interpreter for which objPtr was created to + * hold a literal. */ + register CompileEnv *envPtr;/* Points to CompileEnv whose literal array + * contains the entry being hidden. */ + int index; /* The index of the entry in the literal + * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &(envPtr->localLitTable); @@ -518,9 +516,9 @@ TclHideLiteral(interp, envPtr, index) /* * To avoid unwanted sharing we need to copy the object and remove it from - * the local and global literal tables. It still has a slot in the literal - * array so it can be referred to by byte codes, but it will not be matched - * by literal searches. + * the local and global literal tables. It still has a slot in the + * literal array so it can be referred to by byte codes, but it will not + * be matched by literal searches. */ newObjPtr = Tcl_DuplicateObj(lPtr->objPtr); @@ -532,7 +530,7 @@ TclHideLiteral(interp, envPtr, index) localHash = (HashString(bytes, length) & localTablePtr->mask); nextPtrPtr = &localTablePtr->buckets[localHash]; - for (entryPtr = *nextPtrPtr; entryPtr != NULL; entryPtr = *nextPtrPtr) { + for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) { if (entryPtr == lPtr) { *nextPtrPtr = lPtr->nextPtr; lPtr->nextPtr = NULL; @@ -548,31 +546,30 @@ TclHideLiteral(interp, envPtr, index) * * TclAddLiteralObj -- * - * Add a single literal object to the literal array. This - * function does not add the literal to the local or global - * literal tables. The caller is expected to add the entry - * to whatever tables are appropriate. + * Add a single literal object to the literal array. This function does + * not add the literal to the local or global literal tables. The caller + * is expected to add the entry to whatever tables are appropriate. * * Results: * The index in the CompileEnv's literal array that references the - * literal. Stores the pointer to the new literal entry in the - * location referenced by the localPtrPtr argument. + * literal. Stores the pointer to the new literal entry in the location + * referenced by the localPtrPtr argument. * * Side effects: - * Expands the literal array if necessary. Increments the refcount - * on the literal object. + * Expands the literal array if necessary. Increments the refcount on the + * literal object. * *---------------------------------------------------------------------- */ int TclAddLiteralObj(envPtr, objPtr, litPtrPtr) - register CompileEnv *envPtr; /* Points to CompileEnv in whose literal - * array the object is to be inserted. */ - Tcl_Obj *objPtr; /* The object to insert into the array. */ - LiteralEntry **litPtrPtr; /* The location where the pointer to the - * new literal entry should be stored. - * May be NULL. */ + register CompileEnv *envPtr;/* Points to CompileEnv in whose literal array + * the object is to be inserted. */ + Tcl_Obj *objPtr; /* The object to insert into the array. */ + LiteralEntry **litPtrPtr; /* The location where the pointer to the new + * literal entry should be stored. May be + * NULL. */ { register LiteralEntry *lPtr; int objIndex; @@ -609,8 +606,8 @@ TclAddLiteralObj(envPtr, objPtr, litPtrPtr) * * Side effects: * Increments the ref count of the global LiteralEntry since the - * CompileEnv now refers to the literal. Expands the literal array - * if necessary. May rebuild the hash bucket array of the CompileEnv's + * CompileEnv now refers to the literal. Expands the literal array if + * necessary. May rebuild the hash bucket array of the CompileEnv's * literal array if it becomes too large. * *---------------------------------------------------------------------- @@ -618,16 +615,16 @@ TclAddLiteralObj(envPtr, objPtr, litPtrPtr) static int AddLocalLiteralEntry(envPtr, globalPtr, localHash) - register CompileEnv *envPtr; /* Points to CompileEnv in whose literal - * array the object is to be inserted. */ - LiteralEntry *globalPtr; /* Points to the global LiteralEntry for - * the literal to add to the CompileEnv. */ - int localHash; /* Hash value for the literal's string. */ + register CompileEnv *envPtr;/* Points to CompileEnv in whose literal array + * the object is to be inserted. */ + LiteralEntry *globalPtr; /* Points to the global LiteralEntry for the + * literal to add to the CompileEnv. */ + int localHash; /* Hash value for the literal's string. */ { register LiteralTable *localTablePtr = &(envPtr->localLitTable); LiteralEntry *localPtr; int objIndex; - + objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr); /* @@ -654,22 +651,25 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash) { char *bytes; int length, found, i; + found = 0; - for (i = 0; i < localTablePtr->numBuckets; i++) { - for (localPtr = localTablePtr->buckets[i]; - localPtr != NULL; localPtr = localPtr->nextPtr) { + for (i=0 ; i<localTablePtr->numBuckets ; i++) { + for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ; + localPtr=localPtr->nextPtr) { if (localPtr->objPtr == globalPtr->objPtr) { found = 1; } } } + if (!found) { bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally", - (length>60? 60 : length), bytes); + (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ + return objIndex; } @@ -678,30 +678,29 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash) * * ExpandLocalLiteralArray -- * - * Procedure that uses malloc to allocate more storage for a - * CompileEnv's local literal array. + * Procedure that uses malloc to allocate more storage for a CompileEnv's + * local literal array. * * Results: * None. * * Side effects: - * The literal array in *envPtr is reallocated to a new array of - * double the size, and if envPtr->mallocedLiteralArray is non-zero - * the old array is freed. Entries are copied from the old array - * to the new one. The local literal table is updated to refer to - * the new entries. + * The literal array in *envPtr is reallocated to a new array of double + * the size, and if envPtr->mallocedLiteralArray is non-zero the old + * array is freed. Entries are copied from the old array to the new one. + * The local literal table is updated to refer to the new entries. * *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray(envPtr) - register CompileEnv *envPtr; /* Points to the CompileEnv whose object - * array must be enlarged. */ + register CompileEnv *envPtr;/* Points to the CompileEnv whose object array + * must be enlarged. */ { /* - * The current allocated local literal entries are stored between - * elements 0 and (envPtr->literalArrayNext - 1) [inclusive]. + * The current allocated local literal entries are stored between elements + * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ LiteralTable *localTablePtr = &(envPtr->localLitTable); @@ -711,33 +710,33 @@ ExpandLocalLiteralArray(envPtr) register LiteralEntry *newArrayPtr = (LiteralEntry *) ckalloc((unsigned) (2 * currBytes)); int i; - + /* * Copy from the old literal array to the new, then update the local * literal table's bucket array. */ memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes); - for (i = 0; i < currElems; i++) { + for (i=0 ; i<currElems ; i++) { if (currArrayPtr[i].nextPtr == NULL) { newArrayPtr[i].nextPtr = NULL; } else { - newArrayPtr[i].nextPtr = newArrayPtr - + (currArrayPtr[i].nextPtr - currArrayPtr); + newArrayPtr[i].nextPtr = + newArrayPtr + (currArrayPtr[i].nextPtr - currArrayPtr); } } - for (i = 0; i < localTablePtr->numBuckets; i++) { + for (i=0 ; i<localTablePtr->numBuckets ; i++) { if (localTablePtr->buckets[i] != NULL) { - localTablePtr->buckets[i] = newArrayPtr - + (localTablePtr->buckets[i] - currArrayPtr); + localTablePtr->buckets[i] = + newArrayPtr + (localTablePtr->buckets[i] - currArrayPtr); } } /* - * Free the old literal array if needed, and mark the new literal - * array as malloced. + * Free the old literal array if needed, and mark the new literal array as + * malloced. */ - + if (envPtr->mallocedLiteralArray) { ckfree((char *) currArrayPtr); } @@ -752,25 +751,25 @@ ExpandLocalLiteralArray(envPtr) * TclReleaseLiteral -- * * This procedure releases a reference to one of the shared Tcl objects - * that hold literals. It is called to release the literals referenced - * by a ByteCode that is being destroyed, and it is also called by + * that hold literals. It is called to release the literals referenced by + * a ByteCode that is being destroyed, and it is also called by * TclDeleteLiteralTable. * * Results: * None. * * Side effects: - * The reference count for the global LiteralTable entry that - * corresponds to the literal is decremented. If no other reference - * to a global literal object remains, it is freed. + * The reference count for the global LiteralTable entry that corresponds + * to the literal is decremented. If no other reference to a global + * literal object remains, it is freed. * *---------------------------------------------------------------------- */ void TclReleaseLiteral(interp, objPtr) - Tcl_Interp *interp; /* Interpreter for which objPtr was created - * to hold a literal. */ + Tcl_Interp *interp; /* Interpreter for which objPtr was created to + * hold a literal. */ register Tcl_Obj *objPtr; /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ @@ -785,9 +784,9 @@ TclReleaseLiteral(interp, objPtr) index = (HashString(bytes, length) & globalTablePtr->mask); /* - * Check to see if the object is in the global literal table and - * remove this reference. The object may not be in the table if - * it is a hidden local literal. + * Check to see if the object is in the global literal table and remove + * this reference. The object may not be in the table if it is a hidden + * local literal. */ for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index]; @@ -797,12 +796,11 @@ TclReleaseLiteral(interp, objPtr) entryPtr->refCount--; /* - * If the literal is no longer being used by any ByteCode, - * delete the entry then remove the reference corresponding - * to the global literal table entry (decrement the ref count - * of the object). + * If the literal is no longer being used by any ByteCode, delete + * the entry then remove the reference corresponding to the global + * literal table entry (decrement the ref count of the object). */ - + if (entryPtr->refCount == 0) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; @@ -823,8 +821,7 @@ TclReleaseLiteral(interp, objPtr) } /* - * Remove the reference corresponding to the local literal table - * entry. + * Remove the reference corresponding to the local literal table entry. */ Tcl_DecrRefCount(objPtr); @@ -835,12 +832,11 @@ TclReleaseLiteral(interp, objPtr) * * HashString -- * - * Compute a one-word summary of a text string, which can be - * used to generate a hash index. + * Compute a one-word summary of a text string, which can be used to + * generate a hash index. * * Results: - * The return value is a one-word summary of the information in - * string. + * The return value is a one-word summary of the information in string. * * Side effects: * None. @@ -850,27 +846,26 @@ TclReleaseLiteral(interp, objPtr) static unsigned int HashString(bytes, length) - register CONST char *bytes; /* String for which to compute hash - * value. */ + register CONST char *bytes; /* String for which to compute hash value. */ int length; /* Number of bytes in the string. */ { register unsigned int result; register int i; /* - * I tried a zillion different hash functions and asked many other - * people for advice. Many people had their own favorite functions, - * all different, but no-one had much idea why they were good ones. - * I chose the one below (multiply by 9 and add new character) - * because of the following reasons: + * I tried a zillion different hash functions and asked many other people + * for advice. Many people had their own favorite functions, all + * different, but no-one had much idea why they were good ones. I chose + * the one below (multiply by 9 and add new character) because of the + * following reasons: * - * 1. Multiplying by 10 is perfect for keys that are decimal strings, - * and multiplying by 9 is just about as good. + * 1. Multiplying by 10 is perfect for keys that are decimal strings, and + * multiplying by 9 is just about as good. * 2. Times-9 is (shift-left-3) plus (old). This means that each - * character's bits hang around in the low-order bits of the - * hash value for ever, plus they spread fairly rapidly up to - * the high-order bits to fill out the hash value. This seems - * works well both for decimal and non-decimal strings. + * character's bits hang around in the low-order bits of the hash value + * for ever, plus they spread fairly rapidly up to the high-order bits + * to fill out the hash value. This seems works well both for decimal + * and non-decimal strings. */ result = 0; @@ -886,8 +881,8 @@ HashString(bytes, length) * RebuildLiteralTable -- * * This procedure is invoked when the ratio of entries to hash buckets - * becomes too large in a local or global literal table. It allocates - * a larger bucket array and moves the entries into the new buckets. + * becomes too large in a local or global literal table. It allocates a + * larger bucket array and moves the entries into the new buckets. * * Results: * None. @@ -900,7 +895,8 @@ HashString(bytes, length) static void RebuildLiteralTable(tablePtr) - register LiteralTable *tablePtr; /* Local or global table to enlarge. */ + register LiteralTable *tablePtr; + /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; register LiteralEntry **oldChainPtr, **newChainPtr; @@ -913,8 +909,8 @@ RebuildLiteralTable(tablePtr) oldBuckets = tablePtr->buckets; /* - * Allocate and initialize the new bucket array, and set up - * hashing constants for new array size. + * Allocate and initialize the new bucket array, and set up hashing + * constants for new array size. */ tablePtr->numBuckets *= 4; @@ -932,14 +928,11 @@ RebuildLiteralTable(tablePtr) * Rehash all of the existing entries into the new bucket array. */ - for (oldChainPtr = oldBuckets; - oldSize > 0; - oldSize--, oldChainPtr++) { - for (entryPtr = *oldChainPtr; entryPtr != NULL; - entryPtr = *oldChainPtr) { + for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { + for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length); index = (HashString(bytes, length) & tablePtr->mask); - + *oldChainPtr = entryPtr->nextPtr; bucketPtr = &(tablePtr->buckets[index]); entryPtr->nextPtr = *bucketPtr; @@ -962,13 +955,12 @@ RebuildLiteralTable(tablePtr) * * TclLiteralStats -- * - * Return statistics describing the layout of the hash table - * in its hash buckets. + * Return statistics describing the layout of the hash table in its hash + * buckets. * * Results: - * The return value is a malloc-ed string containing information - * about tablePtr. It is the caller's responsibility to free - * this string. + * The return value is a malloc-ed string containing information about + * tablePtr. It is the caller's responsibility to free this string. * * Side effects: * None. @@ -987,8 +979,8 @@ TclLiteralStats(tablePtr) char *result, *p; /* - * Compute a histogram of bucket usage. For each bucket chain i, - * j is the number of entries in the chain. + * Compute a histogram of bucket usage. For each bucket chain i, j is the + * number of entries in the chain. */ for (i = 0; i < NUM_COUNTERS; i++) { @@ -999,7 +991,7 @@ TclLiteralStats(tablePtr) for (i = 0; i < tablePtr->numBuckets; i++) { j = 0; for (entryPtr = tablePtr->buckets[i]; entryPtr != NULL; - entryPtr = entryPtr->nextPtr) { + entryPtr = entryPtr->nextPtr) { j++; } if (j < NUM_COUNTERS) { @@ -1051,8 +1043,8 @@ TclLiteralStats(tablePtr) void TclVerifyLocalLiteralTable(envPtr) - CompileEnv *envPtr; /* Points to CompileEnv whose literal - * table is to be validated. */ + CompileEnv *envPtr; /* Points to CompileEnv whose literal table is + * to be validated. */ { register LiteralTable *localTablePtr = &(envPtr->localLitTable); register LiteralEntry *localPtr; @@ -1063,19 +1055,18 @@ TclVerifyLocalLiteralTable(envPtr) count = 0; for (i = 0; i < localTablePtr->numBuckets; i++) { for (localPtr = localTablePtr->buckets[i]; - localPtr != NULL; localPtr = localPtr->nextPtr) { + localPtr != NULL; localPtr = localPtr->nextPtr) { count++; if (localPtr->refCount != -1) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d", - (length>60? 60 : length), bytes, - localPtr->refCount); + (length>60? 60 : length), bytes, localPtr->refCount); } if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, localPtr->objPtr) == NULL) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global", - (length>60? 60 : length), bytes); + (length>60? 60 : length), bytes); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep"); @@ -1084,7 +1075,7 @@ TclVerifyLocalLiteralTable(envPtr) } if (count != localTablePtr->numEntries) { Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d", - count, localTablePtr->numEntries); + count, localTablePtr->numEntries); } } @@ -1106,8 +1097,8 @@ TclVerifyLocalLiteralTable(envPtr) void TclVerifyGlobalLiteralTable(iPtr) - Interp *iPtr; /* Points to interpreter whose global - * literal table is to be validated. */ + Interp *iPtr; /* Points to interpreter whose global literal + * table is to be validated. */ { register LiteralTable *globalTablePtr = &(iPtr->literalTable); register LiteralEntry *globalPtr; @@ -1118,13 +1109,12 @@ TclVerifyGlobalLiteralTable(iPtr) count = 0; for (i = 0; i < globalTablePtr->numBuckets; i++) { for (globalPtr = globalTablePtr->buckets[i]; - globalPtr != NULL; globalPtr = globalPtr->nextPtr) { + globalPtr != NULL; globalPtr = globalPtr->nextPtr) { count++; if (globalPtr->refCount < 1) { bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); Tcl_Panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d", - (length>60? 60 : length), bytes, - globalPtr->refCount); + (length>60? 60 : length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("TclVerifyGlobalLiteralTable: literal has NULL string rep"); @@ -1133,7 +1123,15 @@ TclVerifyGlobalLiteralTable(iPtr) } if (count != globalTablePtr->numEntries) { Tcl_Panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d", - count, globalTablePtr->numEntries); + count, globalTablePtr->numEntries); } } #endif /*TCL_COMPILE_DEBUG*/ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |