/* 

 * tclListObj.c --

 *

 *	This file contains procedures 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.

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

 *

 * 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.13.4.2 2005/08/25 22:27:08 dkf Exp $

 */

#include "tclInt.h"

/*

 * Prototypes for procedures defined later in this file:

 */

static void		DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,

			    Tcl_Obj *copyPtr));

static void		FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));

static int		SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Obj *objPtr));

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 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.

 */

Tcl_ObjType tclListType = {

    "list",				/* name */

    FreeListInternalRep,		/* freeIntRepProc */

    DupListInternalRep,		        /* dupIntRepProc */

    UpdateStringOfList,			/* updateStringProc */

    SetListFromAny			/* setFromAnyProc */

};

/*

 *----------------------------------------------------------------------

 *

 * Tcl_NewListObj --

 *

 *	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

 *	(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.

 *

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

 *

 * Side effects:

 *	The ref counts of the elements in objv are incremented since the

 *	resulting list now refers to them.

 *

 *----------------------------------------------------------------------

 */

#ifdef TCL_MEM_DEBUG

#undef Tcl_NewListObj

EXPORT_C Tcl_Obj *

Tcl_NewListObj(objc, objv)

    int objc;			/* Count of objects referenced by objv. */

    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */

{

    return Tcl_DbNewListObj(objc, objv, "unknown", 0);

}

#else /* if not TCL_MEM_DEBUG */

EXPORT_C Tcl_Obj *

Tcl_NewListObj(objc, objv)

    int objc;			/* Count of objects referenced by objv. */

    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */

{

    register Tcl_Obj *listPtr;

    register Tcl_Obj **elemPtrs;

    register List *listRepPtr;

    int i;

    TclNewObj(listPtr);

    if (objc > 0) {

	Tcl_InvalidateStringRep(listPtr);

	elemPtrs = (Tcl_Obj **)

	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));

	for (i = 0;  i < objc;  i++) {

	    elemPtrs[i] = objv[i];

	    Tcl_IncrRefCount(elemPtrs[i]);

	}

	listRepPtr = (List *) ckalloc(sizeof(List));

	listRepPtr->maxElemCount = objc;

	listRepPtr->elemCount    = objc;

	listRepPtr->elements     = elemPtrs;

	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;

	listPtr->internalRep.twoPtrValue.ptr2 = NULL;

	listPtr->typePtr = &tclListType;

    }

    return listPtr;

}

#endif /* if TCL_MEM_DEBUG */

/*

 *----------------------------------------------------------------------

 *

 * 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

 *	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

 *	reporting objects that haven't been freed.

 *

 *	When TCL_MEM_DEBUG is not defined, this procedure 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.

 *

 * Side effects:

 *	The ref counts of the elements in objv are incremented since the

 *	resulting list now refers to them.

 *

 *----------------------------------------------------------------------

 */

#ifdef TCL_MEM_DEBUG

EXPORT_C Tcl_Obj *

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

{

    register Tcl_Obj *listPtr;

    register Tcl_Obj **elemPtrs;

    register List *listRepPtr;

    int i;

    TclDbNewObj(listPtr, file, line);

    if (objc > 0) {

	Tcl_InvalidateStringRep(listPtr);

	elemPtrs = (Tcl_Obj **)

	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));

	for (i = 0;  i < objc;  i++) {

	    elemPtrs[i] = objv[i];

	    Tcl_IncrRefCount(elemPtrs[i]);

	}

	listRepPtr = (List *) ckalloc(sizeof(List));

	listRepPtr->maxElemCount = objc;

	listRepPtr->elemCount    = objc;

	listRepPtr->elements     = elemPtrs;

	listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;

	listPtr->internalRep.twoPtrValue.ptr2 = NULL;

	listPtr->typePtr = &tclListType;

    }

    return listPtr;

}

#else /* if not TCL_MEM_DEBUG */

EXPORT_C Tcl_Obj *

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

{

    return Tcl_NewListObj(objc, objv);

}

#endif /* TCL_MEM_DEBUG */

/*

 *----------------------------------------------------------------------

 *

 * Tcl_SetListObj --

 *

 *	Modify an object to be a list containing each of the objc elements

 *	of the object array referenced by objv.

 *

 * Results:

 *	None.

 *

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

 *

 *----------------------------------------------------------------------

 */

EXPORT_C void

Tcl_SetListObj(objPtr, objc, objv)

    Tcl_Obj *objPtr;		/* Object whose internal rep to init. */

    int objc;			/* Count of objects referenced by objv. */

    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */

{

    register Tcl_Obj **elemPtrs;

    register List *listRepPtr;

    Tcl_ObjType *oldTypePtr = objPtr->typePtr;

    int i;

    if (Tcl_IsShared(objPtr)) {

	panic("Tcl_SetListObj called with shared object");

    }

    /*

     * Free any old string rep and any internal rep for the old type.

     */

    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {

	oldTypePtr->freeIntRepProc(objPtr);

    }

    objPtr->typePtr = NULL;

    Tcl_InvalidateStringRep(objPtr);

    /*

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

     */

    if (objc > 0) {

	elemPtrs = (Tcl_Obj **)

	    ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));

	for (i = 0;  i < objc;  i++) {

	    elemPtrs[i] = objv[i];

	    Tcl_IncrRefCount(elemPtrs[i]);

	}

	listRepPtr = (List *) ckalloc(sizeof(List));

	listRepPtr->maxElemCount = objc;

	listRepPtr->elemCount    = objc;

	listRepPtr->elements     = elemPtrs;

	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;

	objPtr->internalRep.twoPtrValue.ptr2 = NULL;

	objPtr->typePtr = &tclListType;

    } else {

	objPtr->bytes = tclEmptyStringRep;

	objPtr->length = 0;

    }

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_ListObjGetElements --

 *

 *	This procedure 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.

 *

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

 *

 * Side effects:

 *	The possible conversion of the object referenced by listPtr

 *	to a list object.

 *

 *----------------------------------------------------------------------

 */

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

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

{

    register List *listRepPtr;

    if (listPtr->typePtr != &tclListType) {

	int result = SetListFromAny(interp, listPtr);

	if (result != TCL_OK) {

	    return result;

	}

    }

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;

    *objcPtr = listRepPtr->elemCount;

    *objvPtr = listRepPtr->elements;

    return TCL_OK;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_ListObjAppendList --

 *

 *	This procedure 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.

 *

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

 *	listPtr's old string representation, if any, is invalidated.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C int

Tcl_ListObjAppendList(interp, listPtr, elemListPtr)

    Tcl_Interp *interp;		/* Used to report errors if not NULL. */

    register Tcl_Obj *listPtr;	/* List object to append elements to. */

    Tcl_Obj *elemListPtr;	/* List obj with elements to append. */

{

    register List *listRepPtr;

    int listLen, objc, result;

    Tcl_Obj **objv;

    if (Tcl_IsShared(listPtr)) {

	panic("Tcl_ListObjAppendList called with shared object");

    }

    if (listPtr->typePtr != &tclListType) {

	result = SetListFromAny(interp, listPtr);

	if (result != TCL_OK) {

	    return result;

	}

    }

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;

    listLen = listRepPtr->elemCount;

    result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);

    if (result != TCL_OK) {

	return result;

    }

    /*

     * Insert objc new elements starting after the lists's last element.

     * Delete zero existing elements.

     */

    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);

}

/*

 *----------------------------------------------------------------------

 *

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

 *

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

 *

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

 *

 *----------------------------------------------------------------------

 */

EXPORT_C int

Tcl_ListObjAppendElement(interp, listPtr, objPtr)

    Tcl_Interp *interp;		/* Used to report errors if not NULL. */

    Tcl_Obj *listPtr;		/* List object to append objPtr to. */

    Tcl_Obj *objPtr;		/* Object to append to listPtr's list. */

{

    register List *listRepPtr;

    register Tcl_Obj **elemPtrs;

    int numElems, numRequired;

    if (Tcl_IsShared(listPtr)) {

	panic("Tcl_ListObjAppendElement called with shared object");

    }

    if (listPtr->typePtr != &tclListType) {

	int result = SetListFromAny(interp, listPtr);

	if (result != TCL_OK) {

	    return result;

	}

    }

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;

    elemPtrs = listRepPtr->elements;

    numElems = listRepPtr->elemCount;

    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 (numRequired > listRepPtr->maxElemCount) {

	int newMax = (2 * numRequired);

	Tcl_Obj **newElemPtrs = (Tcl_Obj **)

	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));

	memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,

	       (size_t) (numElems * sizeof(Tcl_Obj *)));

	listRepPtr->maxElemCount = newMax;

	listRepPtr->elements = newElemPtrs;

	ckfree((char *) elemPtrs);

	elemPtrs = newElemPtrs;

    }

    /*

     * Add objPtr to the end of listPtr's array of element

     * pointers. Increment the ref count for the (now shared) objPtr.

     */

    elemPtrs[numElems] = objPtr;

    Tcl_IncrRefCount(objPtr);

    listRepPtr->elemCount++;

    /*

     * Invalidate any old string representation since the list's internal

     * representation has changed.

     */

    Tcl_InvalidateStringRep(listPtr);

    return TCL_OK;

}

/*

 *----------------------------------------------------------------------

 *

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

 *

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

 *

 * Side effects:

 *	listPtr will be converted, if necessary, to a list object.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C int

Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)

    Tcl_Interp *interp;		/* Used to report errors if not NULL. */

    register Tcl_Obj *listPtr;	/* List object to index into. */

    register int index;		/* Index of element to return. */

    Tcl_Obj **objPtrPtr;	/* The resulting Tcl_Obj* is stored here. */

{

    register List *listRepPtr;

    if (listPtr->typePtr != &tclListType) {

	int result = SetListFromAny(interp, listPtr);

	if (result != TCL_OK) {

	    return result;