Logo Search packages:      
Sourcecode: tcl8.0 version File versions  Download package

tclStringObj.c

/* 
 * tclStringObj.c --
 *
 *    This file contains procedures that implement string operations
 *    on Tcl objects.  To do this efficiently (i.e. to allow many
 *    appends to be done to an object without constantly reallocating
 *    the space for the string representation) we overallocate the
 *    space for the string and use the internal representation to keep
 *    track of the extra space.  Objects with this internal
 *    representation are called "expandable string objects".
 *
 * 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.
 *
 * RCS: @(#) $Id: tclStringObj.c,v 1.2 1998/09/14 18:40:02 stanton Exp $
 */

#include "tclInt.h"

/*
 * Prototypes for procedures defined later in this file:
 */

static void       ConvertToStringType _ANSI_ARGS_((Tcl_Obj *objPtr));
static void       DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
                      Tcl_Obj *copyPtr));
static int        SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
                      Tcl_Obj *objPtr));
static void       UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));

/*
 * The structure below defines the string Tcl object type by means of
 * procedures that can be invoked by generic object code.
 */

Tcl_ObjType tclStringType = {
    "string",                       /* name */
    (Tcl_FreeInternalRepProc *) NULL,     /* freeIntRepProc */
    DupStringInternalRep,           /* dupIntRepProc */
    UpdateStringOfString,           /* updateStringProc */
    SetStringFromAny                /* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewStringObj --
 *
 *    This procedure is normally called when not debugging: i.e., when
 *    TCL_MEM_DEBUG is not defined. It creates a new string object and
 *    initializes it from the byte pointer and length arguments.
 *
 *    When TCL_MEM_DEBUG is defined, this procedure just returns the
 *    result of calling the debugging version Tcl_DbNewStringObj.
 *
 * Results:
 *    A newly created string object is returned that has ref count zero.
 *
 * Side effects:
 *    The new object's internal 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 type is set
 *    to NULL. An extra NULL is added to the end of the new object's byte
 *    array.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj

Tcl_Obj *
Tcl_NewStringObj(bytes, length)
    register char *bytes;     /* Points to the first of the length bytes
                         * used to initialize the new object. */
    register int length;      /* The number of bytes to copy from "bytes"
                         * when initializing the new object. If 
                         * negative, use bytes up to the first
                         * NULL byte. */
{
    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewStringObj(bytes, length)
    register char *bytes;     /* Points to the first of the length bytes
                         * used to initialize the new object. */
    register int length;      /* The number of bytes to copy from "bytes"
                         * when initializing the new object. If 
                         * negative, use bytes up to the first
                         * NULL byte. */
{
    register Tcl_Obj *objPtr;

    if (length < 0) {
      length = (bytes? strlen(bytes) : 0);
    }
    TclNewObj(objPtr);
    TclInitStringRep(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbNewStringObj --
 *
 *    This procedure is normally called when debugging: i.e., when
 *    TCL_MEM_DEBUG is defined. It creates new string objects. It is the
 *    same as the Tcl_NewStringObj 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_NewStringObj.
 *
 * Results:
 *    A newly created string object is returned that has ref count zero.
 *
 * Side effects:
 *    The new object's internal 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 type is set
 *    to NULL. An extra NULL is added to the end of the new object's byte
 *    array.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewStringObj(bytes, length, file, line)
    register char *bytes;     /* Points to the first of the length bytes
                         * used to initialize the new object. */
    register int length;      /* The number of bytes to copy from "bytes"
                         * when initializing the new object. If 
                         * negative, use bytes up to the first
                         * NULL byte. */
    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;

    if (length < 0) {
      length = (bytes? strlen(bytes) : 0);
    }
    TclDbNewObj(objPtr, file, line);
    TclInitStringRep(objPtr, bytes, length);
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewStringObj(bytes, length, file, line)
    register char *bytes;     /* Points to the first of the length bytes
                         * used to initialize the new object. */
    register int length;      /* The number of bytes to copy from "bytes"
                         * when initializing the new object. If 
                         * negative, use bytes up to the first
                         * NULL byte. */
    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_NewStringObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * 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. */
    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");
    }

    Tcl_InvalidateStringRep(objPtr);
    if (length < 0) {
      length = strlen(bytes);
    }
    TclInitStringRep(objPtr, bytes, length);
        
    /*
     * 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_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. */
{
    char *new;

    if (Tcl_IsShared(objPtr)) {
      panic("Tcl_SetObjLength called with shared object");
    }
    if (objPtr->typePtr != &tclStringType) {
      ConvertToStringType(objPtr);
    }
    
    if ((long)length > objPtr->internalRep.longValue) {
      /*
       * Not enough space in current string. Reallocate the string
       * space and free the old string.
       */

      new = (char *) ckalloc((unsigned) (length+1));
      if (objPtr->bytes != NULL) {
          memcpy((VOID *) new, (VOID *) objPtr->bytes,
                (size_t) objPtr->length);
          Tcl_InvalidateStringRep(objPtr);
      }
      objPtr->bytes = new;
      objPtr->internalRep.longValue = (long) length;
    }
    objPtr->length = length;
    if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
      objPtr->bytes[length] = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendToObj --
 *
 *    This procedure appends a sequence of bytes to an object.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The bytes at *bytes are appended to the string representation
 *    of objPtr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendToObj(objPtr, bytes, length)
    register Tcl_Obj *objPtr; /* Points to the object to append to. */
    char *bytes;        /* Points to the bytes to append to the
                         * object. */
    register int length;      /* The number of bytes to append from
                         * "bytes". If < 0, then append all bytes
                         * up to NULL byte. */
{
    int newLength, oldLength;

    if (Tcl_IsShared(objPtr)) {
      panic("Tcl_AppendToObj called with shared object");
    }
    if (objPtr->typePtr != &tclStringType) {
      ConvertToStringType(objPtr);
    }
    if (length < 0) {
      length = strlen(bytes);
    }
    if (length == 0) {
      return;
    }
    oldLength = objPtr->length;
    newLength = length + oldLength;
    if ((long)newLength > objPtr->internalRep.longValue) {
      /*
       * There isn't currently enough space in the string
       * representation so allocate additional space.  In fact,
       * overallocate so that there is room for future growth without
       * having to reallocate again.
       */

      Tcl_SetObjLength(objPtr, 2*newLength);
    }
    if (length > 0) {
      memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
             (size_t) length);
      objPtr->length = newLength;
      objPtr->bytes[objPtr->length] = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendStringsToObj --
 *
 *    This procedure appends one or more null-terminated strings
 *    to an object.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The contents of all the string arguments are appended to the
 *    string representation of objPtr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
{
    va_list argList;
    register Tcl_Obj *objPtr;
    int newLength, oldLength;
    register char *string, *dst;

    objPtr = (Tcl_Obj *) TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
    if (Tcl_IsShared(objPtr)) {
      panic("Tcl_AppendStringsToObj called with shared object");
    }
    if (objPtr->typePtr != &tclStringType) {
      ConvertToStringType(objPtr);
    }

    /*
     * Figure out how much space is needed for all the strings, and
     * expand the string representation if it isn't big enough. If no
     * bytes would be appended, just return.
     */

    newLength = oldLength = objPtr->length;
    while (1) {
      string = va_arg(argList, char *);
      if (string == NULL) {
          break;
      }
      newLength += strlen(string);
    }
    if (newLength == oldLength) {
      return;
    }

    if ((long)newLength > objPtr->internalRep.longValue) {
      /*
       * There isn't currently enough space in the string
       * representation so allocate additional space.  If the current
       * string representation isn't empty (i.e. it looks like we're
       * doing a series of appends) then overallocate the space so
       * that we won't have to do as much reallocation in the future.
       */

      Tcl_SetObjLength(objPtr,
            (objPtr->length == 0) ? newLength : 2*newLength);
    }

    /*
     * Make a second pass through the arguments, appending all the
     * strings to the object.
     */

    TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
    dst = objPtr->bytes + oldLength;
    while (1) {
      string = va_arg(argList, char *);
      if (string == NULL) {
          break;
      }
      while (*string != 0) {
          *dst = *string;
          dst++;
          string++;
      }
    }

    /*
     * Add a null byte to terminate the string.  However, be careful:
     * it's possible that the object is totally empty (if it was empty
     * originally and there was nothing to append).  In this case dst is
     * NULL; just leave everything alone.
     */

    if (dst != NULL) {
      *dst = 0;
    }
    objPtr->length = newLength;
    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertToStringType --
 *
 *    This procedure converts the internal representation of an object
 *    to "expandable string" type.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Any old internal reputation for objPtr is freed and the
 *    internal representation is set to that for an expandable string
 *    (the field internalRep.longValue holds 1 less than the allocated
 *    length of objPtr's string representation).
 *
 *----------------------------------------------------------------------
 */

static void
ConvertToStringType(objPtr)
    register Tcl_Obj *objPtr; /* Pointer to object.  Must have a
                         * typePtr that isn't &tclStringType. */
{
    if (objPtr->typePtr != NULL) {
      if (objPtr->bytes == NULL) {
          objPtr->typePtr->updateStringProc(objPtr);
      }
      if (objPtr->typePtr->freeIntRepProc != NULL) {
          objPtr->typePtr->freeIntRepProc(objPtr);
      }
    }
    objPtr->typePtr = &tclStringType;
    if (objPtr->bytes != NULL) {
      objPtr->internalRep.longValue = (long)objPtr->length;
    } else {
      objPtr->internalRep.longValue = 0;
      objPtr->length = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupStringInternalRep --
 *
 *    Initialize the internal representation of a new Tcl_Obj to a
 *    copy of the internal representation of an existing string object.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    copyPtr's internal rep is set to a copy of srcPtr's internal
 *    representation.
 *
 *----------------------------------------------------------------------
 */

static void
DupStringInternalRep(srcPtr, copyPtr)
    register Tcl_Obj *srcPtr; /* Object with internal rep to copy.  Must
                         * have an internal representation of type
                         * "expandable string". */
    register Tcl_Obj *copyPtr;      /* Object with internal rep to set.  Must
                         * not currently have an internal rep.*/
{
    /*
     * Tricky point: the string value was copied by generic object
     * management code, so it doesn't contain any extra bytes that
     * might exist in the source object.
     */

    copyPtr->internalRep.longValue = (long)copyPtr->length;
    copyPtr->typePtr = &tclStringType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetStringFromAny --
 *
 *    Create an internal representation of type "expandable string"
 *    for an object.
 *
 * Results:
 *    This operation always succeeds and returns TCL_OK.
 *
 * Side effects:
 *    This procedure does nothing; there is no advantage in converting
 *    the internal representation now, so we just defer it.
 *
 *----------------------------------------------------------------------
 */

static int
SetStringFromAny(interp, objPtr)
    Tcl_Interp *interp;       /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;          /* The object to convert. */
{
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfString --
 *
 *    Update the string representation for an object whose internal
 *    representation is "expandable string".
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfString(objPtr)
    Tcl_Obj *objPtr;          /* Object with string rep to update. */
{
    /*
     * The string is almost always valid already, in which case there's
     * nothing for us to do. The only case we have to worry about is if
     * the object is totally null. In this case, set the string rep to
     * an empty string.
     */

    if (objPtr->bytes == NULL) {
      objPtr->bytes = tclEmptyStringRep;
      objPtr->length = 0;
    }
    return;
}

Generated by  Doxygen 1.6.0   Back to index