diff options
Diffstat (limited to 'generic/tclCkalloc.c')
| -rw-r--r-- | generic/tclCkalloc.c | 891 |
1 files changed, 414 insertions, 477 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 5c0432d..a9d98ec 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1,21 +1,21 @@ /* * tclCkalloc.c -- * - * Interface to malloc and free that provides support for debugging - * problems involving overwritten, double freeing memory and loss of - * memory. + * Interface to malloc and free that provides support for debugging problems + * involving overwritten, double freeing memory and loss of memory. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * This code contributed by Karl Lehenbauer and Mark Diekhans */ #include "tclInt.h" +#include "tclPort.h" #define FALSE 0 #define TRUE 1 @@ -28,29 +28,29 @@ */ typedef struct MemTag { - int refCount; /* Number of mem_headers referencing this - * tag. */ - char string[4]; /* Actual size of string will be as large as - * needed for actual tag. This must be the - * last field in the structure. */ + int refCount; /* Number of mem_headers referencing + * this tag. */ + char string[4]; /* Actual size of string will be as + * large as needed for actual tag. This + * must be the last field in the structure. */ } MemTag; #define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3) -static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set - * by "memory tag" command). */ +static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers + * (set by "memory tag" command). */ /* - * One of the following structures is allocated just before each dynamically - * allocated chunk of memory, both to record information about the chunk and - * to help detect chunk under-runs. + * One of the following structures is allocated just before each + * dynamically allocated chunk of memory, both to record information + * about the chunk and to help detect chunk under-runs. */ #define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8) struct mem_header { struct mem_header *flink; struct mem_header *blink; - MemTag *tagPtr; /* Tag from "memory tag" command; may be + MemTag *tagPtr; /* Tag from "memory tag" command; may be * NULL. */ CONST char *file; long length; @@ -59,8 +59,9 @@ struct mem_header { /* Aligns body on 8-byte boundary, plus * provides at least 8 additional guard bytes * to detect underruns. */ - char body[1]; /* First byte of client's space. Actual size - * of this field will be larger than one. */ + char body[1]; /* First byte of client's space. Actual + * size of this field will be larger than + * one. */ }; static struct mem_header *allocHead = NULL; /* List of allocated structures */ @@ -68,16 +69,16 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */ #define GUARD_VALUE 0141 /* - * The following macro determines the amount of guard space *above* each chunk - * of memory. + * The following macro determines the amount of guard space *above* each + * chunk of memory. */ #define HIGH_GUARD_SIZE 8 /* * The following macro computes the offset of the "body" field within - * mem_header. It is used to get back to the header pointer from the body - * pointer that's used by clients. + * mem_header. It is used to get back to the header pointer from the + * body pointer that's used by clients. */ #define BODY_OFFSET \ @@ -85,25 +86,25 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */ static int total_mallocs = 0; static int total_frees = 0; -static size_t current_bytes_malloced = 0; -static size_t maximum_bytes_malloced = 0; +static int current_bytes_malloced = 0; +static int maximum_bytes_malloced = 0; static int current_malloc_packets = 0; static int maximum_malloc_packets = 0; static int break_on_malloc = 0; static int trace_on_at_malloc = 0; -static int alloc_tracing = FALSE; -static int init_malloced_bodies = TRUE; +static int alloc_tracing = FALSE; +static int init_malloced_bodies = TRUE; #ifdef MEM_VALIDATE -static int validate_memory = TRUE; + static int validate_memory = TRUE; #else -static int validate_memory = FALSE; + static int validate_memory = FALSE; #endif /* - * The following variable indicates to TclFinalizeMemorySubsystem() that it - * should dump out the state of memory before exiting. If the value is - * non-NULL, it gives the name of the file in which to dump memory usage - * information. + * The following variable indicates to TclFinalizeMemorySubsystem() + * that it should dump out the state of memory before exiting. If the + * value is non-NULL, it gives the name of the file in which to + * dump memory usage information. */ char *tclMemDumpFileName = NULL; @@ -113,11 +114,10 @@ static char dumpFile[100]; /* Records where to dump memory allocation * information. */ /* - * Mutex to serialize allocations. This is a low-level mutex that must be - * explicitly initialized. This is necessary because the self initializing - * mutexes use ckalloc... + * Mutex to serialize allocations. This is a low-level mutex that must + * be explicitly initialized. This is necessary because the self + * initializing mutexes use ckalloc... */ - static Tcl_Mutex *ckallocMutexPtr; static int ckallocInit = 0; @@ -125,27 +125,26 @@ static int ckallocInit = 0; * Prototypes for procedures defined in this file: */ -static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char *argv[]); -static int MemoryCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char *argv[]); -static void ValidateMemory(struct mem_header *memHeaderP, - CONST char *file, int line, int nukeGuards); +static int CheckmemCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, CONST char *argv[])); +static int MemoryCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv)); +static void ValidateMemory _ANSI_ARGS_(( + struct mem_header *memHeaderP, CONST char *file, + int line, int nukeGuards)); /* *---------------------------------------------------------------------- * * TclInitDbCkalloc -- - * - * Initialize the locks used by the allocator. This is only appropriate - * to call in a single threaded environment, such as during - * TclInitSubsystems. + * Initialize the locks used by the allocator. + * This is only appropriate to call in a single threaded environment, + * such as during TclInitSubsystems. * *---------------------------------------------------------------------- */ - void -TclInitDbCkalloc(void) +TclInitDbCkalloc() { if (!ckallocInit) { ckallocInit = 1; @@ -157,40 +156,29 @@ TclInitDbCkalloc(void) *---------------------------------------------------------------------- * * TclDumpMemoryInfo -- - * - * Display the global memory management statistics. + * Display the global memory management statistics. * *---------------------------------------------------------------------- */ - -int -TclDumpMemoryInfo(ClientData clientData, int flags) +void +TclDumpMemoryInfo(outFile) + FILE *outFile; { - char buf[1024]; - - if (clientData == NULL) { return 0; } - sprintf(buf, - "total mallocs %10d\n" - "total frees %10d\n" - "current packets allocated %10d\n" - "current bytes allocated %10lu\n" - "maximum packets allocated %10d\n" - "maximum bytes allocated %10lu\n", - total_mallocs, - total_frees, - current_malloc_packets, - (unsigned long)current_bytes_malloced, - maximum_malloc_packets, - (unsigned long)maximum_bytes_malloced); - if (flags == 0) { - fprintf((FILE *)clientData, buf); - } else { - /* Assume objPtr to append to */ - Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1); - } - return 1; + fprintf(outFile,"total mallocs %10d\n", + total_mallocs); + fprintf(outFile,"total frees %10d\n", + total_frees); + fprintf(outFile,"current packets allocated %10d\n", + current_malloc_packets); + fprintf(outFile,"current bytes allocated %10d\n", + current_bytes_malloced); + fprintf(outFile,"maximum packets allocated %10d\n", + maximum_malloc_packets); + fprintf(outFile,"maximum bytes allocated %10d\n", + maximum_bytes_malloced); } + /* *---------------------------------------------------------------------- * @@ -209,68 +197,67 @@ TclDumpMemoryInfo(ClientData clientData, int flags) */ static void -ValidateMemory( - struct mem_header *memHeaderP, - /* Memory chunk to validate */ - CONST char *file, /* File containing the call to - * Tcl_ValidateAllMemory */ - int line, /* Line number of call to - * Tcl_ValidateAllMemory */ - int nukeGuards) /* If non-zero, indicates that the memory - * guards are to be reset to 0 after they have - * been printed */ +ValidateMemory(memHeaderP, file, line, nukeGuards) + struct mem_header *memHeaderP; /* Memory chunk to validate */ + CONST char *file; /* File containing the call to + * Tcl_ValidateAllMemory */ + int line; /* Line number of call to + * Tcl_ValidateAllMemory */ + int nukeGuards; /* If non-zero, indicates that the + * memory guards are to be reset to 0 + * after they have been printed */ { unsigned char *hiPtr; - size_t idx; - int guard_failed = FALSE; + int idx; + int guard_failed = FALSE; int byte; for (idx = 0; idx < LOW_GUARD_SIZE; idx++) { - byte = *(memHeaderP->low_guard + idx); - if (byte != GUARD_VALUE) { - guard_failed = TRUE; - fflush(stdout); + byte = *(memHeaderP->low_guard + idx); + if (byte != GUARD_VALUE) { + guard_failed = TRUE; + fflush(stdout); byte &= 0xff; - fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ - } + } } if (guard_failed) { - TclDumpMemoryInfo((ClientData) stderr, 0); - fprintf(stderr, "low guard failed at %lx, %s %d\n", - (long unsigned int) memHeaderP->body, file, line); - fflush(stderr); /* In case name pointer is bad. */ - fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, + TclDumpMemoryInfo (stderr); + fprintf(stderr, "low guard failed at %lx, %s %d\n", + (long unsigned int) memHeaderP->body, file, line); + fflush(stderr); /* In case name pointer is bad. */ + fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); - Tcl_Panic("Memory validation failure"); + panic ("Memory validation failure"); } hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length; for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) { - byte = *(hiPtr + idx); - if (byte != GUARD_VALUE) { - guard_failed = TRUE; - fflush(stdout); + byte = *(hiPtr + idx); + if (byte != GUARD_VALUE) { + guard_failed = TRUE; + fflush (stdout); byte &= 0xff; - fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ - } + } } if (guard_failed) { - TclDumpMemoryInfo((ClientData) stderr, 0); - fprintf(stderr, "high guard failed at %lx, %s %d\n", - (long unsigned int) memHeaderP->body, file, line); - fflush(stderr); /* In case name pointer is bad. */ - fprintf(stderr, "%ld bytes allocated at (%s %d)\n", + TclDumpMemoryInfo (stderr); + fprintf(stderr, "high guard failed at %lx, %s %d\n", + (long unsigned int) memHeaderP->body, file, line); + fflush(stderr); /* In case name pointer is bad. */ + fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); - Tcl_Panic("Memory validation failure"); + panic("Memory validation failure"); } if (nukeGuards) { - memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE); - memset(hiPtr, 0, HIGH_GUARD_SIZE); + memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); + memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE); } } @@ -290,13 +277,10 @@ ValidateMemory( * *---------------------------------------------------------------------- */ - void -Tcl_ValidateAllMemory( - CONST char *file, /* File from which Tcl_ValidateAllMemory was - * called. */ - int line) /* Line number of call to - * Tcl_ValidateAllMemory */ +Tcl_ValidateAllMemory (file, line) + CONST char *file; /* File from which Tcl_ValidateAllMemory was called */ + int line; /* Line number of call to Tcl_ValidateAllMemory */ { struct mem_header *memScanP; @@ -305,7 +289,7 @@ Tcl_ValidateAllMemory( } Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { - ValidateMemory(memScanP, file, line, FALSE); + ValidateMemory(memScanP, file, line, FALSE); } Tcl_MutexUnlock(ckallocMutexPtr); } @@ -319,19 +303,17 @@ Tcl_ValidateAllMemory( * information will be written to stderr. * * Results: - * Return TCL_ERROR if an error accessing the file occurs, `errno' will - * have the file error number left in it. - * + * Return TCL_ERROR if an error accessing the file occurs, `errno' + * will have the file error number left in it. *---------------------------------------------------------------------- */ - int -Tcl_DumpActiveMemory( - CONST char *fileName) /* Name of the file to write info to */ +Tcl_DumpActiveMemory (fileName) + CONST char *fileName; /* Name of the file to write info to */ { - FILE *fileP; + FILE *fileP; struct mem_header *memScanP; - char *address; + char *address; if (fileName == NULL) { fileP = stderr; @@ -344,18 +326,18 @@ Tcl_DumpActiveMemory( Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { - address = &memScanP->body [0]; - fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s", + address = &memScanP->body [0]; + fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s", (long unsigned int) address, - (long unsigned int) address + memScanP->length - 1, - memScanP->length, memScanP->file, memScanP->line, - (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string); + (long unsigned int) address + memScanP->length - 1, + memScanP->length, memScanP->file, memScanP->line, + (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string); (void) fputc('\n', fileP); } Tcl_MutexUnlock(ckallocMutexPtr); if (fileP != stderr) { - fclose(fileP); + fclose (fileP); } return TCL_OK; } @@ -365,54 +347,53 @@ Tcl_DumpActiveMemory( * * Tcl_DbCkalloc - debugging ckalloc * - * Allocate the requested amount of space plus some extra for guard bands - * at both ends of the request, plus a size, panicing if there isn't - * enough space, then write in the guard bands and return the address of - * the space in the middle that the user asked for. + * Allocate the requested amount of space plus some extra for + * guard bands at both ends of the request, plus a size, panicing + * if there isn't enough space, then write in the guard bands + * and return the address of the space in the middle that the + * user asked for. * - * The second and third arguments are file and line, these contain the - * filename and line number corresponding to the caller. These are sent - * by the ckalloc macro; it uses the preprocessor autodefines __FILE__ - * and __LINE__. + * The second and third arguments are file and line, these contain + * the filename and line number corresponding to the caller. + * These are sent by the ckalloc macro; it uses the preprocessor + * autodefines __FILE__ and __LINE__. * *---------------------------------------------------------------------- */ - char * -Tcl_DbCkalloc( - unsigned int size, - CONST char *file, - int line) +Tcl_DbCkalloc(size, file, line) + unsigned int size; + CONST char *file; + int line; { struct mem_header *result = NULL; - if (validate_memory) { - Tcl_ValidateAllMemory(file, line); - } + if (validate_memory) + Tcl_ValidateAllMemory (file, line); + /* Don't let size argument to TclpAlloc overflow */ - if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) { + if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) { result = (struct mem_header *) TclpAlloc((unsigned)size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { - fflush(stdout); - TclDumpMemoryInfo((ClientData) stderr, 0); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + fflush(stdout); + TclDumpMemoryInfo(stderr); + panic("unable to alloc %u bytes, %s line %d", size, file, line); } /* - * 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. + * 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(result, GUARD_VALUE, + memset ((VOID *) result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { - memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); - memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); + memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); + memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); } if (!ckallocInit) { TclInitDbCkalloc(); @@ -428,61 +409,56 @@ Tcl_DbCkalloc( result->flink = allocHead; result->blink = NULL; - if (allocHead != NULL) { - allocHead->blink = result; - } + 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; + (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 %u %s %d\n", + if (alloc_tracing) + fprintf(stderr,"ckalloc %lx %u %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); + 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; - } + 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; - } + if (current_bytes_malloced > maximum_bytes_malloced) + maximum_bytes_malloced = current_bytes_malloced; Tcl_MutexUnlock(ckallocMutexPtr); return result->body; } - + char * -Tcl_AttemptDbCkalloc( - unsigned int size, - CONST char *file, - int line) +Tcl_AttemptDbCkalloc(size, file, line) + unsigned int size; + CONST char *file; + int line; { struct mem_header *result = NULL; - if (validate_memory) { - Tcl_ValidateAllMemory(file, line); - } + if (validate_memory) + Tcl_ValidateAllMemory (file, line); /* Don't let size argument to TclpAlloc overflow */ if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) { @@ -490,22 +466,22 @@ Tcl_AttemptDbCkalloc( sizeof(struct mem_header) + HIGH_GUARD_SIZE); } if (result == NULL) { - fflush(stdout); - TclDumpMemoryInfo((ClientData) stderr, 0); + 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. + * 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(result, GUARD_VALUE, + memset ((VOID *) result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { - memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); - memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); + memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); + memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); } if (!ckallocInit) { TclInitDbCkalloc(); @@ -521,73 +497,71 @@ Tcl_AttemptDbCkalloc( result->flink = allocHead; result->blink = NULL; - if (allocHead != NULL) { - allocHead->blink = result; - } + 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; + (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 %u %s %d\n", + if (alloc_tracing) + fprintf(stderr,"ckalloc %lx %u %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); + 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; - } + 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; - } + if (current_bytes_malloced > maximum_bytes_malloced) + maximum_bytes_malloced = current_bytes_malloced; Tcl_MutexUnlock(ckallocMutexPtr); return result->body; } + /* *---------------------------------------------------------------------- * * Tcl_DbCkfree - debugging ckfree * - * Verify that the low and high guards are intact, and if so then free - * the buffer else Tcl_Panic. + * Verify that the low and high guards are intact, and if so + * then free the buffer else panic. * - * The guards are erased after being checked to catch duplicate frees. + * The guards are erased after being checked to catch duplicate + * frees. * - * The second and third arguments are file and line, these contain the - * filename and line number corresponding to the caller. These are sent - * by the ckfree macro; it uses the preprocessor autodefines __FILE__ and - * __LINE__. + * The second and third arguments are file and line, these contain + * the filename and line number corresponding to the caller. + * These are sent by the ckfree macro; it uses the preprocessor + * autodefines __FILE__ and __LINE__. * *---------------------------------------------------------------------- */ void -Tcl_DbCkfree( - char *ptr, - CONST char *file, - int line) +Tcl_DbCkfree(ptr, file, line) + char *ptr; + CONST char *file; + int line; { struct mem_header *memp; @@ -596,28 +570,28 @@ Tcl_DbCkfree( } /* - * The following cast is *very* tricky. Must convert the pointer to an - * integer before doing arithmetic on it, because otherwise the arithmetic - * will be done differently (and incorrectly) on word-addressed machines - * such as Crays (will subtract only bytes, even though BODY_OFFSET is in - * words on these machines). + * The following cast is *very* tricky. Must convert the pointer + * to an integer before doing arithmetic on it, because otherwise + * the arithmetic will be done differently (and incorrectly) on + * word-addressed machines such as Crays (will subtract only bytes, + * even though BODY_OFFSET is in words on these machines). */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); if (alloc_tracing) { - fprintf(stderr, "ckfree %lx %ld %s %d\n", + fprintf(stderr, "ckfree %lx %ld %s %d\n", (long unsigned int) memp->body, memp->length, file, line); } if (validate_memory) { - Tcl_ValidateAllMemory(file, line); + Tcl_ValidateAllMemory(file, line); } Tcl_MutexLock(ckallocMutexPtr); ValidateMemory(memp, file, line, TRUE); if (init_malloced_bodies) { - memset(ptr, GUARD_VALUE, (size_t) memp->length); + memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length); } total_frees++; @@ -634,16 +608,12 @@ Tcl_DbCkfree( /* * Delink from allocated list */ - - if (memp->flink != NULL) { - memp->flink->blink = memp->blink; - } - if (memp->blink != NULL) { - memp->blink->flink = memp->flink; - } - if (allocHead == memp) { - allocHead = memp->flink; - } + if (memp->flink != NULL) + memp->flink->blink = memp->blink; + if (memp->blink != NULL) + memp->blink->flink = memp->flink; + if (allocHead == memp) + allocHead = memp->flink; TclpFree((char *) memp); Tcl_MutexUnlock(ckallocMutexPtr); } @@ -653,22 +623,21 @@ Tcl_DbCkfree( * * Tcl_DbCkrealloc - debugging ckrealloc * - * Reallocate a chunk of memory by allocating a new one of the right - * size, copying the old data to the new location, and then freeing the - * old memory space, using all the memory checking features of this - * package. + * Reallocate a chunk of memory by allocating a new one of the + * right size, copying the old data to the new location, and then + * freeing the old memory space, using all the memory checking + * features of this package. * *-------------------------------------------------------------------- */ - char * -Tcl_DbCkrealloc( - char *ptr, - unsigned int size, - CONST char *file, - int line) +Tcl_DbCkrealloc(ptr, size, file, line) + char *ptr; + unsigned int size; + CONST char *file; + int line; { - char *newPtr; + char *new; unsigned int copySize; struct mem_header *memp; @@ -677,7 +646,8 @@ Tcl_DbCkrealloc( } /* - * See comment from Tcl_DbCkfree before you change the following line. + * See comment from Tcl_DbCkfree before you change the following + * line. */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); @@ -686,20 +656,20 @@ Tcl_DbCkrealloc( if (copySize > (unsigned int) memp->length) { copySize = memp->length; } - newPtr = Tcl_DbCkalloc(size, file, line); - memcpy(newPtr, ptr, (size_t) copySize); + new = Tcl_DbCkalloc(size, file, line); + memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize); Tcl_DbCkfree(ptr, file, line); - return newPtr; + return new; } - + char * -Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, - CONST char *file, - int line) +Tcl_AttemptDbCkrealloc(ptr, size, file, line) + char *ptr; + unsigned int size; + CONST char *file; + int line; { - char *newPtr; + char *new; unsigned int copySize; struct mem_header *memp; @@ -708,7 +678,8 @@ Tcl_AttemptDbCkrealloc( } /* - * See comment from Tcl_DbCkfree before you change the following line. + * See comment from Tcl_DbCkfree before you change the following + * line. */ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); @@ -717,13 +688,13 @@ Tcl_AttemptDbCkrealloc( if (copySize > (unsigned int) memp->length) { copySize = memp->length; } - newPtr = Tcl_AttemptDbCkalloc(size, file, line); - if (newPtr == NULL) { + new = Tcl_AttemptDbCkalloc(size, file, line); + if (new == NULL) { return NULL; } - memcpy(newPtr, ptr, (size_t) copySize); + memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize); Tcl_DbCkfree(ptr, file, line); - return newPtr; + return new; } @@ -732,8 +703,8 @@ Tcl_AttemptDbCkrealloc( * * Tcl_Alloc, et al. -- * - * These functions are defined in terms of the debugging versions when - * TCL_MEM_DEBUG is set. + * These functions are defined in terms of the debugging versions + * when TCL_MEM_DEBUG is set. * * Results: * Same as the debug versions. @@ -751,37 +722,37 @@ Tcl_AttemptDbCkrealloc( #undef Tcl_AttemptRealloc char * -Tcl_Alloc( - unsigned int size) +Tcl_Alloc(size) + unsigned int size; { return Tcl_DbCkalloc(size, "unknown", 0); } char * -Tcl_AttemptAlloc( - unsigned int size) +Tcl_AttemptAlloc(size) + unsigned int size; { return Tcl_AttemptDbCkalloc(size, "unknown", 0); } void -Tcl_Free( - char *ptr) +Tcl_Free(ptr) + char *ptr; { Tcl_DbCkfree(ptr, "unknown", 0); } char * -Tcl_Realloc( - char *ptr, - unsigned int size) +Tcl_Realloc(ptr, size) + char *ptr; + unsigned int size; { return Tcl_DbCkrealloc(ptr, size, "unknown", 0); } char * -Tcl_AttemptRealloc( - char *ptr, - unsigned int size) +Tcl_AttemptRealloc(ptr, size) + char *ptr; + unsigned int size; { return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0); } @@ -790,9 +761,8 @@ Tcl_AttemptRealloc( *---------------------------------------------------------------------- * * MemoryCmd -- - * - * Implements the Tcl "memory" command, which provides Tcl-level control - * of Tcl memory debugging information. + * Implements the Tcl "memory" command, which provides Tcl-level + * control of Tcl memory debugging information. * memory active $file * memory break_on_malloc $count * memory info @@ -804,34 +774,33 @@ Tcl_AttemptRealloc( * memory validate on|off * * Results: - * Standard TCL results. + * Standard TCL results. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int -MemoryCmd( - ClientData clientData, - Tcl_Interp *interp, - int argc, - CONST char *argv[]) +MemoryCmd (clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + CONST char **argv; { CONST char *fileName; - FILE *fileP; Tcl_DString buffer; int result; size_t len; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option [args..]\"", NULL); + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option [args..]\"", (char *) NULL); return TCL_ERROR; } if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " file\"", NULL); + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " ", argv[1], " file\"", (char *) NULL); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); @@ -841,61 +810,43 @@ MemoryCmd( result = Tcl_DumpActiveMemory (fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { - Tcl_AppendResult(interp, "error accessing ", argv[2], NULL); + Tcl_AppendResult(interp, "error accessing ", argv[2], + (char *) NULL); return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"break_on_malloc") == 0) { - if (argc != 3) { - goto argError; + if (argc != 3) { + goto argError; } - if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) { + if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) { return TCL_ERROR; } - return TCL_OK; + return TCL_OK; } if (strcmp(argv[1],"info") == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n", - "total mallocs", total_mallocs, "total frees", total_frees, - "current packets allocated", current_malloc_packets, - "current bytes allocated", current_bytes_malloced, - "maximum packets allocated", maximum_malloc_packets, - "maximum bytes allocated", maximum_bytes_malloced)); - return TCL_OK; + char buf[400]; + sprintf(buf, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n", + "total mallocs", total_mallocs, "total frees", total_frees, + "current packets allocated", current_malloc_packets, + "current bytes allocated", current_bytes_malloced, + "maximum packets allocated", maximum_malloc_packets, + "maximum bytes allocated", maximum_bytes_malloced); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return TCL_OK; } if (strcmp(argv[1],"init") == 0) { - if (argc != 3) { - goto bad_suboption; - } - init_malloced_bodies = (strcmp(argv[2],"on") == 0); - return TCL_OK; - } - if (strcmp(argv[1],"objs") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " objs file\"", NULL); - return TCL_ERROR; - } - fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); - if (fileName == NULL) { - return TCL_ERROR; - } - fileP = fopen(fileName, "w"); - if (fileP == NULL) { - Tcl_AppendResult(interp, "cannot open output file", NULL); - return TCL_ERROR; + if (argc != 3) { + goto bad_suboption; } - TclDbDumpActiveObjects(fileP); - fclose(fileP); - Tcl_DStringFree(&buffer); - return TCL_OK; + init_malloced_bodies = (strcmp(argv[2],"on") == 0); + return TCL_OK; } if (strcmp(argv[1],"onexit") == 0) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " onexit file\"", NULL); + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " onexit file\"", (char *) NULL); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); @@ -910,7 +861,7 @@ MemoryCmd( if (strcmp(argv[1],"tag") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " tag string\"", NULL); + " tag string\"", (char *) NULL); return TCL_ERROR; } if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { @@ -923,43 +874,43 @@ MemoryCmd( return TCL_OK; } if (strcmp(argv[1],"trace") == 0) { - if (argc != 3) { - goto bad_suboption; + if (argc != 3) { + goto bad_suboption; } - alloc_tracing = (strcmp(argv[2],"on") == 0); - return TCL_OK; + alloc_tracing = (strcmp(argv[2],"on") == 0); + return TCL_OK; } if (strcmp(argv[1],"trace_on_at_malloc") == 0) { - if (argc != 3) { - goto argError; + if (argc != 3) { + goto argError; } - if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) { + if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"validate") == 0) { - if (argc != 3) { + if (argc != 3) { goto bad_suboption; } - validate_memory = (strcmp(argv[2],"on") == 0); - return TCL_OK; + validate_memory = (strcmp(argv[2],"on") == 0); + return TCL_OK; } Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": should be active, break_on_malloc, info, init, onexit, " - "tag, trace, trace_on_at_malloc, or validate", NULL); + "\": should be active, break_on_malloc, info, init, onexit, ", + "tag, trace, trace_on_at_malloc, or validate", (char *) NULL); return TCL_ERROR; - argError: +argError: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " count\"", NULL); + " ", argv[1], " count\"", (char *) NULL); return TCL_ERROR; - bad_suboption: +bad_suboption: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " on|off\"", NULL); + " ", argv[1], " on|off\"", (char *) NULL); return TCL_ERROR; } @@ -968,9 +919,10 @@ MemoryCmd( * * CheckmemCmd -- * - * This is the command procedure for the "checkmem" command, which causes - * the application to exit after printing information about memory usage - * to the file passed to this command as its first argument. + * This is the command procedure for the "checkmem" command, which + * causes the application to exit after printing information about + * memory usage to the file passed to this command as its first + * argument. * * Results: * Returns a standard Tcl completion code. @@ -982,15 +934,15 @@ MemoryCmd( */ static int -CheckmemCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Interpreter for evaluation. */ - int argc, /* Number of arguments. */ - CONST char *argv[]) /* String values of arguments. */ +CheckmemCmd(clientData, interp, argc, argv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Interpreter for evaluation. */ + int argc; /* Number of arguments. */ + CONST char *argv[]; /* String values of arguments. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " fileName\"", NULL); + " fileName\"", (char *) NULL); return TCL_ERROR; } tclMemDumpFileName = dumpFile; @@ -1003,7 +955,8 @@ CheckmemCmd( * * Tcl_InitMemory -- * - * Create the "memory" and "checkmem" commands in the given interpreter. + * Create the "memory" and "checkmem" commands in the given + * interpreter. * * Results: * None. @@ -1015,13 +968,14 @@ CheckmemCmd( */ void -Tcl_InitMemory( - Tcl_Interp *interp) /* Interpreter in which commands should be - * added */ +Tcl_InitMemory(interp) + Tcl_Interp *interp; /* Interpreter in which commands should be added */ { TclInitDbCkalloc(); - Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL); - Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL); + Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL, + (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, + (Tcl_CmdDeleteProc *) NULL); } @@ -1038,50 +992,47 @@ Tcl_InitMemory( *---------------------------------------------------------------------- * * Tcl_Alloc -- - * - * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check - * that memory was actually allocated. + * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check + * that memory was actually allocated. * *---------------------------------------------------------------------- */ char * -Tcl_Alloc( - unsigned int size) +Tcl_Alloc (size) + unsigned int size; { char *result; result = TclpAlloc(size); - /* - * Most systems will not alloc(0), instead bumping it to one so that NULL - * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning - * NULL, so we have to check that the NULL we get is not in response to - * alloc(0). + * Most systems will not alloc(0), instead bumping it to one so + * that NULL isn't returned. Some systems (AIX, Tru64) will alloc(0) + * by returning NULL, so we have to check that the NULL we get is + * not in response to alloc(0). * - * The ANSI spec actually says that systems either return NULL *or* a - * special pointer on failure, but we only check for NULL + * The ANSI spec actually says that systems either return NULL *or* + * a special pointer on failure, but we only check for NULL */ - if ((result == NULL) && size) { - Tcl_Panic("unable to alloc %u bytes", size); + panic("unable to alloc %u bytes", size); } return result; } char * -Tcl_DbCkalloc( - unsigned int size, - CONST char *file, - int line) +Tcl_DbCkalloc(size, file, line) + unsigned int size; + CONST char *file; + int line; { char *result; result = (char *) TclpAlloc(size); if ((result == NULL) && size) { - fflush(stdout); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + fflush(stdout); + panic("unable to alloc %u bytes, %s line %d", size, file, line); } return result; } @@ -1090,16 +1041,15 @@ Tcl_DbCkalloc( *---------------------------------------------------------------------- * * Tcl_AttemptAlloc -- - * - * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not - * check that memory was actually allocated. + * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not + * check that memory was actually allocated. * *---------------------------------------------------------------------- */ char * -Tcl_AttemptAlloc( - unsigned int size) +Tcl_AttemptAlloc (size) + unsigned int size; { char *result; @@ -1108,57 +1058,57 @@ Tcl_AttemptAlloc( } char * -Tcl_AttemptDbCkalloc( - unsigned int size, - CONST char *file, - int line) +Tcl_AttemptDbCkalloc(size, file, line) + unsigned int size; + CONST char *file; + int line; { char *result; result = (char *) TclpAlloc(size); return result; } + /* *---------------------------------------------------------------------- * * Tcl_Realloc -- - * - * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check - * that memory was actually allocated. + * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does + * check that memory was actually allocated. * *---------------------------------------------------------------------- */ char * -Tcl_Realloc( - char *ptr, - unsigned int size) +Tcl_Realloc(ptr, size) + char *ptr; + unsigned int size; { char *result; result = TclpRealloc(ptr, size); if ((result == NULL) && size) { - Tcl_Panic("unable to realloc %u bytes", size); + panic("unable to realloc %u bytes", size); } return result; } char * -Tcl_DbCkrealloc( - char *ptr, - unsigned int size, - CONST char *file, - int line) +Tcl_DbCkrealloc(ptr, size, file, line) + char *ptr; + unsigned int size; + CONST char *file; + int line; { char *result; result = (char *) TclpRealloc(ptr, size); if ((result == NULL) && size) { - fflush(stdout); - Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); + fflush(stdout); + panic("unable to realloc %u bytes, %s line %d", size, file, line); } return result; } @@ -1167,17 +1117,16 @@ Tcl_DbCkrealloc( *---------------------------------------------------------------------- * * Tcl_AttemptRealloc -- - * - * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not - * check that memory was actually allocated. + * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does + * not check that memory was actually allocated. * *---------------------------------------------------------------------- */ char * -Tcl_AttemptRealloc( - char *ptr, - unsigned int size) +Tcl_AttemptRealloc(ptr, size) + char *ptr; + unsigned int size; { char *result; @@ -1186,11 +1135,11 @@ Tcl_AttemptRealloc( } char * -Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, - CONST char *file, - int line) +Tcl_AttemptDbCkrealloc(ptr, size, file, line) + char *ptr; + unsigned int size; + CONST char *file; + int line; { char *result; @@ -1202,26 +1151,25 @@ Tcl_AttemptDbCkrealloc( *---------------------------------------------------------------------- * * 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 - * TCL_MEM_DEBUG enabled and some with it disabled. + * Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here + * rather in the macro to keep some modules from being compiled with + * TCL_MEM_DEBUG enabled and some with it disabled. * *---------------------------------------------------------------------- */ void -Tcl_Free( - char *ptr) +Tcl_Free (ptr) + char *ptr; { TclpFree(ptr); } void -Tcl_DbCkfree( - char *ptr, - CONST char *file, - int line) +Tcl_DbCkfree(ptr, file, line) + char *ptr; + CONST char *file; + int line; { TclpFree(ptr); } @@ -1230,37 +1178,36 @@ Tcl_DbCkfree( *---------------------------------------------------------------------- * * Tcl_InitMemory -- - * - * Dummy initialization for memory command, which is only available if - * TCL_MEM_DEBUG is on. + * Dummy initialization for memory command, which is only available + * if TCL_MEM_DEBUG is on. * *---------------------------------------------------------------------- */ /* ARGSUSED */ void -Tcl_InitMemory( - Tcl_Interp *interp) +Tcl_InitMemory(interp) + Tcl_Interp *interp; { } int -Tcl_DumpActiveMemory( - CONST char *fileName) +Tcl_DumpActiveMemory(fileName) + CONST char *fileName; { return TCL_OK; } void -Tcl_ValidateAllMemory( - CONST char *file, - int line) +Tcl_ValidateAllMemory(file, line) + CONST char *file; + int line; { } -int -TclDumpMemoryInfo(ClientData clientData, int flags) +void +TclDumpMemoryInfo(outFile) + FILE *outFile; { - return 1; } #endif /* TCL_MEM_DEBUG */ @@ -1270,22 +1217,23 @@ TclDumpMemoryInfo(ClientData clientData, int flags) * * TclFinalizeMemorySubsystem -- * - * This procedure is called to finalize all the structures that are used - * by the memory allocator on a per-process basis. + * This procedure is called to finalize all the structures that + * are used by the memory allocator on a per-process basis. * * Results: * None. * * Side effects: - * This subsystem is self-initializing, since memory can be allocated - * before Tcl is formally initialized. After this call, this subsystem - * has been reset to its initial state and is usable again. + * This subsystem is self-initializing, since memory can be + * allocated before Tcl is formally initialized. After this call, + * this subsystem has been reset to its initial state and is + * usable again. * *--------------------------------------------------------------------------- */ void -TclFinalizeMemorySubsystem(void) +TclFinalizeMemorySubsystem() { #ifdef TCL_MEM_DEBUG if (tclMemDumpFileName != NULL) { @@ -1293,15 +1241,12 @@ TclFinalizeMemorySubsystem(void) } else if (onExitMemDumpFileName != NULL) { Tcl_DumpActiveMemory(onExitMemDumpFileName); } - Tcl_MutexLock(ckallocMutexPtr); - if (curTagPtr != NULL) { TclpFree((char *) curTagPtr); curTagPtr = NULL; } allocHead = NULL; - Tcl_MutexUnlock(ckallocMutexPtr); #endif @@ -1309,11 +1254,3 @@ TclFinalizeMemorySubsystem(void) TclFinalizeAllocSubsystem(); #endif } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |