tclobj.c

linux系统下的音频通信

 * TclAllocateFreeObjects --
 *
 *	Procedure to allocate a number of free Tcl_Objs. This is done using
 *	a single ckalloc to reduce the overhead for Tcl_Obj allocation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
 *	first of a number of free Tcl_Obj's linked together by their
 *	internalRep.otherValuePtrs.
 *
 *----------------------------------------------------------------------
 */

#define OBJS_TO_ALLOC_EACH_TIME 100

void
TclAllocateFreeObjects()
{
    Tcl_Obj tmp[2];
    size_t objSizePlusPadding =	/* NB: this assumes byte addressing. */
	((int)(&(tmp[1])) - (int)(&(tmp[0])));
    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * objSizePlusPadding);
    char *basePtr;
    register Tcl_Obj *prevPtr, *objPtr;
    register int i;

    basePtr = (char *) ckalloc(bytesToAlloc);
    memset(basePtr, 0, bytesToAlloc);

    prevPtr = NULL;
    objPtr = (Tcl_Obj *) basePtr;
    for (i = 0;  i < OBJS_TO_ALLOC_EACH_TIME;  i++) {
	objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
	prevPtr = objPtr;
	objPtr = (Tcl_Obj *) (((char *)objPtr) + objSizePlusPadding);
    }
    tclFreeObjList = prevPtr;
}
#undef OBJS_TO_ALLOC_EACH_TIME

/*
 *----------------------------------------------------------------------
 *
 * TclFreeObj --
 *
 *	This procedure frees the memory associated with the argument
 *	object. It is called by the tcl.h macro Tcl_DecrRefCount when an
 *	object's ref count is zero. It is only "public" since it must
 *	be callable by that macro wherever the macro is used. It should not
 *	be directly called by clients.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deallocates the storage for the object's Tcl_Obj structure
 *	after deallocating the string representation and calling the
 *	type-specific Tcl_FreeInternalRepProc to deallocate the object's
 *	internal representation. If compiling with TCL_COMPILE_STATS,
 *	this procedure increments the global count of freed objects
 *	(tclObjsFreed).
 *
 *----------------------------------------------------------------------
 */

void
TclFreeObj(objPtr)
    register Tcl_Obj *objPtr;	/* The object to be freed. */
{
    register Tcl_ObjType *typePtr = objPtr->typePtr;
    
#ifdef TCL_MEM_DEBUG
    if ((objPtr)->refCount < -1) {
	panic("Reference count for %lx was negative", objPtr);
    }
#endif /* TCL_MEM_DEBUG */

    Tcl_InvalidateStringRep(objPtr);
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	typePtr->freeIntRepProc(objPtr);
    }

    /*
     * If debugging Tcl's memory usage, deallocate the object using ckfree.
     * Otherwise, deallocate it by adding it onto the list of free
     * Tcl_Objs we maintain.
     */
    
#ifdef TCL_MEM_DEBUG
    ckfree((char *) objPtr);
#else
    objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
    tclFreeObjList = objPtr;
#endif /* TCL_MEM_DEBUG */

#ifdef TCL_COMPILE_STATS    
    tclObjsFreed++;
