tclstringobj.c

来自「tcl是工具命令语言」· C语言 代码 · 共 1,878 行 · 第 1/4 页

	
	stringPtr = GET_STRING(objPtr);
    }
    if (stringPtr->hasUnicode == 0) {

	/*
	 * All of the characters in the Utf string are 1 byte chars,
	 * so we don't store the unicode char.  We get the Utf string
	 * and convert the index'th byte to a Unicode character.
	 */

	unichar = (Tcl_UniChar) objPtr->bytes[index];
    } else {
	unichar = stringPtr->unicode[index];
    }
    return unichar;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicode --
 *
 *	Get the Unicode form of the String object.  If
 *	the object is not already a String object, it will be converted
 *	to one.  If the String object does not have a Unicode rep, then
 *	one is create from the UTF string format.
 *
 * Results:
 *	Returns a pointer to the object's internal Unicode string.
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_GetUnicode(objPtr)
    Tcl_Obj *objPtr;	/* The object to find the unicode string for. */
{
    String *stringPtr;
    
    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    
    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {

	/*
	 * We haven't yet calculated the length, or all of the characters
	 * in the Utf string are 1 byte chars (so we didn't store the
	 * unicode str).  Since this function must return a unicode string,
	 * and one has not yet been stored, force the Unicode to be
	 * calculated and stored now.
	 */

	FillUnicodeRep(objPtr);

	/*
	 * We need to fetch the pointer again because we have just
	 * reallocated the structure to make room for the Unicode data.
	 */
	
	stringPtr = GET_STRING(objPtr);
    }
    return stringPtr->unicode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *
 *	Get the Unicode form of the String object with length.  If
 *	the object is not already a String object, it will be converted
 *	to one.  If the String object does not have a Unicode rep, then
 *	one is create from the UTF string format.
 *
 * Results:
 *	Returns a pointer to the object's internal Unicode string.
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
    Tcl_Obj *objPtr;	/* The object to find the unicode string for. */
    int *lengthPtr;	/* If non-NULL, the location where the
			 * string rep's unichar length should be
			 * stored. If NULL, no length is stored. */
{
    String *stringPtr;
    
    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    
    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {

	/*
	 * We haven't yet calculated the length, or all of the characters
	 * in the Utf string are 1 byte chars (so we didn't store the
	 * unicode str).  Since this function must return a unicode string,
	 * and one has not yet been stored, force the Unicode to be
	 * calculated and stored now.
	 */

	FillUnicodeRep(objPtr);

	/*
	 * We need to fetch the pointer again because we have just
	 * reallocated the structure to make room for the Unicode data.
	 */
	
	stringPtr = GET_STRING(objPtr);
    }

    if (lengthPtr != NULL) {
	*lengthPtr = stringPtr->numChars;
    }
    return stringPtr->unicode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetRange --
 *
 *	Create a Tcl Object that contains the chars between first and last
 *	of the object indicated by "objPtr".  If the object is not already
 *	a String object, convert it to one.  The first and last indices
 *	are assumed to be in the appropriate range.
 *
 * Results:
 *	Returns a new Tcl Object of the String type.
 *
 * Side effects:
 *	Changes the internal rep of "objPtr" to the String type.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetRange(objPtr, first, last)
    Tcl_Obj *objPtr;		/* The Tcl object to find the range of. */
    int first;			/* First index of the range. */
    int last;			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    
    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->numChars == -1) {
    
	/*
	 * We haven't yet calculated the length, so we don't have the
	 * Unicode str.  We need to know the number of chars before we
	 * can do indexing.
	 */

	Tcl_GetCharLength(objPtr);

	/*
	 * We need to fetch the pointer again because we may have just
	 * reallocated the structure.
	 */
	
	stringPtr = GET_STRING(objPtr);
    }

    if (stringPtr->numChars == objPtr->length) {
	char *str = Tcl_GetString(objPtr);

	/*
	 * All of the characters in the Utf string are 1 byte chars,
	 * so we don't store the unicode char.  Create a new string
	 * object containing the specified range of chars.
	 */
	
	newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);

	/*
	 * Since we know the new string only has 1-byte chars, we
	 * can set it's numChars field.
	 */
	
	SetStringFromAny(NULL, newObjPtr);
	stringPtr = GET_STRING(newObjPtr);
	stringPtr->numChars = last-first+1;
    } else {
	newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
		last-first+1);
    }
    return newObjPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStringObj --
 *
 *	Modify an object to hold a string that is a copy of the bytes
 *	indicated by the byte pointer and length arguments. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string representation will be set to a copy of
 *	the "length" bytes starting at "bytes". If "length" is negative, use
 *	bytes up to the first NULL byte; i.e., assume "bytes" points to a
 *	C-style NULL-terminated string. The object's old string and internal
 *	representations are freed and the object's type is set NULL.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetStringObj(objPtr, bytes, length)
    register Tcl_Obj *objPtr;	/* Object whose internal rep to init. */
    CONST char *bytes;		/* Points to the first of the length bytes
				 * used to initialize the object. */
    register int length;	/* The number of bytes to copy from "bytes"
				 * when initializing the object. If 
				 * negative, use bytes up to the first
				 * NULL byte.*/
{
    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;

    /*
     * Free any old string rep, then set the string rep to a copy of
     * the length bytes starting at "bytes".
     */

    if (Tcl_IsShared(objPtr)) {
	panic("Tcl_SetStringObj called with shared object");
    }

    /*
     * Set the type to NULL and free any internal rep for the old type.
     */

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

    Tcl_InvalidateStringRep(objPtr);
    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclInitStringRep(objPtr, bytes, length);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjLength --
 *
 *	This procedure changes the length of the string representation
 *	of an object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If the size of objPtr's string representation is greater than
 *	length, then it is reduced to length and a new terminating null
 *	byte is stored in the strength.  If the length of the string
 *	representation is greater than length, the storage space is
 *	reallocated to the given length; a null byte is stored at the
 *	end, but other bytes past the end of the original string
 *	representation are undefined.  The object's internal
 *	representation is changed to "expendable string".
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjLength(objPtr, length)
    register Tcl_Obj *objPtr;	/* Pointer to object.  This object must
				 * not currently be shared. */
    register int length;	/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	panic("Tcl_SetObjLength called with shared object");
    }
    SetStringFromAny(NULL, objPtr);
    
    stringPtr = GET_STRING(objPtr);
    
    /* Check that we're not extending a pure unicode string */
    
    if (length > (int) stringPtr->allocated && 
	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
	char *new;

	/*
	 * Not enough space in current string. Reallocate the string
	 * space and free the old string.
	 */
	if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
	    new = (char *) ckrealloc((char *)objPtr->bytes,
		    (unsigned)(length+1));
	} else {
	    new = (char *) ckalloc((unsigned) (length+1));
	    if (objPtr->bytes != NULL && objPtr->length != 0) {
		memcpy((VOID *) new, (VOID *) objPtr->bytes,
			(size_t) objPtr->length);
		Tcl_InvalidateStringRep(objPtr);
	    }
	}
	objPtr->bytes = new;
	stringPtr->allocated = length;
	/* Invalidate the unicode data. */
	stringPtr->hasUnicode = 0;
    }
    
    if (objPtr->bytes != NULL) {
        objPtr->length = length;
        if (objPtr->bytes != tclEmptyStringRep) {
            /* Ensure the string is NULL-terminated */
            objPtr->bytes[length] = 0;
        }
        /* Invalidate the unicode data. */
        stringPtr->numChars = -1;
        stringPtr->hasUnicode = 0;
    } else {
        /* Changing length of pure unicode string */
        size_t uallocated = STRING_UALLOC(length);
        if (uallocated > stringPtr->uallocated) {
            stringPtr = (String *) ckrealloc((char*) stringPtr,
                    STRING_SIZE(uallocated));
            SET_STRING(objPtr, stringPtr);
            stringPtr->uallocated = uallocated;
        }
        stringPtr->numChars = length;
        stringPtr->hasUnicode = (length > 0);
        /* Ensure the string is NULL-terminated */
        stringPtr->unicode[length] = 0;
        stringPtr->allocated = 0;
        objPtr->length = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptSetObjLength --
 *
 *	This procedure changes the length of the string representation
 *	of an object.  It uses the attempt* (non-panic'ing) memory allocators.
 *
 * Results:
 *	1 if the requested memory was allocated, 0 otherwise.
 *
 * Side effects:
 *	If the size of objPtr's string representation is greater than
 *	length, then it is reduced to length and a new terminating null
 *	byte is stored in the strength.  If the length of the string
 *	representation is greater than length, the storage space is
 *	reallocated to the given length; a null byte is stored at the
 *	end, but other bytes past the end of the original string
 *	representation are undefined.  The object's internal
 *	representation is changed to "expendable string".
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AttemptSetObjLength(objPtr, length)
    register Tcl_Obj *objPtr;	/* Pointer to object.  This object must
				 * not currently be shared. */
    register int length;	/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	panic("Tcl_AttemptSetObjLength called with shared object");
    }
    SetStringFromAny(NULL, objPtr);
        
    stringPtr = GET_STRING(objPtr);

    /* Check that we're not extending a pure unicode string */

    if (length > (int) stringPtr->allocated && 
	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
	char *new;

	/*
	 * Not enough space in current string. Reallocate the string
	 * space and free the old string.
	 */
	if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
	    new = (char *) attemptckrealloc((char *)objPtr->bytes,
		    (unsigned)(length+1));
	    if (new == NULL) {
		return 0;
	    }
	} else {
	    new = (char *) attemptckalloc((unsigned) (length+1));
	    if (new == NULL) {
		return 0;
	    }
	    if (objPtr->bytes != NULL && objPtr->length != 0) {
 	    	memcpy((VOID *) new, (VOID *) objPtr->bytes,
 		    	(size_t) objPtr->length);
 	    	Tcl_InvalidateStringRep(objPtr);
	    }
	}
	objPtr->bytes = new;
	stringPtr->allocated = length;
	/* Invalidate the unicode data. */
	stringPtr->hasUnicode = 0;
    }
    
    if (objPtr->bytes != NULL) {
	objPtr->length = length;
	if (objPtr->bytes != tclEmptyStringRep) {
	    /* Ensure the string is NULL-terminated */
	    objPtr->bytes[length] = 0;
	}
	/* Invalidate the unicode data. */
	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/* Changing length of pure unicode string */
	size_t uallocated = STRING_UALLOC(length);
	if (uallocated > stringPtr->uallocated) {
	    stringPtr = (String *) attemptckrealloc((char*) stringPtr,
		    STRING_SIZE(uallocated));
	    if (stringPtr == NULL) {
	        return 0;
	    }
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->uallocated = uallocated;
	}
	stringPtr->numChars = length;
	stringPtr->hasUnicode = (length > 0);
	/* Ensure the string is NULL-terminated */
	stringPtr->unicode[length] = 0;
	stringPtr->allocated = 0;
	objPtr->length = 0;
    }
    return 1;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclSetUnicodeObj --
 *
 *	Modify an object to hold the Unicode string indicated by "unicode".
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory allocated for new "String" internal rep.