summaryrefslogtreecommitdiffstats
path: root/generic/tclCkalloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r--generic/tclCkalloc.c478
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:
+ */