summaryrefslogtreecommitdiffstats
path: root/generic/tclCkalloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r--generic/tclCkalloc.c891
1 files changed, 477 insertions, 414 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index e81eaea..c374ce5 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,9 +59,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 */
@@ -69,16 +68,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 \
@@ -86,25 +85,25 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
static int total_mallocs = 0;
static int total_frees = 0;
-static int current_bytes_malloced = 0;
-static int maximum_bytes_malloced = 0;
+static size_t current_bytes_malloced = 0;
+static size_t 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;
@@ -114,10 +113,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;
@@ -125,26 +125,27 @@ static int ckallocInit = 0;
* Prototypes for procedures defined in this file:
*/
-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));
+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);
/*
*----------------------------------------------------------------------
*
* 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(void)
{
if (!ckallocInit) {
ckallocInit = 1;
@@ -156,29 +157,40 @@ TclInitDbCkalloc()
*----------------------------------------------------------------------
*
* TclDumpMemoryInfo --
- * Display the global memory management statistics.
+ *
+ * Display the global memory management statistics.
*
*----------------------------------------------------------------------
*/
-void
-TclDumpMemoryInfo(outFile)
- FILE *outFile;
+
+int
+TclDumpMemoryInfo(ClientData clientData, int flags)
{
- 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);
+ 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;
}
-
/*
*----------------------------------------------------------------------
*
@@ -197,67 +209,68 @@ TclDumpMemoryInfo(outFile)
*/
static void
-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 */
+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 */
{
unsigned char *hiPtr;
- int idx;
- int guard_failed = FALSE;
+ size_t 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", (int)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((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,
memHeaderP->file, memHeaderP->line);
- 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", (int)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((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",
memHeaderP->length, memHeaderP->file,
memHeaderP->line);
- 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(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
+ memset(hiPtr, 0, HIGH_GUARD_SIZE);
}
}
@@ -277,10 +290,13 @@ 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 */
+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;
@@ -289,7 +305,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);
}
@@ -303,17 +319,19 @@ 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 */
+Tcl_DumpActiveMemory(
+ 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;
@@ -326,18 +344,18 @@ 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,
- (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;
}
@@ -347,53 +365,54 @@ 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__.
*
*----------------------------------------------------------------------
*/
+
char *
-Tcl_DbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkalloc(
+ 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(stderr);
- panic("unable to alloc %u bytes, %s line %d", size, file, line);
+ fflush(stdout);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
+ 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(result, GUARD_VALUE,
size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
- memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
- memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+ memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+ memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
}
if (!ckallocInit) {
TclInitDbCkalloc();
@@ -409,56 +428,61 @@ Tcl_DbCkalloc(size, file, line)
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(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkalloc(
+ 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)) {
@@ -466,22 +490,22 @@ Tcl_AttemptDbCkalloc(size, file, line)
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
}
if (result == NULL) {
- fflush(stdout);
- TclDumpMemoryInfo(stderr);
+ fflush(stdout);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
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(result, GUARD_VALUE,
size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
- memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
- memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+ memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+ memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
}
if (!ckallocInit) {
TclInitDbCkalloc();
@@ -497,71 +521,73 @@ Tcl_AttemptDbCkalloc(size, file, line)
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 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__.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- CONST char *file;
- int line;
+Tcl_DbCkfree(
+ char *ptr,
+ CONST char *file,
+ int line)
{
struct mem_header *memp;
@@ -570,28 +596,28 @@ 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 *) (((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((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
+ memset(ptr, GUARD_VALUE, (size_t) memp->length);
}
total_frees++;
@@ -608,12 +634,16 @@ Tcl_DbCkfree(ptr, file, line)
/*
* 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);
@@ -625,21 +655,22 @@ 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.
*
*--------------------------------------------------------------------
*/
+
char *
-Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
- char *new;
+ char *newPtr;
unsigned int copySize;
struct mem_header *memp;
@@ -648,8 +679,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 *) (((size_t) ptr) - BODY_OFFSET);
@@ -658,20 +688,20 @@ Tcl_DbCkrealloc(ptr, size, file, line)
if (copySize > (unsigned int) memp->length) {
copySize = memp->length;
}
- new = Tcl_DbCkalloc(size, file, line);
- memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+ newPtr = Tcl_DbCkalloc(size, file, line);
+ memcpy(newPtr, ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
- return new;
+ return newPtr;
}
-
+
char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
- char *new;
+ char *newPtr;
unsigned int copySize;
struct mem_header *memp;
@@ -680,8 +710,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 *) (((size_t) ptr) - BODY_OFFSET);
@@ -690,13 +719,13 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
if (copySize > (unsigned int) memp->length) {
copySize = memp->length;
}
- new = Tcl_AttemptDbCkalloc(size, file, line);
- if (new == NULL) {
+ newPtr = Tcl_AttemptDbCkalloc(size, file, line);
+ if (newPtr == NULL) {
return NULL;
}
- memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+ memcpy(newPtr, ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
- return new;
+ return newPtr;
}
@@ -705,8 +734,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.
@@ -724,37 +753,37 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
#undef Tcl_AttemptRealloc
char *
-Tcl_Alloc(size)
- unsigned int size;
+Tcl_Alloc(
+ unsigned int size)
{
return Tcl_DbCkalloc(size, "unknown", 0);
}
char *
-Tcl_AttemptAlloc(size)
- unsigned int size;
+Tcl_AttemptAlloc(
+ unsigned int size)
{
return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}
void
-Tcl_Free(ptr)
- char *ptr;
+Tcl_Free(
+ char *ptr)
{
Tcl_DbCkfree(ptr, "unknown", 0);
}
char *
-Tcl_Realloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_Realloc(
+ char *ptr,
+ unsigned int size)
{
return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
char *
-Tcl_AttemptRealloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_AttemptRealloc(
+ char *ptr,
+ unsigned int size)
{
return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}
@@ -763,8 +792,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
@@ -776,33 +806,34 @@ Tcl_AttemptRealloc(ptr, size)
* memory validate on|off
*
* Results:
- * Standard TCL results.
+ * Standard TCL results.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
-MemoryCmd (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- CONST char **argv;
+MemoryCmd(
+ 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..]\"", (char *) NULL);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option [args..]\"", 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\"", (char *) NULL);
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " file\"", NULL);
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -812,43 +843,61 @@ MemoryCmd (clientData, interp, argc, argv)
result = Tcl_DumpActiveMemory (fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2],
- (char *) NULL);
+ Tcl_AppendResult(interp, "error accessing ", argv[2], 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);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- return TCL_OK;
+ 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;
}
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;
+ }
+ 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;
}
- init_malloced_bodies = (strcmp(argv[2],"on") == 0);
- return TCL_OK;
+ TclDbDumpActiveObjects(fileP);
+ fclose(fileP);
+ Tcl_DStringFree(&buffer);
+ return TCL_OK;
}
if (strcmp(argv[1],"onexit") == 0) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " onexit file\"", (char *) NULL);
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " onexit file\"", NULL);
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -863,7 +912,7 @@ MemoryCmd (clientData, interp, argc, argv)
if (strcmp(argv[1],"tag") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " tag string\"", (char *) NULL);
+ " tag string\"", NULL);
return TCL_ERROR;
}
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
@@ -876,43 +925,43 @@ 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],
- "\": should be active, break_on_malloc, info, init, onexit, ",
- "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
+ "\": should be active, break_on_malloc, info, init, onexit, "
+ "tag, trace, trace_on_at_malloc, or validate", NULL);
return TCL_ERROR;
-argError:
+ argError:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " count\"", (char *) NULL);
+ " ", argv[1], " count\"", NULL);
return TCL_ERROR;
-bad_suboption:
+ bad_suboption:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " on|off\"", (char *) NULL);
+ " ", argv[1], " on|off\"", NULL);
return TCL_ERROR;
}
@@ -921,10 +970,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.
@@ -936,15 +984,15 @@ bad_suboption:
*/
static int
-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. */
+CheckmemCmd(
+ 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\"", (char *) NULL);
+ " fileName\"", NULL);
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
@@ -957,8 +1005,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.
@@ -970,14 +1017,13 @@ CheckmemCmd(clientData, interp, argc, argv)
*/
void
-Tcl_InitMemory(interp)
- Tcl_Interp *interp; /* Interpreter in which commands should be added */
+Tcl_InitMemory(
+ Tcl_Interp *interp) /* Interpreter in which commands should be
+ * added */
{
TclInitDbCkalloc();
- Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL);
}
@@ -994,47 +1040,50 @@ 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.
*
*----------------------------------------------------------------------
*/
char *
-Tcl_Alloc (size)
- unsigned int size;
+Tcl_Alloc(
+ 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) {
- panic("unable to alloc %u bytes", size);
+ Tcl_Panic("unable to alloc %u bytes", size);
}
return result;
}
char *
-Tcl_DbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkalloc(
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *result;
result = (char *) TclpAlloc(size);
if ((result == NULL) && size) {
- fflush(stdout);
- 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;
}
@@ -1043,15 +1092,16 @@ 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.
*
*----------------------------------------------------------------------
*/
char *
-Tcl_AttemptAlloc (size)
- unsigned int size;
+Tcl_AttemptAlloc(
+ unsigned int size)
{
char *result;
@@ -1060,57 +1110,57 @@ Tcl_AttemptAlloc (size)
}
char *
-Tcl_AttemptDbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkalloc(
+ 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(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_Realloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
result = TclpRealloc(ptr, size);
if ((result == NULL) && size) {
- panic("unable to realloc %u bytes", size);
+ Tcl_Panic("unable to realloc %u bytes", size);
}
return result;
}
char *
-Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *result;
result = (char *) TclpRealloc(ptr, size);
if ((result == NULL) && size) {
- fflush(stdout);
- 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;
}
@@ -1119,16 +1169,17 @@ 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.
*
*----------------------------------------------------------------------
*/
char *
-Tcl_AttemptRealloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_AttemptRealloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
@@ -1137,11 +1188,11 @@ Tcl_AttemptRealloc(ptr, size)
}
char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *result;
@@ -1153,25 +1204,26 @@ 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.
*
*----------------------------------------------------------------------
*/
void
-Tcl_Free (ptr)
- char *ptr;
+Tcl_Free(
+ char *ptr)
{
TclpFree(ptr);
}
int
-Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- CONST char *file;
- int line;
+Tcl_DbCkfree(
+ char *ptr,
+ CONST char *file,
+ int line)
{
TclpFree(ptr);
return 0;
@@ -1181,36 +1233,37 @@ 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.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
void
-Tcl_InitMemory(interp)
- Tcl_Interp *interp;
+Tcl_InitMemory(
+ Tcl_Interp *interp)
{
}
int
-Tcl_DumpActiveMemory(fileName)
- CONST char *fileName;
+Tcl_DumpActiveMemory(
+ CONST char *fileName)
{
return TCL_OK;
}
void
-Tcl_ValidateAllMemory(file, line)
- CONST char *file;
- int line;
+Tcl_ValidateAllMemory(
+ CONST char *file,
+ int line)
{
}
-void
-TclDumpMemoryInfo(outFile)
- FILE *outFile;
+int
+TclDumpMemoryInfo(ClientData clientData, int flags)
{
+ return 1;
}
#endif /* TCL_MEM_DEBUG */
@@ -1220,23 +1273,22 @@ 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.
*
*---------------------------------------------------------------------------
*/
void
-TclFinalizeMemorySubsystem()
+TclFinalizeMemorySubsystem(void)
{
#ifdef TCL_MEM_DEBUG
if (tclMemDumpFileName != NULL) {
@@ -1244,12 +1296,15 @@ 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
@@ -1257,3 +1312,11 @@ TclFinalizeMemorySubsystem()
TclFinalizeAllocSubsystem();
#endif
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */