diff options
Diffstat (limited to 'generic/tclStringObj.c')
| -rw-r--r-- | generic/tclStringObj.c | 655 |
1 files changed, 0 insertions, 655 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c deleted file mode 100644 index c0261c7..0000000 --- a/generic/tclStringObj.c +++ /dev/null @@ -1,655 +0,0 @@ -/* - * 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.4 1999/04/16 00:46:53 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) - CONST char *bytes; /* Points to the first of the length bytes - * used to initialize the new object. */ - 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) - CONST char *bytes; /* Points to the first of the length bytes - * used to initialize the new object. */ - 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) - CONST char *bytes; /* Points to the first of the length bytes - * used to initialize the new object. */ - 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) - CONST 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 = (bytes? strlen(bytes) : 0); - } - 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 = (bytes? strlen(bytes) : 0); - } - 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_AppendObjToObj -- - * - * This procedure appends the string rep of one object to another. - * - * Results: - * None. - * - * Side effects: - * The string rep of appendObjPtr is appended to the string - * representation of objPtr. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AppendObjToObj(objPtr, appendObjPtr) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - Tcl_Obj *appendObjPtr; /* Object to append. */ -{ - int length; - char *stringRep; - - stringRep = Tcl_GetStringFromObj(appendObjPtr, &length); - Tcl_AppendToObj(objPtr, stringRep, length); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AppendStringsToObjVA -- - * - * 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_AppendStringsToObjVA (objPtr, argList) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - va_list argList; /* Variable argument list. */ -{ - va_list tmpArgList; - int newLength, oldLength; - register char *string, *dst; - - 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. - */ - - tmpArgList = argList; - newLength = oldLength = objPtr->length; - while (1) { - string = va_arg(tmpArgList, 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. - */ - - 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; -} - -/* - *---------------------------------------------------------------------- - * - * 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) -{ - register Tcl_Obj *objPtr; - va_list argList; - - objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList); - Tcl_AppendStringsToObjVA(objPtr, argList); - 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; -} |