diff options
Diffstat (limited to 'generic/tclObj.c')
| -rw-r--r-- | generic/tclObj.c | 250 |
1 files changed, 217 insertions, 33 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c index c641152..338e027 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -17,6 +17,7 @@ #include "tclInt.h" #include "tommath.h" #include <math.h> +#include <assert.h> /* * Table of all object types. @@ -1061,9 +1062,8 @@ TclDbInitNewObj( * debugging. */ { objPtr->refCount = 0; - objPtr->bytes = tclEmptyStringRep; - objPtr->length = 0; objPtr->typePtr = NULL; + TclInitStringRep(objPtr, NULL, 0); #ifdef TCL_THREADS /* @@ -1700,6 +1700,92 @@ Tcl_GetStringFromObj( /* *---------------------------------------------------------------------- * + * Tcl_InitStringRep -- + * + * This function is called in several configurations to provide all + * the tools needed to set an object's string representation. The + * function is determined by the arguments. + * + * (objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0) + * Invalid call -- panic! + * + * objPtr->bytes == NULL && bytes == NULL && numBytes >= 0 + * Allocation only - allocate space for (numBytes+1) chars. + * store in objPtr->bytes and return. Also sets + * objPtr->length to 0 and objPtr->bytes[0] to NUL. + * + * objPtr->bytes == NULL && bytes != NULL && numBytes >= 0 + * Allocate and copy. bytes is assumed to point to chars to + * copy into the string rep. objPtr->length = numBytes. Allocate + * array of (numBytes + 1) chars. store in objPtr->bytes. Copy + * numBytes chars from bytes to objPtr->bytes; Set + * objPtr->bytes[numBytes] to NUL and return objPtr->bytes. + * Caller must guarantee there are numBytes chars at bytes to + * be copied. + * + * objPtr->bytes != NULL && bytes == NULL && numBytes >= 0 + * Truncate. Set objPtr->length to numBytes and + * objPr->bytes[numBytes] to NUL. Caller has to guarantee + * that a prior allocating call allocated enough bytes for + * this to be valid. Return objPtr->bytes. + * + * Caller is expected to ascertain that the bytes copied into + * the string rep make up complete valid UTF-8 characters. + * + * Results: + * A pointer to the string rep of objPtr. + * + * Side effects: + * As described above. + * + *---------------------------------------------------------------------- + */ + +char * +Tcl_InitStringRep( + Tcl_Obj *objPtr, /* Object whose string rep is to be set */ + const char *bytes, + unsigned int numBytes) +{ + assert(objPtr->bytes == NULL || bytes == NULL); + + if (numBytes > INT_MAX) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + + /* Allocate */ + if (objPtr->bytes == NULL) { + /* Allocate only as empty - extend later if bytes copied */ + objPtr->length = 0; + if (numBytes) { + objPtr->bytes = attemptckalloc(numBytes + 1); + if (objPtr->bytes == NULL) { + return NULL; + } + if (bytes) { + /* Copy */ + memcpy(objPtr->bytes, bytes, numBytes); + objPtr->length = (int) numBytes; + } + } else { + objPtr->bytes = tclEmptyStringRep; + return NULL; + } + } else { + /* objPtr->bytes != NULL bytes == NULL - Truncate */ + objPtr->bytes = ckrealloc(objPtr->bytes, numBytes + 1); + objPtr->length = (int)numBytes; + } + + /* Terminate */ + objPtr->bytes[objPtr->length] = '\0'; + + return objPtr->bytes; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_InvalidateStringRep -- * * This function is called to invalidate an object's string @@ -1726,6 +1812,104 @@ Tcl_InvalidateStringRep( /* *---------------------------------------------------------------------- * + * Tcl_StoreIntRep -- + * + * This function is called to set the object's internal + * representation to match a particular type. + * + * It is the caller's responsibility to guarantee that + * the value of the submitted IntRep is in agreement with + * the value of any existing string rep. + * + * Results: + * None. + * + * Side effects: + * Calls the freeIntRepProc of the current Tcl_ObjType, if any. + * Sets the internalRep and typePtr fields to the submitted values. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_StoreIntRep( + Tcl_Obj *objPtr, /* Object whose internal rep should be set. */ + const Tcl_ObjType *typePtr, /* New type for the object */ + const Tcl_ObjIntRep *irPtr) /* New IntRep for the object */ +{ + /* Clear out any existing IntRep ( "shimmer" ) */ + TclFreeIntRep(objPtr); + + /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */ + if (irPtr) { + /* Copy the new IntRep into place */ + objPtr->internalRep = *irPtr; + + /* Set the type to match */ + objPtr->typePtr = typePtr; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_FetchIntRep -- + * + * This function is called to retrieve the object's internal + * representation matching a requested type, if any. + * + * Results: + * A read-only pointer to the associated Tcl_ObjIntRep, or + * NULL if no such internal representation exists. + * + * Side effects: + * Calls the freeIntRepProc of the current Tcl_ObjType, if any. + * Sets the internalRep and typePtr fields to the submitted values. + * + *---------------------------------------------------------------------- + */ + +Tcl_ObjIntRep * +Tcl_FetchIntRep( + Tcl_Obj *objPtr, /* Object to fetch from. */ + const Tcl_ObjType *typePtr) /* Requested type */ +{ + /* If objPtr type doesn't match request, nothing can be fetched */ + if (objPtr->typePtr != typePtr) { + return NULL; + } + + /* Type match! objPtr IntRep is the one sought. */ + return &(objPtr->internalRep); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_FreeIntRep -- + * + * This function is called to free an object's internal representation. + * + * Results: + * None. + * + * Side effects: + * Calls the freeIntRepProc of the current Tcl_ObjType, if any. + * Sets typePtr field to NULL. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_FreeIntRep( + Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ +{ + TclFreeIntRep(objPtr); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_NewBooleanObj -- * * This function is normally called when not debugging: i.e., when @@ -1809,6 +1993,7 @@ Tcl_DbNewBooleanObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.longValue = (boolValue? 1 : 0); @@ -2201,6 +2386,7 @@ Tcl_DbNewDoubleObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.doubleValue = dblValue; @@ -2367,15 +2553,12 @@ static void UpdateStringOfDouble( register Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { - char buffer[TCL_DOUBLE_SPACE]; - register int len; + char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); - Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer); - len = strlen(buffer); + TclOOM(dst, TCL_DOUBLE_SPACE + 1); - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, buffer, (unsigned) len + 1); - objPtr->length = len; + Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst); + (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } /* @@ -2565,14 +2748,11 @@ static void UpdateStringOfInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { - char buffer[TCL_INTEGER_SPACE]; - register int len; + char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); - len = TclFormatInt(buffer, objPtr->internalRep.longValue); - - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, buffer, (unsigned) len + 1); - objPtr->length = len; + TclOOM(dst, TCL_INTEGER_SPACE + 1); + (void) Tcl_InitStringRep(objPtr, NULL, + TclFormatInt(dst, objPtr->internalRep.longValue)); } /* @@ -2676,6 +2856,7 @@ Tcl_DbNewLongObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep */ objPtr->bytes = NULL; objPtr->internalRep.longValue = longValue; @@ -2860,9 +3041,9 @@ static void UpdateStringOfWideInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { - char buffer[TCL_INTEGER_SPACE+2]; - register unsigned len; - register Tcl_WideInt wideVal = objPtr->internalRep.wideValue; + char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 2); + + TclOOM(dst, TCL_INTEGER_SPACE + 3); /* * Note that sprintf will generate a compiler warning under Mingw claiming @@ -2871,11 +3052,9 @@ UpdateStringOfWideInt( * value. */ - sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal); - len = strlen(buffer); - objPtr->bytes = ckalloc(len + 1); - memcpy(objPtr->bytes, buffer, len + 1); - objPtr->length = len; + sprintf(dst, "%" TCL_LL_MODIFIER "d", objPtr->internalRep.wideValue); + + (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } #endif /* !TCL_WIDE_INT_IS_LONG */ @@ -3245,12 +3424,10 @@ UpdateStringOfBignum( { mp_int bignumVal; int size; - int status; char *stringVal; UNPACK_BIGNUM(objPtr, bignumVal); - status = mp_radix_size(&bignumVal, 10, &size); - if (status != MP_OKAY) { + if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) { Tcl_Panic("radix size failure in UpdateStringOfBignum"); } if (size == 3) { @@ -3267,13 +3444,14 @@ UpdateStringOfBignum( Tcl_Panic("UpdateStringOfBignum: string length limit exceeded"); } - stringVal = ckalloc(size); - status = mp_toradix_n(&bignumVal, stringVal, 10, size); - if (status != MP_OKAY) { + + stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1); + + TclOOM(stringVal, size); + if (MP_OKAY != mp_toradix_n(&bignumVal, stringVal, 10, size)) { Tcl_Panic("conversion failure in UpdateStringOfBignum"); } - objPtr->bytes = stringVal; - objPtr->length = size - 1; /* size includes a trailing NUL byte. */ + (void) Tcl_InitStringRep(objPtr, NULL, size - 1); } /* @@ -3393,11 +3571,17 @@ GetBignumFromObj( mp_init_copy(bignumValue, &temp); } else { UNPACK_BIGNUM(objPtr, *bignumValue); + /* Optimized TclFreeIntRep */ objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = NULL; + /* + * TODO: If objPtr has a string rep, this leaves + * it undisturbed. Not clear that's proper. Pure + * bignum values are converted to empty string. + */ if (objPtr->bytes == NULL) { - TclInitStringRep(objPtr, tclEmptyStringRep, 0); + TclInitStringRep(objPtr, NULL, 0); } } return TCL_OK; |