tcllistobj.c

linux系统下的音频通信

/* 
 * tclListObj.c --
 *
 *	This file contains procedures that implement the Tcl list object
 *	type.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclListObj.c 1.47 97/08/12 19:02:02
 */

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

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

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

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.otherValuePtr = (VOID *) listRepPtr;
	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 checkmem 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

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. */
    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.otherValuePtr = (VOID *) listRepPtr;
	listPtr->typePtr = &tclListType;
    }
    return listPtr;
}

#else /* if not TCL_MEM_DEBUG */

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

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

    Tcl_InvalidateStringRep(objPtr);
    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
	oldTypePtr->freeIntRepProc(objPtr);
	objPtr->typePtr = NULL;
    }
        
    /*
     * Set the object's type to "list" and initialize the internal rep.
     */

    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.otherValuePtr = (VOID *) listRepPtr;
	objPtr->typePtr = &tclListType;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

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

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;