/*
|
/*
|
* tclListObj.c --
|
* tclListObj.c --
|
*
|
*
|
* This file contains procedures that implement the Tcl list object
|
* This file contains procedures that implement the Tcl list object
|
* type.
|
* type.
|
*
|
*
|
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
|
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
|
* Copyright (c) 1998 by Scriptics Corporation.
|
* Copyright (c) 1998 by Scriptics Corporation.
|
*
|
*
|
* See the file "license.terms" for information on usage and redistribution
|
* See the file "license.terms" for information on usage and redistribution
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
*
|
*
|
* RCS: @(#) $Id: tclListObj.c,v 1.1.1.1 2002-01-16 10:25:28 markom Exp $
|
* RCS: @(#) $Id: tclListObj.c,v 1.1.1.1 2002-01-16 10:25:28 markom Exp $
|
*/
|
*/
|
|
|
#include "tclInt.h"
|
#include "tclInt.h"
|
|
|
/*
|
/*
|
* Prototypes for procedures defined later in this file:
|
* Prototypes for procedures defined later in this file:
|
*/
|
*/
|
|
|
static void DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
|
static void DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
|
Tcl_Obj *copyPtr));
|
Tcl_Obj *copyPtr));
|
static void FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
|
static void FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
|
static int SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
|
static int SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
|
Tcl_Obj *objPtr));
|
Tcl_Obj *objPtr));
|
static void UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
|
static void UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
|
|
|
/*
|
/*
|
* The structure below defines the list Tcl object type by means of
|
* The structure below defines the list Tcl object type by means of
|
* procedures that can be invoked by generic object code.
|
* procedures that can be invoked by generic object code.
|
*/
|
*/
|
|
|
Tcl_ObjType tclListType = {
|
Tcl_ObjType tclListType = {
|
"list", /* name */
|
"list", /* name */
|
FreeListInternalRep, /* freeIntRepProc */
|
FreeListInternalRep, /* freeIntRepProc */
|
DupListInternalRep, /* dupIntRepProc */
|
DupListInternalRep, /* dupIntRepProc */
|
UpdateStringOfList, /* updateStringProc */
|
UpdateStringOfList, /* updateStringProc */
|
SetListFromAny /* setFromAnyProc */
|
SetListFromAny /* setFromAnyProc */
|
};
|
};
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_NewListObj --
|
* Tcl_NewListObj --
|
*
|
*
|
* This procedure is normally called when not debugging: i.e., when
|
* This procedure is normally called when not debugging: i.e., when
|
* TCL_MEM_DEBUG is not defined. It creates a new list object from an
|
* 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
|
* (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.
|
* referenced by objv is inserted as an element into a new Tcl object.
|
*
|
*
|
* When TCL_MEM_DEBUG is defined, this procedure just returns the
|
* When TCL_MEM_DEBUG is defined, this procedure just returns the
|
* result of calling the debugging version Tcl_DbNewListObj.
|
* result of calling the debugging version Tcl_DbNewListObj.
|
*
|
*
|
* Results:
|
* Results:
|
* A new list object is returned that is initialized from the object
|
* 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
|
* pointers in objv. If objc is less than or equal to zero, an empty
|
* object is returned. The new object's string representation
|
* object is returned. The new object's string representation
|
* is left NULL. The resulting new list object has ref count 0.
|
* is left NULL. The resulting new list object has ref count 0.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The ref counts of the elements in objv are incremented since the
|
* The ref counts of the elements in objv are incremented since the
|
* resulting list now refers to them.
|
* resulting list now refers to them.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
#ifdef TCL_MEM_DEBUG
|
#ifdef TCL_MEM_DEBUG
|
#undef Tcl_NewListObj
|
#undef Tcl_NewListObj
|
|
|
Tcl_Obj *
|
Tcl_Obj *
|
Tcl_NewListObj(objc, objv)
|
Tcl_NewListObj(objc, objv)
|
int objc; /* Count of objects referenced by objv. */
|
int objc; /* Count of objects referenced by objv. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
{
|
{
|
return Tcl_DbNewListObj(objc, objv, "unknown", 0);
|
return Tcl_DbNewListObj(objc, objv, "unknown", 0);
|
}
|
}
|
|
|
#else /* if not TCL_MEM_DEBUG */
|
#else /* if not TCL_MEM_DEBUG */
|
|
|
Tcl_Obj *
|
Tcl_Obj *
|
Tcl_NewListObj(objc, objv)
|
Tcl_NewListObj(objc, objv)
|
int objc; /* Count of objects referenced by objv. */
|
int objc; /* Count of objects referenced by objv. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
{
|
{
|
register Tcl_Obj *listPtr;
|
register Tcl_Obj *listPtr;
|
register Tcl_Obj **elemPtrs;
|
register Tcl_Obj **elemPtrs;
|
register List *listRepPtr;
|
register List *listRepPtr;
|
int i;
|
int i;
|
|
|
TclNewObj(listPtr);
|
TclNewObj(listPtr);
|
|
|
if (objc > 0) {
|
if (objc > 0) {
|
Tcl_InvalidateStringRep(listPtr);
|
Tcl_InvalidateStringRep(listPtr);
|
|
|
elemPtrs = (Tcl_Obj **)
|
elemPtrs = (Tcl_Obj **)
|
ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
|
ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
|
for (i = 0; i < objc; i++) {
|
for (i = 0; i < objc; i++) {
|
elemPtrs[i] = objv[i];
|
elemPtrs[i] = objv[i];
|
Tcl_IncrRefCount(elemPtrs[i]);
|
Tcl_IncrRefCount(elemPtrs[i]);
|
}
|
}
|
|
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr->maxElemCount = objc;
|
listRepPtr->maxElemCount = objc;
|
listRepPtr->elemCount = objc;
|
listRepPtr->elemCount = objc;
|
listRepPtr->elements = elemPtrs;
|
listRepPtr->elements = elemPtrs;
|
|
|
listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
listPtr->typePtr = &tclListType;
|
listPtr->typePtr = &tclListType;
|
}
|
}
|
return listPtr;
|
return listPtr;
|
}
|
}
|
#endif /* if TCL_MEM_DEBUG */
|
#endif /* if TCL_MEM_DEBUG */
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_DbNewListObj --
|
* Tcl_DbNewListObj --
|
*
|
*
|
* This procedure is normally called when debugging: i.e., when
|
* This procedure is normally called when debugging: i.e., when
|
* TCL_MEM_DEBUG is defined. It creates new list objects. It is the
|
* TCL_MEM_DEBUG is defined. It creates new list objects. It is the
|
* same as the Tcl_NewListObj procedure above except that it calls
|
* same as the Tcl_NewListObj procedure above except that it calls
|
* Tcl_DbCkalloc directly with the file name and line number from its
|
* Tcl_DbCkalloc directly with the file name and line number from its
|
* caller. This simplifies debugging since then the checkmem command
|
* caller. This simplifies debugging since then the checkmem command
|
* will report the correct file name and line number when reporting
|
* will report the correct file name and line number when reporting
|
* objects that haven't been freed.
|
* 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 procedure just returns the
|
* result of calling Tcl_NewListObj.
|
* result of calling Tcl_NewListObj.
|
*
|
*
|
* Results:
|
* Results:
|
* A new list object is returned that is initialized from the object
|
* 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
|
* pointers in objv. If objc is less than or equal to zero, an empty
|
* object is returned. The new object's string representation
|
* object is returned. The new object's string representation
|
* is left NULL. The new list object has ref count 0.
|
* is left NULL. The new list object has ref count 0.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The ref counts of the elements in objv are incremented since the
|
* The ref counts of the elements in objv are incremented since the
|
* resulting list now refers to them.
|
* resulting list now refers to them.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
#ifdef TCL_MEM_DEBUG
|
#ifdef TCL_MEM_DEBUG
|
|
|
Tcl_Obj *
|
Tcl_Obj *
|
Tcl_DbNewListObj(objc, objv, file, line)
|
Tcl_DbNewListObj(objc, objv, file, line)
|
int objc; /* Count of objects referenced by objv. */
|
int objc; /* Count of objects referenced by objv. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
char *file; /* The name of the source file calling this
|
char *file; /* The name of the source file calling this
|
* procedure; used for debugging. */
|
* procedure; used for debugging. */
|
int line; /* Line number in the source file; used
|
int line; /* Line number in the source file; used
|
* for debugging. */
|
* for debugging. */
|
{
|
{
|
register Tcl_Obj *listPtr;
|
register Tcl_Obj *listPtr;
|
register Tcl_Obj **elemPtrs;
|
register Tcl_Obj **elemPtrs;
|
register List *listRepPtr;
|
register List *listRepPtr;
|
int i;
|
int i;
|
|
|
TclDbNewObj(listPtr, file, line);
|
TclDbNewObj(listPtr, file, line);
|
|
|
if (objc > 0) {
|
if (objc > 0) {
|
Tcl_InvalidateStringRep(listPtr);
|
Tcl_InvalidateStringRep(listPtr);
|
|
|
elemPtrs = (Tcl_Obj **)
|
elemPtrs = (Tcl_Obj **)
|
ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
|
ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
|
for (i = 0; i < objc; i++) {
|
for (i = 0; i < objc; i++) {
|
elemPtrs[i] = objv[i];
|
elemPtrs[i] = objv[i];
|
Tcl_IncrRefCount(elemPtrs[i]);
|
Tcl_IncrRefCount(elemPtrs[i]);
|
}
|
}
|
|
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr->maxElemCount = objc;
|
listRepPtr->maxElemCount = objc;
|
listRepPtr->elemCount = objc;
|
listRepPtr->elemCount = objc;
|
listRepPtr->elements = elemPtrs;
|
listRepPtr->elements = elemPtrs;
|
|
|
listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
listPtr->typePtr = &tclListType;
|
listPtr->typePtr = &tclListType;
|
}
|
}
|
return listPtr;
|
return listPtr;
|
}
|
}
|
|
|
#else /* if not TCL_MEM_DEBUG */
|
#else /* if not TCL_MEM_DEBUG */
|
|
|
Tcl_Obj *
|
Tcl_Obj *
|
Tcl_DbNewListObj(objc, objv, file, line)
|
Tcl_DbNewListObj(objc, objv, file, line)
|
int objc; /* Count of objects referenced by objv. */
|
int objc; /* Count of objects referenced by objv. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
char *file; /* The name of the source file calling this
|
char *file; /* The name of the source file calling this
|
* procedure; used for debugging. */
|
* procedure; used for debugging. */
|
int line; /* Line number in the source file; used
|
int line; /* Line number in the source file; used
|
* for debugging. */
|
* for debugging. */
|
{
|
{
|
return Tcl_NewListObj(objc, objv);
|
return Tcl_NewListObj(objc, objv);
|
}
|
}
|
#endif /* TCL_MEM_DEBUG */
|
#endif /* TCL_MEM_DEBUG */
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_SetListObj --
|
* Tcl_SetListObj --
|
*
|
*
|
* Modify an object to be a list containing each of the objc elements
|
* Modify an object to be a list containing each of the objc elements
|
* of the object array referenced by objv.
|
* of the object array referenced by objv.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The object is made a list object and is initialized from the object
|
* 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
|
* pointers in objv. If objc is less than or equal to zero, an empty
|
* object is returned. The new object's string representation
|
* object is returned. The new object's string representation
|
* is left NULL. The ref counts of the elements in objv are incremented
|
* 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
|
* since the list now refers to them. The object's old string and
|
* internal representations are freed and its type is set NULL.
|
* internal representations are freed and its type is set NULL.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
void
|
void
|
Tcl_SetListObj(objPtr, objc, objv)
|
Tcl_SetListObj(objPtr, objc, objv)
|
Tcl_Obj *objPtr; /* Object whose internal rep to init. */
|
Tcl_Obj *objPtr; /* Object whose internal rep to init. */
|
int objc; /* Count of objects referenced by objv. */
|
int objc; /* Count of objects referenced by objv. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
Tcl_Obj *CONST objv[]; /* An array of pointers to Tcl objects. */
|
{
|
{
|
register Tcl_Obj **elemPtrs;
|
register Tcl_Obj **elemPtrs;
|
register List *listRepPtr;
|
register List *listRepPtr;
|
Tcl_ObjType *oldTypePtr = objPtr->typePtr;
|
Tcl_ObjType *oldTypePtr = objPtr->typePtr;
|
int i;
|
int i;
|
|
|
if (Tcl_IsShared(objPtr)) {
|
if (Tcl_IsShared(objPtr)) {
|
panic("Tcl_SetListObj called with shared object");
|
panic("Tcl_SetListObj called with shared object");
|
}
|
}
|
|
|
/*
|
/*
|
* Free any old string rep and any internal rep for the old type.
|
* Free any old string rep and any internal rep for the old type.
|
*/
|
*/
|
|
|
Tcl_InvalidateStringRep(objPtr);
|
Tcl_InvalidateStringRep(objPtr);
|
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
|
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
|
oldTypePtr->freeIntRepProc(objPtr);
|
oldTypePtr->freeIntRepProc(objPtr);
|
}
|
}
|
objPtr->typePtr = NULL;
|
objPtr->typePtr = NULL;
|
|
|
/*
|
/*
|
* Set the object's type to "list" and initialize the internal rep.
|
* Set the object's type to "list" and initialize the internal rep.
|
*/
|
*/
|
|
|
if (objc > 0) {
|
if (objc > 0) {
|
elemPtrs = (Tcl_Obj **)
|
elemPtrs = (Tcl_Obj **)
|
ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
|
ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
|
for (i = 0; i < objc; i++) {
|
for (i = 0; i < objc; i++) {
|
elemPtrs[i] = objv[i];
|
elemPtrs[i] = objv[i];
|
Tcl_IncrRefCount(elemPtrs[i]);
|
Tcl_IncrRefCount(elemPtrs[i]);
|
}
|
}
|
|
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr->maxElemCount = objc;
|
listRepPtr->maxElemCount = objc;
|
listRepPtr->elemCount = objc;
|
listRepPtr->elemCount = objc;
|
listRepPtr->elements = elemPtrs;
|
listRepPtr->elements = elemPtrs;
|
|
|
objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
objPtr->typePtr = &tclListType;
|
objPtr->typePtr = &tclListType;
|
} else {
|
} else {
|
objPtr->bytes = tclEmptyStringRep;
|
objPtr->bytes = tclEmptyStringRep;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_ListObjGetElements --
|
* Tcl_ListObjGetElements --
|
*
|
*
|
* This procedure returns an (objc,objv) array of the elements in a
|
* This procedure returns an (objc,objv) array of the elements in a
|
* list object.
|
* list object.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case *objcPtr is set to
|
* 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
|
* 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
|
* 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
|
* 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
|
* one, TCL_ERROR is returned and an error message will be left in
|
* the interpreter's result if interp is not NULL.
|
* the interpreter's result if interp is not NULL.
|
*
|
*
|
* The objects referenced by the returned array should be treated as
|
* The objects referenced by the returned array should be treated as
|
* readonly and their ref counts are _not_ incremented; the caller must
|
* readonly and their ref counts are _not_ incremented; the caller must
|
* do that if it holds on to a reference. Furthermore, the pointer
|
* do that if it holds on to a reference. Furthermore, the pointer
|
* and length returned by this procedure may change as soon as any
|
* and length returned by this procedure may change as soon as any
|
* procedure is called on the list object; be careful about retaining
|
* procedure is called on the list object; be careful about retaining
|
* the pointer in a local data structure.
|
* the pointer in a local data structure.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The possible conversion of the object referenced by listPtr
|
* The possible conversion of the object referenced by listPtr
|
* to a list object.
|
* to a list object.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
|
Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
register Tcl_Obj *listPtr; /* List object for which an element array
|
register Tcl_Obj *listPtr; /* List object for which an element array
|
* is to be returned. */
|
* is to be returned. */
|
int *objcPtr; /* Where to store the count of objects
|
int *objcPtr; /* Where to store the count of objects
|
* referenced by objv. */
|
* referenced by objv. */
|
Tcl_Obj ***objvPtr; /* Where to store the pointer to an array
|
Tcl_Obj ***objvPtr; /* Where to store the pointer to an array
|
* of pointers to the list's objects. */
|
* of pointers to the list's objects. */
|
{
|
{
|
register List *listRepPtr;
|
register List *listRepPtr;
|
|
|
if (listPtr->typePtr != &tclListType) {
|
if (listPtr->typePtr != &tclListType) {
|
int result = SetListFromAny(interp, listPtr);
|
int result = SetListFromAny(interp, listPtr);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
}
|
}
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
*objcPtr = listRepPtr->elemCount;
|
*objcPtr = listRepPtr->elemCount;
|
*objvPtr = listRepPtr->elements;
|
*objvPtr = listRepPtr->elements;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_ListObjAppendList --
|
* Tcl_ListObjAppendList --
|
*
|
*
|
* This procedure appends the objects in the list referenced by
|
* This procedure appends the objects in the list referenced by
|
* elemListPtr to the list object referenced by listPtr. If listPtr is
|
* 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
|
* not already a list object, an attempt will be made to convert it to
|
* one.
|
* one.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK. If listPtr or elemListPtr do
|
* 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,
|
* not refer to list objects and they can not be converted to one,
|
* TCL_ERROR is returned and an error message is left in
|
* TCL_ERROR is returned and an error message is left in
|
* the interpreter's result if interp is not NULL.
|
* the interpreter's result if interp is not NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The reference counts of the elements in elemListPtr are incremented
|
* The reference counts of the elements in elemListPtr are incremented
|
* since the list now refers to them. listPtr and elemListPtr are
|
* since the list now refers to them. listPtr and elemListPtr are
|
* converted, if necessary, to list objects. Also, appending the
|
* converted, if necessary, to list objects. Also, appending the
|
* new elements may cause listObj's array of element pointers to grow.
|
* new elements may cause listObj's array of element pointers to grow.
|
* listPtr's old string representation, if any, is invalidated.
|
* listPtr's old string representation, if any, is invalidated.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
|
Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
register Tcl_Obj *listPtr; /* List object to append elements to. */
|
register Tcl_Obj *listPtr; /* List object to append elements to. */
|
Tcl_Obj *elemListPtr; /* List obj with elements to append. */
|
Tcl_Obj *elemListPtr; /* List obj with elements to append. */
|
{
|
{
|
register List *listRepPtr;
|
register List *listRepPtr;
|
int listLen, objc, result;
|
int listLen, objc, result;
|
Tcl_Obj **objv;
|
Tcl_Obj **objv;
|
|
|
if (Tcl_IsShared(listPtr)) {
|
if (Tcl_IsShared(listPtr)) {
|
panic("Tcl_ListObjAppendList called with shared object");
|
panic("Tcl_ListObjAppendList called with shared object");
|
}
|
}
|
if (listPtr->typePtr != &tclListType) {
|
if (listPtr->typePtr != &tclListType) {
|
result = SetListFromAny(interp, listPtr);
|
result = SetListFromAny(interp, listPtr);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
}
|
}
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
listLen = listRepPtr->elemCount;
|
listLen = listRepPtr->elemCount;
|
|
|
result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
|
result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
|
|
/*
|
/*
|
* Insert objc new elements starting after the lists's last element.
|
* Insert objc new elements starting after the lists's last element.
|
* Delete zero existing elements.
|
* Delete zero existing elements.
|
*/
|
*/
|
|
|
return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
|
return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_ListObjAppendElement --
|
* Tcl_ListObjAppendElement --
|
*
|
*
|
* This procedure is a special purpose version of
|
* This procedure is a special purpose version of
|
* Tcl_ListObjAppendList: it appends a single object referenced by
|
* Tcl_ListObjAppendList: it appends a single object referenced by
|
* objPtr to the list object referenced by listPtr. If listPtr is not
|
* 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.
|
* already a list object, an attempt will be made to convert it to one.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case objPtr is added
|
* 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
|
* 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
|
* 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
|
* returned and an error message will be left in the interpreter's
|
* result if interp is not NULL.
|
* result if interp is not NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The ref count of objPtr is incremented since the list now refers
|
* The ref count of objPtr is incremented since the list now refers
|
* to it. listPtr will be converted, if necessary, to a list object.
|
* to it. listPtr will be converted, if necessary, to a list object.
|
* Also, appending the new element may cause listObj's array of element
|
* Also, appending the new element may cause listObj's array of element
|
* pointers to grow. listPtr's old string representation, if any,
|
* pointers to grow. listPtr's old string representation, if any,
|
* is invalidated.
|
* is invalidated.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_ListObjAppendElement(interp, listPtr, objPtr)
|
Tcl_ListObjAppendElement(interp, listPtr, objPtr)
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
Tcl_Obj *listPtr; /* List object to append objPtr to. */
|
Tcl_Obj *listPtr; /* List object to append objPtr to. */
|
Tcl_Obj *objPtr; /* Object to append to listPtr's list. */
|
Tcl_Obj *objPtr; /* Object to append to listPtr's list. */
|
{
|
{
|
register List *listRepPtr;
|
register List *listRepPtr;
|
register Tcl_Obj **elemPtrs;
|
register Tcl_Obj **elemPtrs;
|
int numElems, numRequired;
|
int numElems, numRequired;
|
|
|
if (Tcl_IsShared(listPtr)) {
|
if (Tcl_IsShared(listPtr)) {
|
panic("Tcl_ListObjAppendElement called with shared object");
|
panic("Tcl_ListObjAppendElement called with shared object");
|
}
|
}
|
if (listPtr->typePtr != &tclListType) {
|
if (listPtr->typePtr != &tclListType) {
|
int result = SetListFromAny(interp, listPtr);
|
int result = SetListFromAny(interp, listPtr);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
}
|
}
|
|
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
elemPtrs = listRepPtr->elements;
|
elemPtrs = listRepPtr->elements;
|
numElems = listRepPtr->elemCount;
|
numElems = listRepPtr->elemCount;
|
numRequired = numElems + 1 ;
|
numRequired = numElems + 1 ;
|
|
|
/*
|
/*
|
* If there is no room in the current array of element pointers,
|
* If there is no room in the current array of element pointers,
|
* allocate a new, larger array and copy the pointers to it.
|
* allocate a new, larger array and copy the pointers to it.
|
*/
|
*/
|
|
|
if (numRequired > listRepPtr->maxElemCount) {
|
if (numRequired > listRepPtr->maxElemCount) {
|
int newMax = (2 * numRequired);
|
int newMax = (2 * numRequired);
|
Tcl_Obj **newElemPtrs = (Tcl_Obj **)
|
Tcl_Obj **newElemPtrs = (Tcl_Obj **)
|
ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
|
ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
|
|
|
memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
|
memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
|
(size_t) (numElems * sizeof(Tcl_Obj *)));
|
(size_t) (numElems * sizeof(Tcl_Obj *)));
|
|
|
listRepPtr->maxElemCount = newMax;
|
listRepPtr->maxElemCount = newMax;
|
listRepPtr->elements = newElemPtrs;
|
listRepPtr->elements = newElemPtrs;
|
ckfree((char *) elemPtrs);
|
ckfree((char *) elemPtrs);
|
elemPtrs = newElemPtrs;
|
elemPtrs = newElemPtrs;
|
}
|
}
|
|
|
/*
|
/*
|
* Add objPtr to the end of listPtr's array of element
|
* Add objPtr to the end of listPtr's array of element
|
* pointers. Increment the ref count for the (now shared) objPtr.
|
* pointers. Increment the ref count for the (now shared) objPtr.
|
*/
|
*/
|
|
|
elemPtrs[numElems] = objPtr;
|
elemPtrs[numElems] = objPtr;
|
Tcl_IncrRefCount(objPtr);
|
Tcl_IncrRefCount(objPtr);
|
listRepPtr->elemCount++;
|
listRepPtr->elemCount++;
|
|
|
/*
|
/*
|
* Invalidate any old string representation since the list's internal
|
* Invalidate any old string representation since the list's internal
|
* representation has changed.
|
* representation has changed.
|
*/
|
*/
|
|
|
Tcl_InvalidateStringRep(listPtr);
|
Tcl_InvalidateStringRep(listPtr);
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_ListObjIndex --
|
* Tcl_ListObjIndex --
|
*
|
*
|
* This procedure returns a pointer to the index'th object from the
|
* This procedure returns a pointer to the index'th object from the
|
* list referenced by listPtr. The first element has index 0. If index
|
* 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
|
* 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
|
* the list, a NULL is returned. If listPtr is not a list object, an
|
* attempt will be made to convert it to a list.
|
* attempt will be made to convert it to a list.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case objPtrPtr is set
|
* 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
|
* 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
|
* 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
|
* 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
|
* 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
|
* 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.
|
* message is left in the interpreter's result if interp is not NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* listPtr will be converted, if necessary, to a list object.
|
* listPtr will be converted, if necessary, to a list object.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
|
Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
register Tcl_Obj *listPtr; /* List object to index into. */
|
register Tcl_Obj *listPtr; /* List object to index into. */
|
register int index; /* Index of element to return. */
|
register int index; /* Index of element to return. */
|
Tcl_Obj **objPtrPtr; /* The resulting Tcl_Obj* is stored here. */
|
Tcl_Obj **objPtrPtr; /* The resulting Tcl_Obj* is stored here. */
|
{
|
{
|
register List *listRepPtr;
|
register List *listRepPtr;
|
|
|
if (listPtr->typePtr != &tclListType) {
|
if (listPtr->typePtr != &tclListType) {
|
int result = SetListFromAny(interp, listPtr);
|
int result = SetListFromAny(interp, listPtr);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
}
|
}
|
|
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
if ((index < 0) || (index >= listRepPtr->elemCount)) {
|
if ((index < 0) || (index >= listRepPtr->elemCount)) {
|
*objPtrPtr = NULL;
|
*objPtrPtr = NULL;
|
} else {
|
} else {
|
*objPtrPtr = listRepPtr->elements[index];
|
*objPtrPtr = listRepPtr->elements[index];
|
}
|
}
|
|
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_ListObjLength --
|
* Tcl_ListObjLength --
|
*
|
*
|
* This procedure returns the number of elements in a list object. If
|
* 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
|
* the object is not already a list object, an attempt will be made to
|
* convert it to one.
|
* convert it to one.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case *intPtr will be
|
* 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
|
* 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,
|
* 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
|
* TCL_ERROR is returned and an error message will be left in
|
* the interpreter's result if interp is not NULL.
|
* the interpreter's result if interp is not NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The possible conversion of the argument object to a list object.
|
* The possible conversion of the argument object to a list object.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_ListObjLength(interp, listPtr, intPtr)
|
Tcl_ListObjLength(interp, listPtr, intPtr)
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
Tcl_Interp *interp; /* Used to report errors if not NULL. */
|
register Tcl_Obj *listPtr; /* List object whose #elements to return. */
|
register Tcl_Obj *listPtr; /* List object whose #elements to return. */
|
register int *intPtr; /* The resulting int is stored here. */
|
register int *intPtr; /* The resulting int is stored here. */
|
{
|
{
|
register List *listRepPtr;
|
register List *listRepPtr;
|
|
|
if (listPtr->typePtr != &tclListType) {
|
if (listPtr->typePtr != &tclListType) {
|
int result = SetListFromAny(interp, listPtr);
|
int result = SetListFromAny(interp, listPtr);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
}
|
}
|
|
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
*intPtr = listRepPtr->elemCount;
|
*intPtr = listRepPtr->elemCount;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_ListObjReplace --
|
* Tcl_ListObjReplace --
|
*
|
*
|
* This procedure replaces zero or more elements of the list referenced
|
* This procedure replaces zero or more elements of the list referenced
|
* by listPtr with the objects from an (objc,objv) array.
|
* by listPtr with the objects from an (objc,objv) array.
|
* The objc elements of the array referenced by objv replace the
|
* The objc elements of the array referenced by objv replace the
|
* count elements in listPtr starting at first.
|
* count elements in listPtr starting at first.
|
*
|
*
|
* If the argument first is zero or negative, it refers to the 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
|
* 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
|
* in the list, then no elements are deleted; the new elements are
|
* appended to the list. Count gives the number of elements to
|
* appended to the list. Count gives the number of elements to
|
* replace. If count is zero or negative then no elements are deleted;
|
* replace. If count is zero or negative then no elements are deleted;
|
* the new elements are simply inserted before first.
|
* the new elements are simply inserted before first.
|
*
|
*
|
* The argument objv refers to an array of objc pointers to the new
|
* 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
|
* 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
|
* 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.
|
* not a list object, an attempt will be made to convert it to one.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK. If listPtr does
|
* The return value is normally TCL_OK. If listPtr does
|
* not refer to a list object and can not be converted to one,
|
* 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
|
* TCL_ERROR is returned and an error message will be left in
|
* the interpreter's result if interp is not NULL.
|
* the interpreter's result if interp is not NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The ref counts of the objc elements in objv are incremented since
|
* The ref counts of the objc elements in objv are incremented since
|
* the resulting list now refers to them. Similarly, the ref counts for
|
* the resulting list now refers to them. Similarly, the ref counts for
|
* replaced objects are decremented. listPtr is converted, if
|
* replaced objects are decremented. listPtr is converted, if
|
* necessary, to a list object. listPtr's old string representation, if
|
* necessary, to a list object. listPtr's old string representation, if
|
* any, is freed.
|
* any, is freed.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
|
Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
|
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
|
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
|
Tcl_Obj *listPtr; /* List object whose elements to replace. */
|
Tcl_Obj *listPtr; /* List object whose elements to replace. */
|
int first; /* Index of first element to replace. */
|
int first; /* Index of first element to replace. */
|
int count; /* Number of elements to replace. */
|
int count; /* Number of elements to replace. */
|
int objc; /* Number of objects to insert. */
|
int objc; /* Number of objects to insert. */
|
Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects
|
Tcl_Obj *CONST objv[]; /* An array of objc pointers to Tcl objects
|
* to insert. */
|
* to insert. */
|
{
|
{
|
List *listRepPtr;
|
List *listRepPtr;
|
register Tcl_Obj **elemPtrs, **newPtrs;
|
register Tcl_Obj **elemPtrs, **newPtrs;
|
Tcl_Obj *victimPtr;
|
Tcl_Obj *victimPtr;
|
int numElems, numRequired, numAfterLast;
|
int numElems, numRequired, numAfterLast;
|
int start, shift, newMax, i, j, result;
|
int start, shift, newMax, i, j, result;
|
|
|
if (Tcl_IsShared(listPtr)) {
|
if (Tcl_IsShared(listPtr)) {
|
panic("Tcl_ListObjReplace called with shared object");
|
panic("Tcl_ListObjReplace called with shared object");
|
}
|
}
|
if (listPtr->typePtr != &tclListType) {
|
if (listPtr->typePtr != &tclListType) {
|
result = SetListFromAny(interp, listPtr);
|
result = SetListFromAny(interp, listPtr);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
return result;
|
return result;
|
}
|
}
|
}
|
}
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
elemPtrs = listRepPtr->elements;
|
elemPtrs = listRepPtr->elements;
|
numElems = listRepPtr->elemCount;
|
numElems = listRepPtr->elemCount;
|
|
|
if (first < 0) {
|
if (first < 0) {
|
first = 0;
|
first = 0;
|
}
|
}
|
if (first >= numElems) {
|
if (first >= numElems) {
|
first = numElems; /* so we'll insert after last element */
|
first = numElems; /* so we'll insert after last element */
|
}
|
}
|
if (count < 0) {
|
if (count < 0) {
|
count = 0;
|
count = 0;
|
}
|
}
|
|
|
numRequired = (numElems - count + objc);
|
numRequired = (numElems - count + objc);
|
if (numRequired <= listRepPtr->maxElemCount) {
|
if (numRequired <= listRepPtr->maxElemCount) {
|
/*
|
/*
|
* Enough room in the current array. First "delete" count
|
* Enough room in the current array. First "delete" count
|
* elements starting at first.
|
* elements starting at first.
|
*/
|
*/
|
|
|
for (i = 0, j = first; i < count; i++, j++) {
|
for (i = 0, j = first; i < count; i++, j++) {
|
victimPtr = elemPtrs[j];
|
victimPtr = elemPtrs[j];
|
TclDecrRefCount(victimPtr);
|
TclDecrRefCount(victimPtr);
|
}
|
}
|
|
|
/*
|
/*
|
* Shift the elements after the last one removed to their
|
* Shift the elements after the last one removed to their
|
* new locations.
|
* new locations.
|
*/
|
*/
|
|
|
start = (first + count);
|
start = (first + count);
|
numAfterLast = (numElems - start);
|
numAfterLast = (numElems - start);
|
shift = (objc - count); /* numNewElems - numDeleted */
|
shift = (objc - count); /* numNewElems - numDeleted */
|
if ((numAfterLast > 0) && (shift != 0)) {
|
if ((numAfterLast > 0) && (shift != 0)) {
|
Tcl_Obj **src, **dst;
|
Tcl_Obj **src, **dst;
|
|
|
if (shift < 0) {
|
if (shift < 0) {
|
for (src = elemPtrs + start, dst = src + shift;
|
for (src = elemPtrs + start, dst = src + shift;
|
numAfterLast > 0; numAfterLast--, src++, dst++) {
|
numAfterLast > 0; numAfterLast--, src++, dst++) {
|
*dst = *src;
|
*dst = *src;
|
}
|
}
|
} else {
|
} else {
|
for (src = elemPtrs + numElems - 1, dst = src + shift;
|
for (src = elemPtrs + numElems - 1, dst = src + shift;
|
numAfterLast > 0; numAfterLast--, src--, dst--) {
|
numAfterLast > 0; numAfterLast--, src--, dst--) {
|
*dst = *src;
|
*dst = *src;
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Insert the new elements into elemPtrs before "first".
|
* Insert the new elements into elemPtrs before "first".
|
*/
|
*/
|
|
|
for (i = 0, j = first; i < objc; i++, j++) {
|
for (i = 0, j = first; i < objc; i++, j++) {
|
elemPtrs[j] = objv[i];
|
elemPtrs[j] = objv[i];
|
Tcl_IncrRefCount(objv[i]);
|
Tcl_IncrRefCount(objv[i]);
|
}
|
}
|
|
|
/*
|
/*
|
* Update the count of elements.
|
* Update the count of elements.
|
*/
|
*/
|
|
|
listRepPtr->elemCount = numRequired;
|
listRepPtr->elemCount = numRequired;
|
} else {
|
} else {
|
/*
|
/*
|
* Not enough room in the current array. Allocate a larger array and
|
* Not enough room in the current array. Allocate a larger array and
|
* insert elements into it.
|
* insert elements into it.
|
*/
|
*/
|
|
|
newMax = (2 * numRequired);
|
newMax = (2 * numRequired);
|
newPtrs = (Tcl_Obj **)
|
newPtrs = (Tcl_Obj **)
|
ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
|
ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
|
|
|
/*
|
/*
|
* Copy over the elements before "first".
|
* Copy over the elements before "first".
|
*/
|
*/
|
|
|
if (first > 0) {
|
if (first > 0) {
|
memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
|
memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
|
(size_t) (first * sizeof(Tcl_Obj *)));
|
(size_t) (first * sizeof(Tcl_Obj *)));
|
}
|
}
|
|
|
/*
|
/*
|
* "Delete" count elements starting at first.
|
* "Delete" count elements starting at first.
|
*/
|
*/
|
|
|
for (i = 0, j = first; i < count; i++, j++) {
|
for (i = 0, j = first; i < count; i++, j++) {
|
victimPtr = elemPtrs[j];
|
victimPtr = elemPtrs[j];
|
TclDecrRefCount(victimPtr);
|
TclDecrRefCount(victimPtr);
|
}
|
}
|
|
|
/*
|
/*
|
* Copy the elements after the last one removed, shifted to
|
* Copy the elements after the last one removed, shifted to
|
* their new locations.
|
* their new locations.
|
*/
|
*/
|
|
|
start = (first + count);
|
start = (first + count);
|
numAfterLast = (numElems - start);
|
numAfterLast = (numElems - start);
|
if (numAfterLast > 0) {
|
if (numAfterLast > 0) {
|
memcpy((VOID *) &(newPtrs[first + objc]),
|
memcpy((VOID *) &(newPtrs[first + objc]),
|
(VOID *) &(elemPtrs[start]),
|
(VOID *) &(elemPtrs[start]),
|
(size_t) (numAfterLast * sizeof(Tcl_Obj *)));
|
(size_t) (numAfterLast * sizeof(Tcl_Obj *)));
|
}
|
}
|
|
|
/*
|
/*
|
* Insert the new elements before "first" and update the
|
* Insert the new elements before "first" and update the
|
* count of elements.
|
* count of elements.
|
*/
|
*/
|
|
|
for (i = 0, j = first; i < objc; i++, j++) {
|
for (i = 0, j = first; i < objc; i++, j++) {
|
newPtrs[j] = objv[i];
|
newPtrs[j] = objv[i];
|
Tcl_IncrRefCount(objv[i]);
|
Tcl_IncrRefCount(objv[i]);
|
}
|
}
|
|
|
listRepPtr->elemCount = numRequired;
|
listRepPtr->elemCount = numRequired;
|
listRepPtr->maxElemCount = newMax;
|
listRepPtr->maxElemCount = newMax;
|
listRepPtr->elements = newPtrs;
|
listRepPtr->elements = newPtrs;
|
ckfree((char *) elemPtrs);
|
ckfree((char *) elemPtrs);
|
}
|
}
|
|
|
/*
|
/*
|
* Invalidate and free any old string representation since it no longer
|
* Invalidate and free any old string representation since it no longer
|
* reflects the list's internal representation.
|
* reflects the list's internal representation.
|
*/
|
*/
|
|
|
Tcl_InvalidateStringRep(listPtr);
|
Tcl_InvalidateStringRep(listPtr);
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* FreeListInternalRep --
|
* FreeListInternalRep --
|
*
|
*
|
* Deallocate the storage associated with a list object's internal
|
* Deallocate the storage associated with a list object's internal
|
* representation.
|
* representation.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Frees listPtr's List* internal representation and sets listPtr's
|
* Frees listPtr's List* internal representation and sets listPtr's
|
* internalRep.otherValuePtr to NULL. Decrements the ref counts
|
* internalRep.otherValuePtr to NULL. Decrements the ref counts
|
* of all element objects, which may free them.
|
* of all element objects, which may free them.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static void
|
static void
|
FreeListInternalRep(listPtr)
|
FreeListInternalRep(listPtr)
|
Tcl_Obj *listPtr; /* List object with internal rep to free. */
|
Tcl_Obj *listPtr; /* List object with internal rep to free. */
|
{
|
{
|
register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
register Tcl_Obj **elemPtrs = listRepPtr->elements;
|
register Tcl_Obj **elemPtrs = listRepPtr->elements;
|
register Tcl_Obj *objPtr;
|
register Tcl_Obj *objPtr;
|
int numElems = listRepPtr->elemCount;
|
int numElems = listRepPtr->elemCount;
|
int i;
|
int i;
|
|
|
for (i = 0; i < numElems; i++) {
|
for (i = 0; i < numElems; i++) {
|
objPtr = elemPtrs[i];
|
objPtr = elemPtrs[i];
|
Tcl_DecrRefCount(objPtr);
|
Tcl_DecrRefCount(objPtr);
|
}
|
}
|
ckfree((char *) elemPtrs);
|
ckfree((char *) elemPtrs);
|
ckfree((char *) listRepPtr);
|
ckfree((char *) listRepPtr);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* DupListInternalRep --
|
* DupListInternalRep --
|
*
|
*
|
* Initialize the internal representation of a list Tcl_Obj to a
|
* Initialize the internal representation of a list Tcl_Obj to a
|
* copy of the internal representation of an existing list object.
|
* copy of the internal representation of an existing list object.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* "srcPtr"s list internal rep pointer should not be NULL and we assume
|
* "srcPtr"s list internal rep pointer should not be NULL and we assume
|
* it is not NULL. We set "copyPtr"s internal rep to a pointer to a
|
* it is not NULL. We set "copyPtr"s internal rep to a pointer to a
|
* newly allocated List structure that, in turn, points to "srcPtr"s
|
* newly allocated List structure that, in turn, points to "srcPtr"s
|
* element objects. Those element objects are not actually copied but
|
* element objects. Those element objects are not actually copied but
|
* are shared between "srcPtr" and "copyPtr". The ref count of each
|
* are shared between "srcPtr" and "copyPtr". The ref count of each
|
* element object is incremented.
|
* element object is incremented.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static void
|
static void
|
DupListInternalRep(srcPtr, copyPtr)
|
DupListInternalRep(srcPtr, copyPtr)
|
Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
|
Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
|
Tcl_Obj *copyPtr; /* Object with internal rep to set. */
|
Tcl_Obj *copyPtr; /* Object with internal rep to set. */
|
{
|
{
|
List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
|
List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
|
int numElems = srcListRepPtr->elemCount;
|
int numElems = srcListRepPtr->elemCount;
|
int maxElems = srcListRepPtr->maxElemCount;
|
int maxElems = srcListRepPtr->maxElemCount;
|
register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
|
register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
|
register Tcl_Obj **copyElemPtrs;
|
register Tcl_Obj **copyElemPtrs;
|
register List *copyListRepPtr;
|
register List *copyListRepPtr;
|
int i;
|
int i;
|
|
|
/*
|
/*
|
* Allocate a new List structure that points to "srcPtr"s element
|
* Allocate a new List structure that points to "srcPtr"s element
|
* objects. Increment the ref counts for those (now shared) element
|
* objects. Increment the ref counts for those (now shared) element
|
* objects.
|
* objects.
|
*/
|
*/
|
|
|
copyElemPtrs = (Tcl_Obj **)
|
copyElemPtrs = (Tcl_Obj **)
|
ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
|
ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
|
for (i = 0; i < numElems; i++) {
|
for (i = 0; i < numElems; i++) {
|
copyElemPtrs[i] = srcElemPtrs[i];
|
copyElemPtrs[i] = srcElemPtrs[i];
|
Tcl_IncrRefCount(copyElemPtrs[i]);
|
Tcl_IncrRefCount(copyElemPtrs[i]);
|
}
|
}
|
|
|
copyListRepPtr = (List *) ckalloc(sizeof(List));
|
copyListRepPtr = (List *) ckalloc(sizeof(List));
|
copyListRepPtr->maxElemCount = maxElems;
|
copyListRepPtr->maxElemCount = maxElems;
|
copyListRepPtr->elemCount = numElems;
|
copyListRepPtr->elemCount = numElems;
|
copyListRepPtr->elements = copyElemPtrs;
|
copyListRepPtr->elements = copyElemPtrs;
|
|
|
copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
|
copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
|
copyPtr->typePtr = &tclListType;
|
copyPtr->typePtr = &tclListType;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* SetListFromAny --
|
* SetListFromAny --
|
*
|
*
|
* Attempt to generate a list internal form for the Tcl object
|
* Attempt to generate a list internal form for the Tcl object
|
* "objPtr".
|
* "objPtr".
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is TCL_OK or TCL_ERROR. If an error occurs during
|
* The return value is TCL_OK or TCL_ERROR. If an error occurs during
|
* conversion, an error message is left in the interpreter's result
|
* conversion, an error message is left in the interpreter's result
|
* unless "interp" is NULL.
|
* unless "interp" is NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If no error occurs, a list is stored as "objPtr"s internal
|
* If no error occurs, a list is stored as "objPtr"s internal
|
* representation.
|
* representation.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static int
|
static int
|
SetListFromAny(interp, objPtr)
|
SetListFromAny(interp, objPtr)
|
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
|
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
|
Tcl_Obj *objPtr; /* The object to convert. */
|
Tcl_Obj *objPtr; /* The object to convert. */
|
{
|
{
|
Tcl_ObjType *oldTypePtr = objPtr->typePtr;
|
Tcl_ObjType *oldTypePtr = objPtr->typePtr;
|
char *string, *elemStart, *nextElem, *s;
|
char *string, *elemStart, *nextElem, *s;
|
int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
|
int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
|
char *limit; /* Points just after string's last byte. */
|
char *limit; /* Points just after string's last byte. */
|
register char *p;
|
register char *p;
|
register Tcl_Obj **elemPtrs;
|
register Tcl_Obj **elemPtrs;
|
register Tcl_Obj *elemPtr;
|
register Tcl_Obj *elemPtr;
|
List *listRepPtr;
|
List *listRepPtr;
|
|
|
/*
|
/*
|
* Get the string representation. Make it up-to-date if necessary.
|
* Get the string representation. Make it up-to-date if necessary.
|
*/
|
*/
|
|
|
string = Tcl_GetStringFromObj(objPtr, &length);
|
string = Tcl_GetStringFromObj(objPtr, &length);
|
|
|
/*
|
/*
|
* Parse the string into separate string objects, and create a List
|
* Parse the string into separate string objects, and create a List
|
* structure that points to the element string objects. We use a
|
* structure that points to the element string objects. We use a
|
* modified version of Tcl_SplitList's implementation to avoid one
|
* modified version of Tcl_SplitList's implementation to avoid one
|
* malloc and a string copy for each list element. First, estimate the
|
* malloc and a string copy for each list element. First, estimate the
|
* number of elements by counting the number of space characters in the
|
* number of elements by counting the number of space characters in the
|
* list.
|
* list.
|
*/
|
*/
|
|
|
limit = (string + length);
|
limit = (string + length);
|
estCount = 1;
|
estCount = 1;
|
for (p = string; p < limit; p++) {
|
for (p = string; p < limit; p++) {
|
if (isspace(UCHAR(*p))) {
|
if (isspace(UCHAR(*p))) {
|
estCount++;
|
estCount++;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Allocate a new List structure with enough room for "estCount"
|
* Allocate a new List structure with enough room for "estCount"
|
* elements. Each element is a pointer to a Tcl_Obj with the appropriate
|
* elements. Each element is a pointer to a Tcl_Obj with the appropriate
|
* string rep. The initial "estCount" elements are set using the
|
* string rep. The initial "estCount" elements are set using the
|
* corresponding "argv" strings.
|
* corresponding "argv" strings.
|
*/
|
*/
|
|
|
elemPtrs = (Tcl_Obj **)
|
elemPtrs = (Tcl_Obj **)
|
ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
|
ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
|
for (p = string, lenRemain = length, i = 0;
|
for (p = string, lenRemain = length, i = 0;
|
lenRemain > 0;
|
lenRemain > 0;
|
p = nextElem, lenRemain = (limit - nextElem), i++) {
|
p = nextElem, lenRemain = (limit - nextElem), i++) {
|
result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
|
result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
|
&elemSize, &hasBrace);
|
&elemSize, &hasBrace);
|
if (result != TCL_OK) {
|
if (result != TCL_OK) {
|
for (j = 0; j < i; j++) {
|
for (j = 0; j < i; j++) {
|
elemPtr = elemPtrs[j];
|
elemPtr = elemPtrs[j];
|
Tcl_DecrRefCount(elemPtr);
|
Tcl_DecrRefCount(elemPtr);
|
}
|
}
|
ckfree((char *) elemPtrs);
|
ckfree((char *) elemPtrs);
|
return result;
|
return result;
|
}
|
}
|
if (elemStart >= limit) {
|
if (elemStart >= limit) {
|
break;
|
break;
|
}
|
}
|
if (i > estCount) {
|
if (i > estCount) {
|
panic("SetListFromAny: bad size estimate for list");
|
panic("SetListFromAny: bad size estimate for list");
|
}
|
}
|
|
|
/*
|
/*
|
* Allocate a Tcl object for the element and initialize it from the
|
* Allocate a Tcl object for the element and initialize it from the
|
* "elemSize" bytes starting at "elemStart".
|
* "elemSize" bytes starting at "elemStart".
|
*/
|
*/
|
|
|
s = ckalloc((unsigned) elemSize + 1);
|
s = ckalloc((unsigned) elemSize + 1);
|
if (hasBrace) {
|
if (hasBrace) {
|
memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
|
memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
|
s[elemSize] = 0;
|
s[elemSize] = 0;
|
} else {
|
} else {
|
elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
|
elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
|
}
|
}
|
|
|
TclNewObj(elemPtr);
|
TclNewObj(elemPtr);
|
elemPtr->bytes = s;
|
elemPtr->bytes = s;
|
elemPtr->length = elemSize;
|
elemPtr->length = elemSize;
|
elemPtrs[i] = elemPtr;
|
elemPtrs[i] = elemPtr;
|
Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
|
Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
|
}
|
}
|
|
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr = (List *) ckalloc(sizeof(List));
|
listRepPtr->maxElemCount = estCount;
|
listRepPtr->maxElemCount = estCount;
|
listRepPtr->elemCount = i;
|
listRepPtr->elemCount = i;
|
listRepPtr->elements = elemPtrs;
|
listRepPtr->elements = elemPtrs;
|
|
|
/*
|
/*
|
* Free the old internalRep before setting the new one. We do this as
|
* Free the old internalRep before setting the new one. We do this as
|
* late as possible to allow the conversion code, in particular
|
* late as possible to allow the conversion code, in particular
|
* Tcl_GetStringFromObj, to use that old internalRep.
|
* Tcl_GetStringFromObj, to use that old internalRep.
|
*/
|
*/
|
|
|
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
|
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
|
oldTypePtr->freeIntRepProc(objPtr);
|
oldTypePtr->freeIntRepProc(objPtr);
|
}
|
}
|
|
|
objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
|
objPtr->typePtr = &tclListType;
|
objPtr->typePtr = &tclListType;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* UpdateStringOfList --
|
* UpdateStringOfList --
|
*
|
*
|
* Update the string representation for a list object.
|
* Update the string representation for a list object.
|
* Note: This procedure does not invalidate an existing old string rep
|
* Note: This procedure does not invalidate an existing old string rep
|
* so storage will be lost if this has not already been done.
|
* so storage will be lost if this has not already been done.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The object's string is set to a valid string that results from
|
* 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
|
* the list-to-string conversion. This string will be empty if the
|
* list has no elements. The list internal representation
|
* list has no elements. The list internal representation
|
* should not be NULL and we assume it is not NULL.
|
* should not be NULL and we assume it is not NULL.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static void
|
static void
|
UpdateStringOfList(listPtr)
|
UpdateStringOfList(listPtr)
|
Tcl_Obj *listPtr; /* List object with string rep to update. */
|
Tcl_Obj *listPtr; /* List object with string rep to update. */
|
{
|
{
|
# define LOCAL_SIZE 20
|
# define LOCAL_SIZE 20
|
int localFlags[LOCAL_SIZE], *flagPtr;
|
int localFlags[LOCAL_SIZE], *flagPtr;
|
List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
|
int numElems = listRepPtr->elemCount;
|
int numElems = listRepPtr->elemCount;
|
register int i;
|
register int i;
|
char *elem, *dst;
|
char *elem, *dst;
|
int length;
|
int length;
|
|
|
/*
|
/*
|
* Convert each element of the list to string form and then convert it
|
* Convert each element of the list to string form and then convert it
|
* to proper list element form, adding it to the result buffer.
|
* to proper list element form, adding it to the result buffer.
|
*/
|
*/
|
|
|
/*
|
/*
|
* Pass 1: estimate space, gather flags.
|
* Pass 1: estimate space, gather flags.
|
*/
|
*/
|
|
|
if (numElems <= LOCAL_SIZE) {
|
if (numElems <= LOCAL_SIZE) {
|
flagPtr = localFlags;
|
flagPtr = localFlags;
|
} else {
|
} else {
|
flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
|
flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
|
}
|
}
|
listPtr->length = 1;
|
listPtr->length = 1;
|
for (i = 0; i < numElems; i++) {
|
for (i = 0; i < numElems; i++) {
|
elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
|
elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
|
listPtr->length += Tcl_ScanCountedElement(elem, length,
|
listPtr->length += Tcl_ScanCountedElement(elem, length,
|
&flagPtr[i]) + 1;
|
&flagPtr[i]) + 1;
|
}
|
}
|
|
|
/*
|
/*
|
* Pass 2: copy into string rep buffer.
|
* Pass 2: copy into string rep buffer.
|
*/
|
*/
|
|
|
listPtr->bytes = ckalloc((unsigned) listPtr->length);
|
listPtr->bytes = ckalloc((unsigned) listPtr->length);
|
dst = listPtr->bytes;
|
dst = listPtr->bytes;
|
for (i = 0; i < numElems; i++) {
|
for (i = 0; i < numElems; i++) {
|
elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
|
elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
|
dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
|
dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
|
*dst = ' ';
|
*dst = ' ';
|
dst++;
|
dst++;
|
}
|
}
|
if (flagPtr != localFlags) {
|
if (flagPtr != localFlags) {
|
ckfree((char *) flagPtr);
|
ckfree((char *) flagPtr);
|
}
|
}
|
if (dst == listPtr->bytes) {
|
if (dst == listPtr->bytes) {
|
*dst = 0;
|
*dst = 0;
|
} else {
|
} else {
|
dst--;
|
dst--;
|
*dst = 0;
|
*dst = 0;
|
}
|
}
|
listPtr->length = dst - listPtr->bytes;
|
listPtr->length = dst - listPtr->bytes;
|
}
|
}
|
|
|
