diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tcl.h | 4 | ||||
| -rw-r--r-- | generic/tclCkalloc.c | 123 |
3 files changed, 134 insertions, 3 deletions
@@ -7,6 +7,16 @@ the makefile. Should probably be updated to use its real version at some point. [Patch #102560, Bug #119421] +2000-12-06 eric melski <ericm@ajubasolutions.com> + + * generic/tcl.h (attemptckalloc): Fixed typo for #define of + attemptckalloc (was defined to Tcl_AttempDbCkalloc, should have + been Tcl_AttemptDbCkalloc). [Bug: 124384] + + * generic/tclCkalloc.c: Added + TCL_MEM_DEBUG versions of Tcl_AttemptDbCkrealloc and + Tcl_AttemptDbCkalloc. [Bug: 124384]. + 2000-11-24 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tclExecute.c (TclExecuteByteCode): Logical negation "!" diff --git a/generic/tcl.h b/generic/tcl.h index 2c5dab7..c8f527e 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.84 2000/12/07 22:20:31 hobbs Exp $ + * RCS: @(#) $Id: tcl.h,v 1.85 2000/12/08 04:22:43 ericm Exp $ */ #ifndef _TCL @@ -1355,7 +1355,7 @@ typedef int (Tcl_DriverHandlerProc) _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 attemptckalloc(x) Tcl_AttemptDbCkalloc(x, __FILE__, __LINE__) # define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__) #else /* !TCL_MEM_DEBUG */ diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index c0d79e4..4293a93 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.9 2000/09/14 18:42:30 ericm Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.10 2000/12/08 04:22:43 ericm Exp $ */ #include "tclInt.h" @@ -445,6 +445,92 @@ Tcl_DbCkalloc(size, file, line) return result->body; } + +char * +Tcl_AttemptDbCkalloc(size, file, line) + unsigned int size; + char *file; + int line; +{ + struct mem_header *result; + + if (validate_memory) + Tcl_ValidateAllMemory (file, line); + + result = (struct mem_header *) TclpAlloc((unsigned)size + + sizeof(struct mem_header) + HIGH_GUARD_SIZE); + if (result == NULL) { + fflush(stdout); + TclDumpMemoryInfo(stderr); + return NULL; + } + + /* + * Fill in guard zones and size. Also initialize the contents of + * the block with bogus bytes to detect uses of initialized data. + * Link into allocated list. + */ + if (init_malloced_bodies) { + memset ((VOID *) result, GUARD_VALUE, + size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); + } else { + memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); + memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); + } + if (!ckallocInit) { + TclInitDbCkalloc(); + } + Tcl_MutexLock(ckallocMutexPtr); + result->length = size; + result->tagPtr = curTagPtr; + if (curTagPtr != NULL) { + curTagPtr->refCount++; + } + result->file = file; + result->line = line; + result->flink = allocHead; + result->blink = NULL; + + if (allocHead != NULL) + allocHead->blink = result; + allocHead = result; + + total_mallocs++; + if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { + (void) fflush(stdout); + fprintf(stderr, "reached malloc trace enable point (%d)\n", + total_mallocs); + fflush(stderr); + alloc_tracing = TRUE; + trace_on_at_malloc = 0; + } + + if (alloc_tracing) + fprintf(stderr,"ckalloc %lx %d %s %d\n", + (long unsigned int) result->body, size, file, line); + + if (break_on_malloc && (total_mallocs >= break_on_malloc)) { + break_on_malloc = 0; + (void) fflush(stdout); + fprintf(stderr,"reached malloc break limit (%d)\n", + total_mallocs); + fprintf(stderr, "program will now enter C debugger\n"); + (void) fflush(stderr); + abort(); + } + + current_malloc_packets++; + if (current_malloc_packets > maximum_malloc_packets) + maximum_malloc_packets = current_malloc_packets; + current_bytes_malloced += size; + if (current_bytes_malloced > maximum_bytes_malloced) + maximum_bytes_malloced = current_bytes_malloced; + + Tcl_MutexUnlock(ckallocMutexPtr); + + return result->body; +} + /* *---------------------------------------------------------------------- @@ -572,6 +658,41 @@ Tcl_DbCkrealloc(ptr, size, file, line) return new; } +char * +Tcl_AttemptDbCkrealloc(ptr, size, file, line) + char *ptr; + unsigned int size; + char *file; + int line; +{ + char *new; + unsigned int copySize; + struct mem_header *memp; + + if (ptr == NULL) { + return Tcl_AttemptDbCkalloc(size, file, line); + } + + /* + * See comment from Tcl_DbCkfree before you change the following + * line. + */ + + memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); + + copySize = size; + if (copySize > (unsigned int) memp->length) { + copySize = memp->length; + } + new = Tcl_AttemptDbCkalloc(size, file, line); + if (new == NULL) { + return NULL; + } + memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize); + Tcl_DbCkfree(ptr, file, line); + return new; +} + /* *---------------------------------------------------------------------- |