#endif /* TCL_COMPILE_STATS */    
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
 *	Create and return a new object that is a duplicate of the argument
 *	object.
 *
 * Results:
 *	The return value is a pointer to a newly created Tcl_Obj. This
 *	object has reference count 0 and the same type, if any, as the
 *	source object objPtr. Also:
 *	  1) If the source object has a valid string rep, we copy it;
 *	     otherwise, the duplicate's string rep is set NULL to mark
 *	     it invalid.
 *	  2) If the source object has an internal representation (i.e. its
 *	     typePtr is non-NULL), the new object's internal rep is set to
 *	     a copy; otherwise the new internal rep is marked invalid.
 *
 * Side effects:
 *      What constitutes "copying" the internal representation depends on
 *	the type. For example, if the argument object is a list,
 *	the element objects it points to will not actually be copied but
 *	will be shared with the duplicate list. That is, the ref counts of
 *	the element objects will be incremented.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_DuplicateObj(objPtr)
    register Tcl_Obj *objPtr;		/* The object to duplicate. */
{
    register Tcl_ObjType *typePtr = objPtr->typePtr;
    register Tcl_Obj *dupPtr;

    TclNewObj(dupPtr);

    if (objPtr->bytes == NULL) {
	dupPtr->bytes = NULL;
    } else if (objPtr->bytes != tclEmptyStringRep) {
	int len = objPtr->length;
	
	dupPtr->bytes = (char *) ckalloc((unsigned) len+1);
	if (len > 0) {
	    memcpy((VOID *) dupPtr->bytes, (VOID *) objPtr->bytes,
		   (unsigned) len);
	}
	dupPtr->bytes[len] = '\0';
	dupPtr->length = len;
    }
    
    if (typePtr != NULL) {
	typePtr->dupIntRepProc(objPtr, dupPtr);
    }
    return dupPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringFromObj --
 *
 *	Returns the string representation's byte array pointer and length
 *	for an object.
 *
 * Results:
 *	Returns a pointer to the string representation of objPtr. If
 *	lengthPtr isn't NULL, the length of the string representation is
 *	stored at *lengthPtr. The byte array referenced by the returned
 *	pointer must not be modified by the caller. Furthermore, the
 *	caller must copy the bytes if they need to retain them since the
 *	object's string rep can change as a result of other operations.
 *
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetStringFromObj(objPtr, lengthPtr)
    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
				 * should be returned. */
    register int *lengthPtr;	/* If non-NULL, the location where the
				 * string rep's byte array length should be
				 * stored. If NULL, no length is stored. */
{
    if (objPtr->bytes != NULL) {
	if (lengthPtr != NULL) {
	    *lengthPtr = objPtr->length;
	}
	return objPtr->bytes;
    }

    objPtr->typePtr->updateStringProc(objPtr);
    if (lengthPtr != NULL) {
	*lengthPtr = objPtr->length;
    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InvalidateStringRep --
 *
 *	This procedure is called to invalidate an object's string
 *	representation. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deallocates the storage for any old string representation, then
 *	sets the string representation NULL to mark it invalid.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InvalidateStringRep(objPtr)
     register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
				 * should be freed. */
{
    if (objPtr->bytes != NULL) {
	if (objPtr->bytes != tclEmptyStringRep) {
	    ckfree((char *) objPtr->bytes);
	}
	objPtr->bytes = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewBooleanObj --
 *
 *	This procedure is normally called when not debugging: i.e., when
 *	TCL_MEM_DEBUG is not defined. It creates a new boolean object and
 *	initializes it from the argument boolean value. A nonzero
 *	"boolValue" is coerced to 1.
 *
 *	When TCL_MEM_DEBUG is defined, this procedure just returns the
 *	result of calling the debugging version Tcl_DbNewBooleanObj.
 *
 * Results:
 *	The newly created object is returned. This object will have an
 *	invalid string representation. The returned object has ref count 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewBooleanObj

Tcl_Obj *
Tcl_NewBooleanObj(boolValue)
    register int boolValue;	/* Boolean used to initialize new object. */
{
    return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewBooleanObj(boolValue)
    register int boolValue;	/* Boolean used to initialize new object. */
{
    register Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    objPtr->bytes = NULL;
    
    objPtr->internalRep.longValue = (boolValue? 1 : 0);
    objPtr->typePtr = &tclBooleanType;
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbNewBooleanObj --
 *
 *	This procedure is normally called when debugging: i.e., when
 *	TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
 *	same as the Tcl_NewBooleanObj 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_NewBooleanObj.
 *
 * Results:
 *	The newly created object is returned. This object will have an
 *	invalid string representation. The returned object has ref count 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewBooleanObj(boolValue, file, line)
    register int boolValue;	/* Boolean used to initialize new object. */
    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 *objPtr;

    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;
    
    objPtr->internalRep.longValue = (boolValue? 1 : 0);
    objPtr->typePtr = &tclBooleanType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewBooleanObj(boolValue, file, line)
    register int boolValue;	/* Boolean used to initialize new object. */
    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_NewBooleanObj(boolValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetBooleanObj --
 *
 *	Modify an object to be a boolean object and to have the specified
 *	boolean value. A nonzero "boolValue" is coerced to 1.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old string rep, if any, is freed. Also, any old
 *	internal rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetBooleanObj(objPtr, boolValue)
    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
    register int boolValue;	/* Boolean used to set object's value. */
{
    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;

    if (Tcl_IsShared(objPtr)) {
	panic("Tcl_SetBooleanObj called with shared object");
    }
    
    Tcl_InvalidateStringRep(objPtr);
    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
	oldTypePtr->freeIntRepProc(objPtr);
    }
    
    objPtr->internalRep.longValue = (boolValue? 1 : 0);
    objPtr->typePtr = &tclBooleanType;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBooleanFromObj --
 *
 *	Attempt to return a boolean from the Tcl object "objPtr". If the
 *	object is not already a boolean, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already a boolean, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
    register int *boolPtr;	/* Place to store resulting boolean. */
{
    register int result;

    result = SetBooleanFromAny(interp, objPtr);
    if (result == TCL_OK) {
	*boolPtr = (int) objPtr->internalRep.longValue;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DupBooleanInternalRep --
 *
 *	Initialize the internal representation of a boolean Tcl_Obj to a
 *	copy of the internal representation of an existing boolean object. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	"copyPtr"s internal rep is set to the boolean (an integer)
 *	corresponding to "srcPtr"s internal rep.
 *
 *----------------------------------------------------------------------
 */

static void
DupBooleanInternalRep(srcPtr, copyPtr)
    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
{
    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
    copyPtr->typePtr = &tclBooleanType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetBooleanFromAny --
 *
 *	Attempt to generate a boolean internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s
 *	internal representation and the type of "objPtr" is set to boolean.
 *
 *----------------------------------------------------------------------
 */

static int
SetBooleanFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr;	/* The object to convert. */
{
    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
    char *string, *end;
    register char c;
    char lowerCase[10];
    int newBool, length;
    register int i;
    double dbl;

    /*
     * Get the string representation. Make it up-to-date if necessary.
     */

    string = TclGetStringFromObj(objPtr, &length);

    /*
     * Copy the string converting its characters to lower case.
     */

    for (i = 0;  (i < 9) && (i < length);  i++) {
	c = string[i];
	if (isupper(UCHAR(c))) {
	    c = (char) tolower(UCHAR(c));
	}
	lowerCase[i] = c;
    }
    lowerCase[i] = 0;

    /*
     * Parse the string as a boolean. We use an implementation here that
     * doesn't report errors in interp if interp is NULL.
     */

    c = lowerCase[0];
    if ((c == '0') && (lowerCase[1] == '\0')) {
	newBool = 0;
    } else if ((c == '1') && (lowerCase[1] == '\0')) {
	newBool = 1;
    } else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
	newBool = 1;
    } else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
	newBool = 0;
    } else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
	newBool = 1;
    } else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
	newBool = 0;
    } else if ((c == 'o') && (length >= 2)) {
	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
	    newBool = 1;
	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
	    newBool = 0;
	} else {
	    goto badBoolean;
	}
    } else {
        /*
         * Still might be a string containing the characters representing an
         * int or double that wasn't handled above. This would be a string
         * like "27" or "1.0" that is non-zero and not "1". Such a string
         * whould result in the boolean value true. We try converting to
         * double. If that succeeds and the resulting double is non-zero, we
         * have a "true". Note that numbers can't have embedded NULLs.
	 */