summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclListObj.c634
-rw-r--r--generic/tclLiteral.c500
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:
+ */