diff options
Diffstat (limited to 'generic/tclCkalloc.c')
| -rw-r--r-- | generic/tclCkalloc.c | 478 |
1 files changed, 249 insertions, 229 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index dbae0fd..595c24a 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1,19 +1,20 @@ -/* +/* * 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 * - * RCS: @(#) $Id: tclCkalloc.c,v 1.22 2004/10/06 13:05:02 dkf Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.23 2005/07/19 22:45:35 dkf Exp $ */ #include "tclInt.h" @@ -29,29 +30,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; @@ -60,9 +61,8 @@ 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 */ @@ -70,16 +70,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 \ @@ -102,10 +102,10 @@ static int init_malloced_bodies = TRUE; #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; @@ -115,10 +115,11 @@ 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; @@ -138,15 +139,16 @@ static void ValidateMemory _ANSI_ARGS_(( *---------------------------------------------------------------------- * * 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() +TclInitDbCkalloc() { if (!ckallocInit) { ckallocInit = 1; @@ -158,26 +160,27 @@ TclInitDbCkalloc() *---------------------------------------------------------------------- * * TclDumpMemoryInfo -- - * Display the global memory management statistics. + * + * Display the global memory management statistics. * *---------------------------------------------------------------------- */ void -TclDumpMemoryInfo(outFile) +TclDumpMemoryInfo(outFile) FILE *outFile; { - fprintf(outFile,"total mallocs %10d\n", + fprintf(outFile,"total mallocs %10d\n", total_mallocs); - fprintf(outFile,"total frees %10d\n", + fprintf(outFile,"total frees %10d\n", total_frees); - fprintf(outFile,"current packets allocated %10d\n", + fprintf(outFile,"current packets allocated %10d\n", current_malloc_packets); - fprintf(outFile,"current bytes allocated %10d\n", + fprintf(outFile,"current bytes allocated %10d\n", current_bytes_malloced); - fprintf(outFile,"maximum packets allocated %10d\n", + fprintf(outFile,"maximum packets allocated %10d\n", maximum_malloc_packets); - fprintf(outFile,"maximum bytes allocated %10d\n", + fprintf(outFile,"maximum bytes allocated %10d\n", maximum_bytes_malloced); } @@ -213,53 +216,53 @@ ValidateMemory(memHeaderP, file, line, nukeGuards) 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", 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 (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, + 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"); + Tcl_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", 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(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", + 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"); + Tcl_Panic("Memory validation failure"); } if (nukeGuards) { - memset((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); - memset((char *) hiPtr, 0, HIGH_GUARD_SIZE); + memset((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); + memset((char *) hiPtr, 0, HIGH_GUARD_SIZE); } } @@ -282,8 +285,10 @@ ValidateMemory(memHeaderP, file, line, nukeGuards) void Tcl_ValidateAllMemory(file, line) - CONST char *file; /* File from which Tcl_ValidateAllMemory was called */ - int line; /* Line number of call to Tcl_ValidateAllMemory */ + CONST char *file; /* File from which Tcl_ValidateAllMemory was + * called. */ + int line; /* Line number of call to + * Tcl_ValidateAllMemory */ { struct mem_header *memScanP; @@ -292,7 +297,7 @@ Tcl_ValidateAllMemory(file, line) } Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { - ValidateMemory(memScanP, file, line, FALSE); + ValidateMemory(memScanP, file, line, FALSE); } Tcl_MutexUnlock(ckallocMutexPtr); } @@ -306,14 +311,15 @@ Tcl_ValidateAllMemory(file, line) * 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 (fileName) - CONST char *fileName; /* Name of the file to write info to */ + CONST char *fileName; /* Name of the file to write info to */ { FILE *fileP; struct mem_header *memScanP; @@ -330,8 +336,8 @@ Tcl_DumpActiveMemory (fileName) 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, @@ -351,16 +357,15 @@ Tcl_DumpActiveMemory (fileName) * * 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__. * *---------------------------------------------------------------------- */ @@ -374,24 +379,25 @@ Tcl_DbCkalloc(size, file, line) struct mem_header *result; if (validate_memory) { - Tcl_ValidateAllMemory(file, line); + Tcl_ValidateAllMemory(file, line); } - result = (struct mem_header *) TclpAlloc((unsigned)size + + result = (struct mem_header *) TclpAlloc((unsigned)size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); if (result == NULL) { - fflush(stdout); - TclDumpMemoryInfo(stderr); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + fflush(stdout); + TclDumpMemoryInfo(stderr); + Tcl_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((VOID *) result, GUARD_VALUE, + memset((VOID *) result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { memset((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); @@ -412,42 +418,42 @@ Tcl_DbCkalloc(size, file, line) result->blink = NULL; if (allocHead != NULL) { - allocHead->blink = result; + 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; + 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", + 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; + 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"); + 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; + maximum_malloc_packets = current_malloc_packets; } current_bytes_malloced += size; if (current_bytes_malloced > maximum_bytes_malloced) { - maximum_bytes_malloced = current_bytes_malloced; + maximum_bytes_malloced = current_bytes_malloced; } Tcl_MutexUnlock(ckallocMutexPtr); @@ -464,24 +470,24 @@ Tcl_AttemptDbCkalloc(size, file, line) struct mem_header *result; if (validate_memory) { - Tcl_ValidateAllMemory(file, line); + Tcl_ValidateAllMemory(file, line); } - result = (struct mem_header *) TclpAlloc((unsigned)size + + result = (struct mem_header *) TclpAlloc((unsigned)size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); if (result == NULL) { - fflush(stdout); - TclDumpMemoryInfo(stderr); + 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((VOID *) result, GUARD_VALUE, + memset((VOID *) result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { memset((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); @@ -502,42 +508,42 @@ Tcl_AttemptDbCkalloc(size, file, line) result->blink = NULL; if (allocHead != NULL) { - allocHead->blink = result; + 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; + 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", + 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; + 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"); + 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; + maximum_malloc_packets = current_malloc_packets; } current_bytes_malloced += size; if (current_bytes_malloced > maximum_bytes_malloced) { - maximum_bytes_malloced = current_bytes_malloced; + maximum_bytes_malloced = current_bytes_malloced; } Tcl_MutexUnlock(ckallocMutexPtr); @@ -550,16 +556,15 @@ Tcl_AttemptDbCkalloc(size, file, line) * * 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 Tcl_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__. * *---------------------------------------------------------------------- */ @@ -577,22 +582,22 @@ Tcl_DbCkfree(ptr, file, line) } /* - * 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 *) (((unsigned long) 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); @@ -615,14 +620,15 @@ Tcl_DbCkfree(ptr, file, line) /* * Delink from allocated list */ + if (memp->flink != NULL) { - memp->flink->blink = memp->blink; + memp->flink->blink = memp->blink; } if (memp->blink != NULL) { - memp->blink->flink = memp->flink; + memp->blink->flink = memp->flink; } if (allocHead == memp) { - allocHead = memp->flink; + allocHead = memp->flink; } TclpFree((char *) memp); Tcl_MutexUnlock(ckallocMutexPtr); @@ -635,10 +641,10 @@ Tcl_DbCkfree(ptr, file, line) * * 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. * *-------------------------------------------------------------------- */ @@ -659,8 +665,7 @@ Tcl_DbCkrealloc(ptr, size, file, line) } /* - * 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 *) (((unsigned long) ptr) - BODY_OFFSET); @@ -691,8 +696,7 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line) } /* - * 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 *) (((unsigned long) ptr) - BODY_OFFSET); @@ -716,8 +720,8 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line) * * 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. @@ -774,8 +778,9 @@ Tcl_AttemptRealloc(ptr, size) *---------------------------------------------------------------------- * * 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 @@ -787,7 +792,7 @@ Tcl_AttemptRealloc(ptr, size) * memory validate on|off * * Results: - * Standard TCL results. + * Standard TCL results. * *---------------------------------------------------------------------- */ @@ -810,7 +815,7 @@ MemoryCmd(clientData, interp, argc, argv) } if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) { - if (argc != 3) { + if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " file\"", (char *) NULL); return TCL_ERROR; @@ -822,41 +827,41 @@ MemoryCmd(clientData, interp, argc, argv) result = Tcl_DumpActiveMemory (fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { - Tcl_AppendResult(interp, "error accessing ", argv[2], + 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) { 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); + "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; + return TCL_OK; } if (strcmp(argv[1],"init") == 0) { - if (argc != 3) { - goto bad_suboption; + if (argc != 3) { + goto bad_suboption; } - init_malloced_bodies = (strcmp(argv[2],"on") == 0); - return TCL_OK; + init_malloced_bodies = (strcmp(argv[2],"on") == 0); + return TCL_OK; } if (strcmp(argv[1],"onexit") == 0) { - if (argc != 3) { + if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " onexit file\"", (char *) NULL); return TCL_ERROR; @@ -885,28 +890,28 @@ MemoryCmd(clientData, interp, argc, argv) 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], @@ -914,12 +919,12 @@ MemoryCmd(clientData, interp, argc, argv) "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\"", (char *) NULL); return TCL_ERROR; -bad_suboption: + bad_suboption: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " on|off\"", (char *) NULL); return TCL_ERROR; @@ -930,10 +935,9 @@ bad_suboption: * * 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. @@ -966,8 +970,7 @@ CheckmemCmd(clientData, interp, argc, argv) * * Tcl_InitMemory -- * - * Create the "memory" and "checkmem" commands in the given - * interpreter. + * Create the "memory" and "checkmem" commands in the given interpreter. * * Results: * None. @@ -983,7 +986,7 @@ Tcl_InitMemory(interp) Tcl_Interp *interp; /* Interpreter in which commands should be added */ { TclInitDbCkalloc(); - Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, + Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); @@ -1003,8 +1006,9 @@ Tcl_InitMemory(interp) *---------------------------------------------------------------------- * * 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. * *---------------------------------------------------------------------- */ @@ -1016,15 +1020,17 @@ Tcl_Alloc(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); } @@ -1042,8 +1048,8 @@ Tcl_DbCkalloc(size, file, line) 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); + Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } return result; } @@ -1052,8 +1058,9 @@ Tcl_DbCkalloc(size, file, line) *---------------------------------------------------------------------- * * 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. * *---------------------------------------------------------------------- */ @@ -1079,14 +1086,14 @@ Tcl_AttemptDbCkalloc(size, file, line) 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. * *---------------------------------------------------------------------- */ @@ -1118,8 +1125,8 @@ Tcl_DbCkrealloc(ptr, size, file, line) 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); + Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); } return result; } @@ -1128,8 +1135,9 @@ 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. + * + * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not + * check that memory was actually allocated. * *---------------------------------------------------------------------- */ @@ -1162,9 +1170,10 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line) *---------------------------------------------------------------------- * * 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. * *---------------------------------------------------------------------- */ @@ -1190,8 +1199,9 @@ Tcl_DbCkfree(ptr, file, line) *---------------------------------------------------------------------- * * 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. * *---------------------------------------------------------------------- */ @@ -1217,7 +1227,7 @@ Tcl_ValidateAllMemory(file, line) } void -TclDumpMemoryInfo(outFile) +TclDumpMemoryInfo(outFile) FILE *outFile; { } @@ -1229,17 +1239,16 @@ TclDumpMemoryInfo(outFile) * * 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. * *--------------------------------------------------------------------------- */ @@ -1253,16 +1262,27 @@ TclFinalizeMemorySubsystem() } else if (onExitMemDumpFileName != NULL) { Tcl_DumpActiveMemory(onExitMemDumpFileName); } + Tcl_MutexLock(ckallocMutexPtr); + if (curTagPtr != NULL) { TclpFree((char *) curTagPtr); curTagPtr = NULL; } allocHead = NULL; + Tcl_MutexUnlock(ckallocMutexPtr); #endif #if USE_TCLALLOC - TclFinalizeAllocSubsystem(); + TclFinalizeAllocSubsystem(); #endif } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |