summaryrefslogtreecommitdiffstats
path: root/generic/tclCkalloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r--generic/tclCkalloc.c416
1 files changed, 226 insertions, 190 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index f0c625f..5263e82 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -5,9 +5,9 @@
* problems involving overwritten, double freeing memory and loss of
* memory.
*
- * Copyright © 1991-1994 The Regents of the University of California.
- * Copyright © 1994-1997 Sun Microsystems, Inc.
- * Copyright © 1998-1999 Scriptics Corporation.
+ * 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.
@@ -20,12 +20,6 @@
#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
/*
@@ -33,15 +27,15 @@
* "memory tag" command is invoked, to hold the current tag.
*/
-typedef struct {
- size_t refCount; /* Number of mem_headers referencing this
+typedef struct MemTag {
+ int refCount; /* Number of mem_headers referencing this
* tag. */
- char string[TCLFLEXARRAY]; /* Actual size of string will be as large as
+ 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) ((offsetof(MemTag, string) + 1U) + (bytesInString))
+#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). */
@@ -52,26 +46,26 @@ static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* to help detect chunk under-runs.
*/
-#define LOW_GUARD_SIZE (8 + (32 - (sizeof(size_t) + sizeof(int)))%8)
+#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
* NULL. */
- const char *file;
- size_t length;
+ CONST char *file;
+ long length;
int line;
unsigned char low_guard[LOW_GUARD_SIZE];
/* Aligns body on 8-byte boundary, plus
* provides at least 8 additional guard bytes
* to detect underruns. */
- char body[TCLFLEXARRAY]; /* First byte of client's space. Actual size
+ 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 */
-#define GUARD_VALUE 0x61
+#define GUARD_VALUE 0141
/*
* The following macro determines the amount of guard space *above* each chunk
@@ -89,14 +83,14 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
#define BODY_OFFSET \
((size_t) (&((struct mem_header *) 0)->body))
-static size_t total_mallocs = 0;
-static size_t total_frees = 0;
+static int total_mallocs = 0;
+static int total_frees = 0;
static size_t current_bytes_malloced = 0;
static size_t maximum_bytes_malloced = 0;
-static size_t current_malloc_packets = 0;
-static size_t maximum_malloc_packets = 0;
-static size_t break_on_malloc = 0;
-static size_t trace_on_at_malloc = 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;
#ifdef MEM_VALIDATE
@@ -128,13 +122,24 @@ static Tcl_Mutex *ckallocMutexPtr;
static int ckallocInit = 0;
/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, CONST char *argv[]);
+static int MemoryCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, CONST char *argv[]);
+static void ValidateMemory(struct mem_header *memHeaderP,
+ CONST char *file, int line, int nukeGuards);
+
+/*
*----------------------------------------------------------------------
*
* TclInitDbCkalloc --
*
* Initialize the locks used by the allocator. This is only appropriate
* to call in a single threaded environment, such as during
- * Tcl_InitSubsystems.
+ * TclInitSubsystems.
*
*----------------------------------------------------------------------
*/
@@ -145,7 +150,7 @@ TclInitDbCkalloc(void)
if (!ckallocInit) {
ckallocInit = 1;
ckallocMutexPtr = Tcl_GetAllocMutex();
-#if !TCL_THREADS
+#ifndef TCL_THREADS
/* Silence compiler warning */
(void)ckallocMutexPtr;
#endif
@@ -163,30 +168,26 @@ TclInitDbCkalloc(void)
*/
int
-TclDumpMemoryInfo(
- void *clientData,
- int flags)
+TclDumpMemoryInfo(ClientData clientData, int flags)
{
char buf[1024];
- if (clientData == NULL) {
- return 0;
- }
- snprintf(buf, sizeof(buf),
- "total mallocs %10" TCL_Z_MODIFIER "u\n"
- "total frees %10" TCL_Z_MODIFIER "u\n"
- "current packets allocated %10" TCL_Z_MODIFIER "u\n"
- "current bytes allocated %10" TCL_Z_MODIFIER "u\n"
- "maximum packets allocated %10" TCL_Z_MODIFIER "u\n"
- "maximum bytes allocated %10" TCL_Z_MODIFIER "u\n",
+ 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,
- current_bytes_malloced,
+ (unsigned long)current_bytes_malloced,
maximum_malloc_packets,
- maximum_bytes_malloced);
+ (unsigned long)maximum_bytes_malloced);
if (flags == 0) {
- fprintf((FILE *)clientData, "%s", buf);
+ fprintf((FILE *)clientData, buf);
} else {
/* Assume objPtr to append to */
Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
@@ -215,7 +216,7 @@ static void
ValidateMemory(
struct mem_header *memHeaderP,
/* Memory chunk to validate */
- const char *file, /* File containing the call to
+ CONST char *file, /* File containing the call to
* Tcl_ValidateAllMemory */
int line, /* Line number of call to
* Tcl_ValidateAllMemory */
@@ -233,17 +234,17 @@ ValidateMemory(
if (byte != GUARD_VALUE) {
guard_failed = TRUE;
fflush(stdout);
- byte &= 0xFF;
- fprintf(stderr, "low guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte,
+ byte &= 0xff;
+ 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, 0);
- fprintf(stderr, "low guard failed at %p, %s %d\n",
- memHeaderP->body, file, line);
+ 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, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
+ fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
memHeaderP->file, memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -254,18 +255,18 @@ ValidateMemory(
if (byte != GUARD_VALUE) {
guard_failed = TRUE;
fflush(stdout);
- byte &= 0xFF;
- fprintf(stderr, "hi guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte,
+ byte &= 0xff;
+ 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, 0);
- fprintf(stderr, "high guard failed at %p, %s %d\n",
- memHeaderP->body, file, line);
+ 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, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
+ fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
memHeaderP->length, memHeaderP->file,
memHeaderP->line);
Tcl_Panic("Memory validation failure");
@@ -296,7 +297,7 @@ ValidateMemory(
void
Tcl_ValidateAllMemory(
- const char *file, /* File from which Tcl_ValidateAllMemory was
+ CONST char *file, /* File from which Tcl_ValidateAllMemory was
* called. */
int line) /* Line number of call to
* Tcl_ValidateAllMemory */
@@ -330,7 +331,7 @@ Tcl_ValidateAllMemory(
int
Tcl_DumpActiveMemory(
- 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;
@@ -347,9 +348,10 @@ Tcl_DumpActiveMemory(
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
- address = &memScanP->body[0];
- fprintf(fileP, "%p - %p %" TCL_Z_MODIFIER "u @ %s %d %s",
- address, address + memScanP->length - 1,
+ 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);
(void) fputc('\n', fileP);
@@ -368,7 +370,7 @@ Tcl_DumpActiveMemory(
* Tcl_DbCkalloc - debugging ckalloc
*
* Allocate the requested amount of space plus some extra for guard bands
- * at both ends of the request, plus a size, panicking if there isn't
+ * 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.
*
@@ -383,7 +385,7 @@ Tcl_DumpActiveMemory(
char *
Tcl_DbCkalloc(
unsigned int size,
- const char *file,
+ CONST char *file,
int line)
{
struct mem_header *result = NULL;
@@ -393,13 +395,13 @@ Tcl_DbCkalloc(
}
/* Don't let size argument to TclpAlloc overflow */
- if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) {
- result = (struct mem_header *) TclpAlloc(size +
- offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE);
+ 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, 0);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
}
@@ -411,7 +413,7 @@ Tcl_DbCkalloc(
if (init_malloced_bodies) {
memset(result, GUARD_VALUE,
- offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE + size);
+ size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
@@ -438,7 +440,7 @@ Tcl_DbCkalloc(
total_mallocs++;
if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
(void) fflush(stdout);
- fprintf(stderr, "reached malloc trace enable point (%" TCL_Z_MODIFIER "u)\n",
+ fprintf(stderr, "reached malloc trace enable point (%d)\n",
total_mallocs);
fflush(stderr);
alloc_tracing = TRUE;
@@ -446,14 +448,18 @@ Tcl_DbCkalloc(
}
if (alloc_tracing) {
- fprintf(stderr,"ckalloc %p %u %s %d\n",
- result->body, size, file, line);
+ 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);
- Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs);
+ 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++;
@@ -473,7 +479,7 @@ Tcl_DbCkalloc(
char *
Tcl_AttemptDbCkalloc(
unsigned int size,
- const char *file,
+ CONST char *file,
int line)
{
struct mem_header *result = NULL;
@@ -483,13 +489,13 @@ Tcl_AttemptDbCkalloc(
}
/* Don't let size argument to TclpAlloc overflow */
- if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) {
- result = (struct mem_header *) TclpAlloc(size +
- offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE);
+ 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, 0);
+ TclDumpMemoryInfo((ClientData) stderr, 0);
return NULL;
}
@@ -500,7 +506,7 @@ Tcl_AttemptDbCkalloc(
*/
if (init_malloced_bodies) {
memset(result, GUARD_VALUE,
- offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE + size);
+ size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
@@ -527,7 +533,7 @@ Tcl_AttemptDbCkalloc(
total_mallocs++;
if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
(void) fflush(stdout);
- fprintf(stderr, "reached malloc trace enable point (%" TCL_Z_MODIFIER "u)\n",
+ fprintf(stderr, "reached malloc trace enable point (%d)\n",
total_mallocs);
fflush(stderr);
alloc_tracing = TRUE;
@@ -535,14 +541,18 @@ Tcl_AttemptDbCkalloc(
}
if (alloc_tracing) {
- fprintf(stderr,"ckalloc %p %u %s %d\n",
- result->body, size, file, line);
+ 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);
- Tcl_Panic("reached malloc break limit (%" TCL_Z_MODIFIER "u)", total_mallocs);
+ 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++;
@@ -580,7 +590,7 @@ Tcl_AttemptDbCkalloc(
void
Tcl_DbCkfree(
char *ptr,
- const char *file,
+ CONST char *file,
int line)
{
struct mem_header *memp;
@@ -600,8 +610,8 @@ Tcl_DbCkfree(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
if (alloc_tracing) {
- fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
- memp->body, memp->length, file, line);
+ fprintf(stderr, "ckfree %lx %ld %s %d\n",
+ (long unsigned int) memp->body, memp->length, file, line);
}
if (validate_memory) {
@@ -611,7 +621,7 @@ Tcl_DbCkfree(
Tcl_MutexLock(ckallocMutexPtr);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
- memset(ptr, GUARD_VALUE, memp->length);
+ memset(ptr, GUARD_VALUE, (size_t) memp->length);
}
total_frees++;
@@ -619,8 +629,9 @@ Tcl_DbCkfree(
current_bytes_malloced -= memp->length;
if (memp->tagPtr != NULL) {
- if ((memp->tagPtr->refCount-- <= 1) && (curTagPtr != memp->tagPtr)) {
- TclpFree(memp->tagPtr);
+ memp->tagPtr->refCount--;
+ if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
+ TclpFree((char *) memp->tagPtr);
}
}
@@ -637,7 +648,7 @@ Tcl_DbCkfree(
if (allocHead == memp) {
allocHead = memp->flink;
}
- TclpFree(memp);
+ TclpFree((char *) memp);
Tcl_MutexUnlock(ckallocMutexPtr);
}
@@ -658,11 +669,11 @@ char *
Tcl_DbCkrealloc(
char *ptr,
unsigned int size,
- const char *file,
+ CONST char *file,
int line)
{
char *newPtr;
- size_t copySize;
+ unsigned int copySize;
struct mem_header *memp;
if (ptr == NULL) {
@@ -676,11 +687,11 @@ Tcl_DbCkrealloc(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
- if (copySize > memp->length) {
+ if (copySize > (unsigned int) memp->length) {
copySize = memp->length;
}
- newPtr = (char *)Tcl_DbCkalloc(size, file, line);
- memcpy(newPtr, ptr, copySize);
+ newPtr = Tcl_DbCkalloc(size, file, line);
+ memcpy(newPtr, ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
@@ -689,11 +700,11 @@ char *
Tcl_AttemptDbCkrealloc(
char *ptr,
unsigned int size,
- const char *file,
+ CONST char *file,
int line)
{
char *newPtr;
- size_t copySize;
+ unsigned int copySize;
struct mem_header *memp;
if (ptr == NULL) {
@@ -707,14 +718,14 @@ Tcl_AttemptDbCkrealloc(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
- if (copySize > memp->length) {
+ if (copySize > (unsigned int) memp->length) {
copySize = memp->length;
}
- newPtr = (char *)Tcl_AttemptDbCkalloc(size, file, line);
+ newPtr = Tcl_AttemptDbCkalloc(size, file, line);
if (newPtr == NULL) {
return NULL;
}
- memcpy(newPtr, ptr, copySize);
+ memcpy(newPtr, ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
@@ -737,6 +748,12 @@ Tcl_AttemptDbCkrealloc(
*----------------------------------------------------------------------
*/
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+#undef Tcl_AttemptAlloc
+#undef Tcl_AttemptRealloc
+
char *
Tcl_Alloc(
unsigned int size)
@@ -795,56 +812,56 @@ Tcl_AttemptRealloc(
*
*----------------------------------------------------------------------
*/
+ /* ARGSUSED */
static int
MemoryCmd(
- TCL_UNUSED(void *),
+ ClientData clientData,
Tcl_Interp *interp,
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Obj values of arguments. */
+ int argc,
+ CONST char *argv[])
{
- const char *fileName;
+ CONST char *fileName;
FILE *fileP;
Tcl_DString buffer;
int result;
size_t len;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option [args..]");
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option [args..]\"", NULL);
return TCL_ERROR;
}
- if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "file");
+ if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " file\"", NULL);
return TCL_ERROR;
}
- fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
+ 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_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
- TclGetString(objv[2]), Tcl_PosixError(interp)));
+ Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
return TCL_ERROR;
}
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
- Tcl_WideInt value;
- if (objc != 3) {
+ if (strcmp(argv[1],"break_on_malloc") == 0) {
+ if (argc != 3) {
goto argError;
}
- if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
return TCL_ERROR;
}
- break_on_malloc = value;
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]),"info") == 0) {
+ if (strcmp(argv[1],"info") == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n",
+ "%-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,
@@ -852,27 +869,26 @@ MemoryCmd(
"maximum bytes allocated", maximum_bytes_malloced));
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]), "init") == 0) {
- if (objc != 3) {
+ if (strcmp(argv[1],"init") == 0) {
+ if (argc != 3) {
goto bad_suboption;
}
- init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
+ init_malloced_bodies = (strcmp(argv[2],"on") == 0);
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]), "objs") == 0) {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "file");
+ 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, TclGetString(objv[2]), &buffer);
+ 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)));
+ Tcl_AppendResult(interp, "cannot open output file", NULL);
return TCL_ERROR;
}
TclDbDumpActiveObjects(fileP);
@@ -880,12 +896,13 @@ MemoryCmd(
Tcl_DStringFree(&buffer);
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]),"onexit") == 0) {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "file");
+ if (strcmp(argv[1],"onexit") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " onexit file\"", NULL);
return TCL_ERROR;
}
- fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
+ fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
if (fileName == NULL) {
return TCL_ERROR;
}
@@ -894,59 +911,59 @@ MemoryCmd(
Tcl_DStringFree(&buffer);
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]),"tag") == 0) {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "file");
+ if (strcmp(argv[1],"tag") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " tag string\"", NULL);
return TCL_ERROR;
}
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
- TclpFree(curTagPtr);
+ TclpFree((char *) curTagPtr);
}
- len = strlen(TclGetString(objv[2]));
+ len = strlen(argv[2]);
curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
curTagPtr->refCount = 0;
- memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1);
+ memcpy(curTagPtr->string, argv[2], len + 1);
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]),"trace") == 0) {
- if (objc != 3) {
+ if (strcmp(argv[1],"trace") == 0) {
+ if (argc != 3) {
goto bad_suboption;
}
- alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0);
+ alloc_tracing = (strcmp(argv[2],"on") == 0);
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) {
- Tcl_WideInt value;
- if (objc != 3) {
+ if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
+ if (argc != 3) {
goto argError;
}
- if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
return TCL_ERROR;
}
- trace_on_at_malloc = value;
return TCL_OK;
}
- if (strcmp(TclGetString(objv[1]),"validate") == 0) {
- if (objc != 3) {
+ if (strcmp(argv[1],"validate") == 0) {
+ if (argc != 3) {
goto bad_suboption;
}
- validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
+ validate_memory = (strcmp(argv[2],"on") == 0);
return TCL_OK;
}
- 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",
- TclGetString(objv[1])));
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be active, break_on_malloc, info, init, onexit, "
+ "tag, trace, trace_on_at_malloc, or validate", NULL);
return TCL_ERROR;
argError:
- Tcl_WrongNumArgs(interp, 2, objv, "count");
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " count\"", NULL);
return TCL_ERROR;
bad_suboption:
- Tcl_WrongNumArgs(interp, 2, objv, "on|off");
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " on|off\"", NULL);
return TCL_ERROR;
}
@@ -967,19 +984,21 @@ MemoryCmd(
*
*----------------------------------------------------------------------
*/
+
static int
CheckmemCmd(
- TCL_UNUSED(void *),
+ ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Interpreter for evaluation. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Obj values of arguments. */
+ int argc, /* Number of arguments. */
+ CONST char *argv[]) /* String values of arguments. */
{
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "fileName");
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " fileName\"", NULL);
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
- strcpy(tclMemDumpFileName, TclGetString(objv[1]));
+ strcpy(tclMemDumpFileName, argv[1]);
return TCL_OK;
}
@@ -1005,8 +1024,8 @@ Tcl_InitMemory(
* added */
{
TclInitDbCkalloc();
- Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
+ Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL);
}
@@ -1034,7 +1053,9 @@ char *
Tcl_Alloc(
unsigned int size)
{
- char *result = (char *)TclpAlloc(size);
+ char *result;
+
+ result = TclpAlloc(size);
/*
* Most systems will not alloc(0), instead bumping it to one so that NULL
@@ -1055,10 +1076,12 @@ Tcl_Alloc(
char *
Tcl_DbCkalloc(
unsigned int size,
- const char *file,
+ CONST char *file,
int line)
{
- char *result = (char *)TclpAlloc(size);
+ char *result;
+
+ result = (char *) TclpAlloc(size);
if ((result == NULL) && size) {
fflush(stdout);
@@ -1082,16 +1105,22 @@ char *
Tcl_AttemptAlloc(
unsigned int size)
{
- return (char *)TclpAlloc(size);
+ char *result;
+
+ result = TclpAlloc(size);
+ return result;
}
char *
Tcl_AttemptDbCkalloc(
unsigned int size,
- TCL_UNUSED(const char *) /*file*/,
- TCL_UNUSED(int) /*line*/)
+ CONST char *file,
+ int line)
{
- return (char *)TclpAlloc(size);
+ char *result;
+
+ result = (char *) TclpAlloc(size);
+ return result;
}
/*
@@ -1110,7 +1139,9 @@ Tcl_Realloc(
char *ptr,
unsigned int size)
{
- char *result = (char *)TclpRealloc(ptr, size);
+ char *result;
+
+ result = TclpRealloc(ptr, size);
if ((result == NULL) && size) {
Tcl_Panic("unable to realloc %u bytes", size);
@@ -1122,10 +1153,12 @@ char *
Tcl_DbCkrealloc(
char *ptr,
unsigned int size,
- const char *file,
+ CONST char *file,
int line)
{
- char *result = (char *)TclpRealloc(ptr, size);
+ char *result;
+
+ result = (char *) TclpRealloc(ptr, size);
if ((result == NULL) && size) {
fflush(stdout);
@@ -1150,17 +1183,23 @@ Tcl_AttemptRealloc(
char *ptr,
unsigned int size)
{
- return (char *)TclpRealloc(ptr, size);
+ char *result;
+
+ result = TclpRealloc(ptr, size);
+ return result;
}
char *
Tcl_AttemptDbCkrealloc(
char *ptr,
unsigned int size,
- TCL_UNUSED(const char *) /*file*/,
- TCL_UNUSED(int) /*line*/)
+ CONST char *file,
+ int line)
{
- return (char *)TclpRealloc(ptr, size);
+ char *result;
+
+ result = (char *) TclpRealloc(ptr, size);
+ return result;
}
/*
@@ -1185,8 +1224,8 @@ Tcl_Free(
void
Tcl_DbCkfree(
char *ptr,
- TCL_UNUSED(const char *) /*file*/,
- TCL_UNUSED(int) /*line*/)
+ CONST char *file,
+ int line)
{
TclpFree(ptr);
}
@@ -1201,30 +1240,29 @@ Tcl_DbCkfree(
*
*----------------------------------------------------------------------
*/
+ /* ARGSUSED */
void
Tcl_InitMemory(
- TCL_UNUSED(Tcl_Interp *) /*interp*/)
+ Tcl_Interp *interp)
{
}
int
Tcl_DumpActiveMemory(
- TCL_UNUSED(const char *) /*fileName*/)
+ CONST char *fileName)
{
return TCL_OK;
}
void
Tcl_ValidateAllMemory(
- TCL_UNUSED(const char *) /*file*/,
- TCL_UNUSED(int) /*line*/)
+ CONST char *file,
+ int line)
{
}
int
-TclDumpMemoryInfo(
- TCL_UNUSED(void *),
- TCL_UNUSED(int) /*flags*/)
+TclDumpMemoryInfo(ClientData clientData, int flags)
{
return 1;
}
@@ -1263,7 +1301,7 @@ TclFinalizeMemorySubsystem(void)
Tcl_MutexLock(ckallocMutexPtr);
if (curTagPtr != NULL) {
- TclpFree(curTagPtr);
+ TclpFree((char *) curTagPtr);
curTagPtr = NULL;
}
allocHead = NULL;
@@ -1271,7 +1309,7 @@ TclFinalizeMemorySubsystem(void)
Tcl_MutexUnlock(ckallocMutexPtr);
#endif
-#if defined(USE_TCLALLOC) && USE_TCLALLOC
+#if USE_TCLALLOC
TclFinalizeAllocSubsystem();
#endif
}
@@ -1281,7 +1319,5 @@ TclFinalizeMemorySubsystem(void)
* mode: c
* c-basic-offset: 4
* fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
* End:
*/
generated by cgit v0.12 at 2025-12-20 14:53:52 (GMT)