diff options
| -rw-r--r-- | ChangeLog | 26 | ||||
| -rw-r--r-- | doc/Alloc.3 | 14 | ||||
| -rw-r--r-- | doc/StringObj.3 | 15 | ||||
| -rw-r--r-- | generic/tcl.decls | 18 | ||||
| -rw-r--r-- | generic/tcl.h | 7 | ||||
| -rw-r--r-- | generic/tclCkalloc.c | 84 | ||||
| -rw-r--r-- | generic/tclDecls.h | 41 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 190 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 7 |
9 files changed, 341 insertions, 61 deletions
@@ -1,3 +1,29 @@ +2000-09-14 Eric Melski <ericm@ajubasolutions.com> + + * doc/Alloc.3: Added entries for Tcl_AttemptAlloc, Tcl_AttempRealloc. + + * doc/StringObj.3: Added entry for Tcl_AttemptSetObjLength. + + * generic/tclDecls.h: + * generic/tclStubInit.c: Regen'ed stubs files from new tcl.decls. + + * generic/tcl.decls: Added stubs for the Tcl_Attempt* memory + allocators and for Tcl_AttemptSetObjLength. + + * generic/tcl.h: Added #define's for attemptckalloc, + attemptckrealloc, which map to the Tcl_Attempt* memory allocators. + + * generic/tclCkalloc.c: Added non-panic'ing versions of Tcl_Alloc, + Tcl_Realloc, etc.; these are called Tcl_AttemptAlloc, + Tcl_AttemptRealloc, etc. These are used by + Tcl_AttemptSetObjLength and the string obj append functions. + + * generic/tclStringObj.c: Modified string growth algorithm to use + doubling algorithm as long as possible, and only fall back when + that fails. Added Tcl_AttemptSetObjLength, and modified + AppendUnicodeToUnicodeRep, AppendUtfToUtfRep, and + Tcl_AppendStringsToObjVA to support this. + 2000-09-07 David Gravereaux <davygrvy@ajubasolutions.com> * win/.cvsignore: changed the glob patterns a bit to exclude VC++ diff --git a/doc/Alloc.3 b/doc/Alloc.3 index 405d7fa..c7396a0 100644 --- a/doc/Alloc.3 +++ b/doc/Alloc.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Alloc.3,v 1.2 1998/09/14 18:39:45 stanton Exp $ +'\" RCS: @(#) $Id: Alloc.3,v 1.3 2000/09/14 18:42:28 ericm Exp $ '\" .so man.macros .TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures" @@ -22,6 +22,12 @@ char * .sp char * \fBTcl_Realloc\fR(\fIptr, size\fR) +.sp +int +\fBTcl_AttemptAlloc\fR(\fIsize\fR) +.sp +int +\fBTcl_AttemptRealloc\fR(\fIptr, size\fR) .SH ARGUMENTS .AS char *size .AP int size in @@ -48,5 +54,11 @@ further allocation. \fIptr\fR to \fIsize\fR bytes and returns a pointer to the new block. The contents will be unchanged up to the lesser of the new and old sizes. The returned location may be different from \fIptr\fR. +.PP +\fBTcl_AttemptAlloc\fR and \fBTcl_AttemptRealloc\fR are identical in +function to \fBTcl_Alloc\fR and \fBTcl_Realloc\fR, except that +\fBTcl_AttemptAlloc\fR and \fBTcl_AttemptRealloc\fR will not cause the Tcl +interpreter to \fBpanic\fR if the memory allocation fails. If the +allocation fails, these functions will return NULL. .SH KEYWORDS alloc, allocation, free, malloc, memory, realloc diff --git a/doc/StringObj.3 b/doc/StringObj.3 index d195362..23273d0 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: StringObj.3,v 1.5 1999/06/15 01:16:21 hershey Exp $ +'\" RCS: @(#) $Id: StringObj.3,v 1.6 2000/09/14 18:42:29 ericm Exp $ '\" .so man.macros .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures" @@ -71,6 +71,9 @@ void void \fBTcl_SetObjLength\fR(\fIobjPtr, newLength\fR) .sp +int +\fBTcl_AttemptSetObjLength\fR(\fIobjPtr, newLength\fR) +.sp Tcl_Obj * \fBTcl_ConcatObj\fR(\fIobjc, objv\fR) .SH ARGUMENTS @@ -227,6 +230,16 @@ enlarged in a subsequent call to \fBTcl_SetObjLength\fR without reallocating storage. In all cases \fBTcl_SetObjLength\fR leaves a null character at \fIobjPtr->bytes[newLength]\fR. .PP +\fBTcl_AttemptSetObjLength\fR is identical in function to +\fBTcl_SetObjLength\fR except that if sufficient memory to satisfy the +request cannot be allocated, it does not cause the Tcl interpreter to +\fBpanic\fR. Thus, if \fInewLength\fR is greater than the space +allocated for the object's string, and there is not enough memory +available to satisfy the request, \fBTcl_AttemptSetObjLength\fR will take +no action and return 0 to indicate failure. If there is enough memory +to satisfy the request, \fBTcl_AttemptSetObjLength\fR behaves just like +\fBTcl_SetObjLength\fR and returns 1 to indicate success. +.PP The \fBTcl_ConcatObj\fR function returns a new string object whose value is the space-separated concatenation of the string representations of all of the objects in the \fIobjv\fR diff --git a/generic/tcl.decls b/generic/tcl.decls index e71c6ee..d40d50d 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.39 2000/08/25 02:04:27 ericm Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.40 2000/09/14 18:42:29 ericm Exp $ library tcl @@ -1418,6 +1418,22 @@ declare 409 generic { void Tcl_UntraceCommand(Tcl_Interp *interp, char *varName, int flags, \ Tcl_CommandTraceProc *proc, ClientData clientData) } +declare 410 generic { + char * Tcl_AttemptAlloc(unsigned int size) +} +declare 411 generic { + char * Tcl_AttemptDbCkalloc(unsigned int size, char *file, int line) +} +declare 412 generic { + char * Tcl_AttemptRealloc(char *ptr, unsigned int size) +} +declare 413 generic { + char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, char *file, + int line) +} +declare 414 generic { + int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length) +} ############################################################################## diff --git a/generic/tcl.h b/generic/tcl.h index 22f4f88..5d239e9 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.78 2000/09/06 18:50:15 hobbs Exp $ + * RCS: @(#) $Id: tcl.h,v 1.79 2000/09/14 18:42:29 ericm Exp $ */ #ifndef _TCL @@ -1341,7 +1341,8 @@ typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_(( # define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__) # define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__) # define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__) - +# define attemptckalloc(x) Tcl_AttempDbCkalloc(x, __FILE__, __LINE__) +# define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__) #else /* !TCL_MEM_DEBUG */ /* @@ -1354,6 +1355,8 @@ typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_(( # define ckalloc(x) Tcl_Alloc(x) # define ckfree(x) Tcl_Free(x) # define ckrealloc(x,y) Tcl_Realloc(x,y) +# define attemptckalloc(x) Tcl_AttemptAlloc(x) +# define attemptckrealloc(x,y) Tcl_AttemptRealloc(x,y) # define Tcl_InitMemory(x) # define Tcl_DumpActiveMemory(x) # define Tcl_ValidateAllMemory(x,y) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index a85a0fd..c0d79e4 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -13,7 +13,7 @@ * * This code contributed by Karl Lehenbauer and Mark Diekhans * - * RCS: @(#) $Id: tclCkalloc.c,v 1.8 2000/04/27 01:47:01 ericm Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.9 2000/09/14 18:42:30 ericm Exp $ */ #include "tclInt.h" @@ -593,6 +593,8 @@ Tcl_DbCkrealloc(ptr, size, file, line) #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc +#undef Tcl_AttemptAlloc +#undef Tcl_AttemptRealloc char * Tcl_Alloc(size) @@ -601,6 +603,13 @@ Tcl_Alloc(size) return Tcl_DbCkalloc(size, "unknown", 0); } +char * +Tcl_AttemptAlloc(size) + unsigned int size; +{ + return Tcl_AttemptDbCkalloc(size, "unknown", 0); +} + void Tcl_Free(ptr) char *ptr; @@ -615,6 +624,13 @@ Tcl_Realloc(ptr, size) { return Tcl_DbCkrealloc(ptr, size, "unknown", 0); } +char * +Tcl_AttemptRealloc(ptr, size) + char *ptr; + unsigned int size; +{ + return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0); +} /* *---------------------------------------------------------------------- @@ -875,6 +891,38 @@ Tcl_DbCkalloc(size, file, line) } return result; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_AttemptAlloc -- + * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not + * check that memory was actually allocated. + * + *---------------------------------------------------------------------- + */ + +char * +Tcl_AttemptAlloc (size) + unsigned int size; +{ + char *result; + + result = TclpAlloc(size); + return result; +} + +char * +Tcl_AttemptDbCkalloc(size, file, line) + unsigned int size; + char *file; + int line; +{ + char *result; + + result = (char *) TclpAlloc(size); + return result; +} /* @@ -923,6 +971,40 @@ Tcl_DbCkrealloc(ptr, size, file, line) /* *---------------------------------------------------------------------- * + * Tcl_AttemptRealloc -- + * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does + * not check that memory was actually allocated. + * + *---------------------------------------------------------------------- + */ + +char * +Tcl_AttemptRealloc(ptr, size) + char *ptr; + unsigned int size; +{ + char *result; + + result = TclpRealloc(ptr, size); + return result; +} + +char * +Tcl_AttemptDbCkrealloc(ptr, size, file, line) + char *ptr; + unsigned int size; + char *file; + int line; +{ + char *result; + + result = (char *) TclpRealloc(ptr, size); + return result; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_Free -- * Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here * rather in the macro to keep some modules from being compiled with diff --git a/generic/tclDecls.h b/generic/tclDecls.h index fd355df..9b2f9a8 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.40 2000/08/25 02:04:28 ericm Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.41 2000/09/14 18:42:31 ericm Exp $ */ #ifndef _TCLDECLS @@ -1283,6 +1283,20 @@ EXTERN void Tcl_UntraceCommand _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); +/* 410 */ +EXTERN char * Tcl_AttemptAlloc _ANSI_ARGS_((unsigned int size)); +/* 411 */ +EXTERN char * Tcl_AttemptDbCkalloc _ANSI_ARGS_((unsigned int size, + char * file, int line)); +/* 412 */ +EXTERN char * Tcl_AttemptRealloc _ANSI_ARGS_((char * ptr, + unsigned int size)); +/* 413 */ +EXTERN char * Tcl_AttemptDbCkrealloc _ANSI_ARGS_((char * ptr, + unsigned int size, char * file, int line)); +/* 414 */ +EXTERN int Tcl_AttemptSetObjLength _ANSI_ARGS_(( + Tcl_Obj * objPtr, int length)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -1760,6 +1774,11 @@ typedef struct TclStubs { ClientData (*tcl_CommandTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * procPtr, ClientData prevClientData)); /* 407 */ int (*tcl_TraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 408 */ void (*tcl_UntraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 409 */ + char * (*tcl_AttemptAlloc) _ANSI_ARGS_((unsigned int size)); /* 410 */ + char * (*tcl_AttemptDbCkalloc) _ANSI_ARGS_((unsigned int size, char * file, int line)); /* 411 */ + char * (*tcl_AttemptRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 412 */ + char * (*tcl_AttemptDbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, char * file, int line)); /* 413 */ + int (*tcl_AttemptSetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 414 */ } TclStubs; #ifdef __cplusplus @@ -3445,6 +3464,26 @@ extern TclStubs *tclStubsPtr; #define Tcl_UntraceCommand \ (tclStubsPtr->tcl_UntraceCommand) /* 409 */ #endif +#ifndef Tcl_AttemptAlloc +#define Tcl_AttemptAlloc \ + (tclStubsPtr->tcl_AttemptAlloc) /* 410 */ +#endif +#ifndef Tcl_AttemptDbCkalloc +#define Tcl_AttemptDbCkalloc \ + (tclStubsPtr->tcl_AttemptDbCkalloc) /* 411 */ +#endif +#ifndef Tcl_AttemptRealloc +#define Tcl_AttemptRealloc \ + (tclStubsPtr->tcl_AttemptRealloc) /* 412 */ +#endif +#ifndef Tcl_AttemptDbCkrealloc +#define Tcl_AttemptDbCkrealloc \ + (tclStubsPtr->tcl_AttemptDbCkrealloc) /* 413 */ +#endif +#ifndef Tcl_AttemptSetObjLength +#define Tcl_AttemptSetObjLength \ + (tclStubsPtr->tcl_AttemptSetObjLength) /* 414 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 3bdefbd..a20fa06 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * 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.18 2000/08/30 01:43:00 ericm Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.19 2000/09/14 18:42:31 ericm Exp $ */ #include "tclInt.h" @@ -113,42 +113,35 @@ typedef struct String { * * When growing strings (during an append, for example), the following growth * algorithm is used: - * if (oldSpace + appendLength < TCL_GROWTH_LARGE_STRING) { - * newSpace = 2 * (oldSpace + appendLength) - * } else { - * newSpace = (2 * appendLength) + TCL_GROWTH_MIN_ALLOC + oldSpace - * } - * - * This allows more efficient use of memory for large strings; if the - * doubling algorithm were used after TCL_GROWTH_LARGE_STRING, the - * maximum string size in Tcl would be about 1/2 the size of available - * memory. With this adaptive algorithm, effectively all of available memory - * can be allocated. * + * Attempt to allocate 2 * (originalLength + appendLength) + * On failure: + * attempt to allocate originalLength + 2*appendLength + + * TCL_GROWTH_MIN_ALLOC + * + * This algorithm allows very good performance, as it rapidly increases the + * memory allocated for a given string, which minimizes the number of + * reallocations that must be performed. However, using only the doubling + * algorithm can lead to a significant waste of memory. In particular, it + * may fail even when there is sufficient memory available to complete the + * append request (but there is not 2 * totalLength memory available). So when + * the doubling fails (because there is not enough memory available), the + * algorithm requests a smaller amount of memory, which is still enough to + * cover the request, but which hopefully will be less than the total available + * memory. + * * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling * of very small appends. Without this extra slush factor, a sequence * of several small appends would cause several memory allocations. * As long as TCL_GROWTH_MIN_ALLOC is a reasonable size, we can * avoid that behavior. * - * We do NOT use TCL_GROWTH_MIN_ALLOC for strings smaller than - * TCL_GROWTH_LARGE_STRING simply because we want our small strings - * to stay small; an allocation of TCL_GROWTH_MIN_ALLOC for a string - * that is only a few bytes long is wasteful. - * * The growth algorithm can be tuned by adjusting the following parameters: * - * TCL_GROWTH_LARGE_STRING Cutoff point, in bytes, at which to switch - * from the doubling algorithm to the adaptive. - * algorithm. Default is 1048576 (1 megabyte) - * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate with - * each allocation for strings larger than - * TCL_GROWTH_LARGE_STRING. + * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when + * the double allocation has failed. * Default is 1024 (1 kilobyte). */ -#ifndef TCL_GROWTH_LARGE_STRING -#define TCL_GROWTH_LARGE_STRING 1048576 -#endif #ifndef TCL_GROWTH_MIN_ALLOC #define TCL_GROWTH_MIN_ALLOC 1024 #endif @@ -715,10 +708,7 @@ Tcl_SetObjLength(objPtr, length) if (objPtr->bytes != tclEmptyStringRep) { new = (char *) ckrealloc((char *)objPtr->bytes, (unsigned)(length+1)); - } else { - new = NULL; - } - if (new == NULL) { + } else { new = (char *) ckalloc((unsigned) (length+1)); if (objPtr->bytes != NULL && objPtr->length != 0) { memcpy((VOID *) new, (VOID *) objPtr->bytes, @@ -737,6 +727,88 @@ Tcl_SetObjLength(objPtr, length) } /* + *---------------------------------------------------------------------- + * + * 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. */ +{ + char *new; + String *stringPtr; + + if (Tcl_IsShared(objPtr)) { + panic("Tcl_AttemptSetObjLength called with shared object"); + } + SetStringFromAny(NULL, objPtr); + + /* + * Invalidate the unicode data. + */ + + stringPtr = GET_STRING(objPtr); + stringPtr->numChars = -1; + stringPtr->uallocated = 0; + + if (length > (int) stringPtr->allocated) { + + /* + * Not enough space in current string. Reallocate the string + * space and free the old string. + */ + if (objPtr->bytes != tclEmptyStringRep) { + 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; + } + + objPtr->length = length; + if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) { + objPtr->bytes[length] = 0; + } + return 1; +} + +/* *--------------------------------------------------------------------------- * * TclSetUnicodeObj -- @@ -1016,7 +1088,7 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) Tcl_UniChar *unicode; /* String to append. */ int appendNumChars; /* Number of chars of "unicode" to append. */ { - String *stringPtr; + String *stringPtr, *tmpString; size_t numChars; if (appendNumChars < 0) { @@ -1034,19 +1106,25 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) /* * If not enough space has been allocated for the unicode rep, - * reallocate the internal rep object with additional space. See the - * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an - * explanation of the growth algorithm. + * reallocate the internal rep object with additional space. First try to + * double the required allocation; if that fails, try a more modest + * increase. See the "TCL STRING GROWTH ALGORITHM" comment at the top of + * this file for an explanation of this growth algorithm. */ numChars = stringPtr->numChars + appendNumChars; if (numChars >= stringPtr->uallocated) { - stringPtr->uallocated = numChars + - (numChars >= TCL_GROWTH_LARGE_STRING ? - (2 * appendNumChars) + TCL_GROWTH_MIN_ALLOC : numChars); - stringPtr = (String *) ckrealloc((char*)stringPtr, + stringPtr->uallocated = 2 * numChars; + tmpString = (String *) attemptckrealloc((char *)stringPtr, STRING_SIZE(stringPtr->uallocated)); + if (tmpString == NULL) { + stringPtr->uallocated = + numChars + appendNumChars + TCL_GROWTH_MIN_ALLOC; + tmpString = (String *) ckrealloc((char *)stringPtr, + STRING_SIZE(stringPtr->uallocated)); + } + stringPtr = tmpString; SET_STRING(objPtr, stringPtr); } @@ -1193,14 +1271,16 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes) /* * There isn't currently enough space in the string representation - * so allocate additional space. See the "TCL STRING GROWTH ALGORITHM" - * comment at the top of this file for an explanation of the growth - * algorithm. + * so allocate additional space. First, try to double the length + * required. If that fails, try a more modest allocation. See the + * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an + * explanation of this growth algorithm. */ - Tcl_SetObjLength(objPtr, newLength + - (newLength >= TCL_GROWTH_LARGE_STRING ? - (2 * numBytes) + TCL_GROWTH_MIN_ALLOC : newLength)); + if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) { + Tcl_SetObjLength(objPtr, + newLength + numBytes + TCL_GROWTH_MIN_ALLOC); + } } else { /* @@ -1242,7 +1322,7 @@ Tcl_AppendStringsToObjVA (objPtr, argList) { #define STATIC_LIST_SIZE 16 String *stringPtr; - int newLength, oldLength; + int newLength, oldLength, attemptLength; register char *string, *dst; char *static_list[STATIC_LIST_SIZE]; char **args = static_list; @@ -1299,19 +1379,23 @@ Tcl_AppendStringsToObjVA (objPtr, argList) * 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 the growth algorithm described in - * the "TCL STRING GROWTH ALGORITHM" comment at the top of this file is - * used to determine how much memory to allocate. Otherwise, exactly - * enough memory is allocated. + * doing a series of appends) then try to allocate extra space to + * accomodate future growth: first try to double the required memory; + * if that fails, try a more modest allocation. See the "TCL STRING + * GROWTH ALGORITHM" comment at the top of this file for an explanation + * of this growth algorithm. Otherwise, if the current string + * representation is empty, exactly enough memory is allocated. */ if (oldLength == 0) { Tcl_SetObjLength(objPtr, newLength); - } else if (oldLength < TCL_GROWTH_LARGE_STRING) { - Tcl_SetObjLength(objPtr, 2 * (oldLength + newLength)); } else { - Tcl_SetObjLength(objPtr, - oldLength + (2 * newLength) + TCL_GROWTH_MIN_ALLOC); + attemptLength = 2 * (oldLength + newLength); + if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) { + attemptLength = oldLength + (2 * newLength) + + TCL_GROWTH_MIN_ALLOC; + Tcl_SetObjLength(objPtr, attemptLength); + } } } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index c927969..dbd5372 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.43 2000/08/25 02:04:29 ericm Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.44 2000/09/14 18:42:32 ericm Exp $ */ #include "tclInt.h" @@ -812,6 +812,11 @@ TclStubs tclStubs = { Tcl_CommandTraceInfo, /* 407 */ Tcl_TraceCommand, /* 408 */ Tcl_UntraceCommand, /* 409 */ + Tcl_AttemptAlloc, /* 410 */ + Tcl_AttemptDbCkalloc, /* 411 */ + Tcl_AttemptRealloc, /* 412 */ + Tcl_AttemptDbCkrealloc, /* 413 */ + Tcl_AttemptSetObjLength, /* 414 */ }; /* !END!: Do not edit above this line. */ |