summaryrefslogtreecommitdiffstats
path: root/generic/tclCkalloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r--generic/tclCkalloc.c528
1 files changed, 284 insertions, 244 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 595c24a..70e64f0 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -13,8 +13,6 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
- *
- * RCS: @(#) $Id: tclCkalloc.c,v 1.23 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
@@ -22,6 +20,12 @@
#define FALSE 0
#define TRUE 1
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+#undef Tcl_AttemptAlloc
+#undef Tcl_AttemptRealloc
+
#ifdef TCL_MEM_DEBUG
/*
@@ -32,12 +36,12 @@
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
+ char string[1]; /* 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)
+#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1) + bytesInString))
static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* by "memory tag" command). */
@@ -54,7 +58,7 @@ struct mem_header {
struct mem_header *blink;
MemTag *tagPtr; /* Tag from "memory tag" command; may be
* NULL. */
- CONST char *file;
+ const char *file;
long length;
int line;
unsigned char low_guard[LOW_GUARD_SIZE];
@@ -78,32 +82,32 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
/*
* 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
+ * mem_header. It is used to get back to the header pointer from the body
* pointer that's used by clients.
*/
#define BODY_OFFSET \
- ((unsigned long) (&((struct mem_header *) 0)->body))
+ ((size_t) (&((struct mem_header *) 0)->body))
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
+ * 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.
*/
@@ -115,8 +119,8 @@ 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
+ * 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...
*/
@@ -127,20 +131,19 @@ 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
+ * Initialize the locks used by the allocator. This is only appropriate
* to call in a single threaded environment, such as during
* TclInitSubsystems.
*
@@ -148,11 +151,15 @@ static void ValidateMemory _ANSI_ARGS_((
*/
void
-TclInitDbCkalloc()
+TclInitDbCkalloc(void)
{
if (!ckallocInit) {
ckallocInit = 1;
ckallocMutexPtr = Tcl_GetAllocMutex();
+#ifndef TCL_THREADS
+ /* Silence compiler warning */
+ (void)ckallocMutexPtr;
+#endif
}
}
@@ -166,22 +173,36 @@ TclInitDbCkalloc()
*----------------------------------------------------------------------
*/
-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, "%s", buf);
+ } else {
+ /* Assume objPtr to append to */
+ Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
+ }
+ return 1;
}
/*
@@ -202,18 +223,19 @@ 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;
+ size_t idx;
int guard_failed = FALSE;
int byte;
@@ -223,15 +245,15 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
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);
+ 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. */
+ (long unsigned) 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");
@@ -244,16 +266,16 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
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);
+ 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. */
+ (long unsigned) 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);
@@ -261,8 +283,8 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
}
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);
}
}
@@ -284,10 +306,10 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
*/
void
-Tcl_ValidateAllMemory(file, line)
- CONST char *file; /* File from which Tcl_ValidateAllMemory was
+Tcl_ValidateAllMemory(
+ const char *file, /* File from which Tcl_ValidateAllMemory was
* called. */
- int line; /* Line number of call to
+ int line) /* Line number of call to
* Tcl_ValidateAllMemory */
{
struct mem_header *memScanP;
@@ -318,8 +340,8 @@ Tcl_ValidateAllMemory(file, line)
*/
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;
struct mem_header *memScanP;
@@ -336,10 +358,10 @@ Tcl_DumpActiveMemory (fileName)
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
- address = &memScanP->body [0];
+ address = &memScanP->body[0];
fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
- (long unsigned int) address,
- (long unsigned int) address + memScanP->length - 1,
+ (long unsigned) address,
+ (long unsigned) address + memScanP->length - 1,
memScanP->length, memScanP->file, memScanP->line,
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
@@ -371,22 +393,25 @@ Tcl_DumpActiveMemory (fileName)
*/
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;
+ struct mem_header *result = NULL;
if (validate_memory) {
Tcl_ValidateAllMemory(file, line);
}
- result = (struct mem_header *) TclpAlloc((unsigned)size +
- sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ /* Don't let size argument to TclpAlloc overflow */
+ 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);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
}
@@ -397,10 +422,10 @@ Tcl_DbCkalloc(size, file, line)
*/
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->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
}
if (!ckallocInit) {
@@ -440,11 +465,7 @@ Tcl_DbCkalloc(size, file, line)
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
- total_mallocs);
- fprintf(stderr, "program will now enter C debugger\n");
- (void) fflush(stderr);
- abort();
+ Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
}
current_malloc_packets++;
@@ -460,24 +481,27 @@ Tcl_DbCkalloc(size, file, line)
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;
+ struct mem_header *result = NULL;
if (validate_memory) {
Tcl_ValidateAllMemory(file, line);
}
- result = (struct mem_header *) TclpAlloc((unsigned)size +
- sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ /* Don't let size argument to TclpAlloc overflow */
+ 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);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
return NULL;
}
@@ -487,10 +511,10 @@ Tcl_AttemptDbCkalloc(size, file, line)
* 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->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
}
if (!ckallocInit) {
@@ -530,11 +554,7 @@ Tcl_AttemptDbCkalloc(size, file, line)
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
- total_mallocs);
- fprintf(stderr, "program will now enter C debugger\n");
- (void) fflush(stderr);
- abort();
+ Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
}
current_malloc_packets++;
@@ -569,16 +589,16 @@ Tcl_AttemptDbCkalloc(size, file, line)
*----------------------------------------------------------------------
*/
-int
-Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- CONST char *file;
- int line;
+void
+Tcl_DbCkfree(
+ char *ptr,
+ const char *file,
+ int line)
{
struct mem_header *memp;
if (ptr == NULL) {
- return 0;
+ return;
}
/*
@@ -589,7 +609,7 @@ Tcl_DbCkfree(ptr, file, line)
* words on these machines).
*/
- memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
if (alloc_tracing) {
fprintf(stderr, "ckfree %lx %ld %s %d\n",
@@ -603,7 +623,7 @@ Tcl_DbCkfree(ptr, 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++;
@@ -632,8 +652,6 @@ Tcl_DbCkfree(ptr, file, line)
}
TclpFree((char *) memp);
Tcl_MutexUnlock(ckallocMutexPtr);
-
- return 0;
}
/*
@@ -650,13 +668,13 @@ Tcl_DbCkfree(ptr, file, line)
*/
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;
@@ -668,26 +686,26 @@ Tcl_DbCkrealloc(ptr, size, file, line)
* See comment from Tcl_DbCkfree before you change the following line.
*/
- memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
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;
@@ -699,19 +717,19 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
* See comment from Tcl_DbCkfree before you change the following line.
*/
- memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
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;
}
@@ -732,44 +750,38 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*----------------------------------------------------------------------
*/
-#undef Tcl_Alloc
-#undef Tcl_Free
-#undef Tcl_Realloc
-#undef Tcl_AttemptAlloc
-#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);
}
@@ -798,37 +810,40 @@ Tcl_AttemptRealloc(ptr, size)
*/
/* 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;
+ 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_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s option [args..]\"", argv[0]));
return TCL_ERROR;
}
- if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
+ 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);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s file\"",
+ argv[0], argv[1]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
if (fileName == NULL) {
return TCL_ERROR;
}
- result = Tcl_DumpActiveMemory (fileName);
+ result = Tcl_DumpActiveMemory(fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2],
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
+ argv[2], Tcl_PosixError(interp)));
return TCL_ERROR;
}
return TCL_OK;
@@ -843,27 +858,48 @@ MemoryCmd(clientData, interp, argc, argv)
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",
+ 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,
+ "current bytes allocated", (unsigned long)current_bytes_malloced,
"maximum packets allocated", maximum_malloc_packets,
- "maximum bytes allocated", maximum_bytes_malloced);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ "maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
return TCL_OK;
}
- if (strcmp(argv[1],"init") == 0) {
+ if (strcmp(argv[1], "init") == 0) {
if (argc != 3) {
goto bad_suboption;
}
init_malloced_bodies = (strcmp(argv[2],"on") == 0);
return TCL_OK;
}
+ if (strcmp(argv[1], "objs") == 0) {
+ if (argc != 3) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s objs file\"", argv[0]));
+ return TCL_ERROR;
+ }
+ fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
+ fileP = fopen(fileName, "w");
+ if (fileP == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot open output file: %s",
+ Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ 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);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s onexit file\"", argv[0]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -877,16 +913,17 @@ 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);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s tag string\"", argv[0]));
return TCL_ERROR;
}
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
TclpFree((char *) curTagPtr);
}
- curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2])));
+ len = strlen(argv[2]);
+ curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
curTagPtr->refCount = 0;
- strcpy(curTagPtr->string, argv[2]);
+ memcpy(curTagPtr->string, argv[2], len + 1);
return TCL_OK;
}
if (strcmp(argv[1],"trace") == 0) {
@@ -914,19 +951,20 @@ MemoryCmd(clientData, interp, argc, argv)
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);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": should be active, break_on_malloc, info, "
+ "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
+ argv[1]));
return TCL_ERROR;
argError:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " count\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
return TCL_ERROR;
bad_suboption:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " on|off\"", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
return TCL_ERROR;
}
@@ -949,15 +987,15 @@ MemoryCmd(clientData, interp, argc, argv)
*/
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);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s fileName\"", argv[0]));
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
@@ -982,14 +1020,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, NULL, NULL);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
}
@@ -1014,8 +1051,8 @@ Tcl_InitMemory(interp)
*/
char *
-Tcl_Alloc(size)
- unsigned int size;
+Tcl_Alloc(
+ unsigned int size)
{
char *result;
@@ -1023,7 +1060,7 @@ Tcl_Alloc(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
+ * 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).
*
@@ -1038,10 +1075,10 @@ Tcl_Alloc(size)
}
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;
@@ -1066,8 +1103,8 @@ Tcl_DbCkalloc(size, file, line)
*/
char *
-Tcl_AttemptAlloc(size)
- unsigned int size;
+Tcl_AttemptAlloc(
+ unsigned int size)
{
char *result;
@@ -1076,10 +1113,10 @@ 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;
@@ -1099,9 +1136,9 @@ Tcl_AttemptDbCkalloc(size, file, line)
*/
char *
-Tcl_Realloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_Realloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
@@ -1114,11 +1151,11 @@ Tcl_Realloc(ptr, size)
}
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;
@@ -1143,9 +1180,9 @@ Tcl_DbCkrealloc(ptr, size, file, line)
*/
char *
-Tcl_AttemptRealloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_AttemptRealloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
@@ -1154,11 +1191,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;
@@ -1179,20 +1216,19 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*/
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;
+void
+Tcl_DbCkfree(
+ char *ptr,
+ const char *file,
+ int line)
{
TclpFree(ptr);
- return 0;
}
/*
@@ -1207,29 +1243,31 @@ Tcl_DbCkfree(ptr, file, line)
*/
/* 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 */
@@ -1254,7 +1292,7 @@ TclDumpMemoryInfo(outFile)
*/
void
-TclFinalizeMemorySubsystem()
+TclFinalizeMemorySubsystem(void)
{
#ifdef TCL_MEM_DEBUG
if (tclMemDumpFileName != NULL) {
@@ -1284,5 +1322,7 @@ TclFinalizeMemorySubsystem()
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
generated by cgit v0.12 at 2025-10-21 15:54:38 (GMT)