summaryrefslogtreecommitdiffstats
path: root/generic/tclCkalloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r--generic/tclCkalloc.c43
1 files changed, 32 insertions, 11 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index dac67d4..98c351b 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -13,7 +13,7 @@
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
*
- * RCS: @(#) $Id: tclCkalloc.c,v 1.13 2001/12/18 15:21:20 dkf Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.14 2001/12/28 23:36:31 dgp Exp $
*/
#include "tclInt.h"
@@ -111,6 +111,7 @@ static int init_malloced_bodies = TRUE;
char *tclMemDumpFileName = NULL;
+static char *onExitMemDumpFileName = NULL;
static char dumpFile[100]; /* Records where to dump memory allocation
* information. */
@@ -304,7 +305,7 @@ Tcl_ValidateAllMemory (file, line)
* information will be written to stderr.
*
* Results:
- * Return TCL_ERROR if an error accessing the file occures, `errno'
+ * Return TCL_ERROR if an error accessing the file occurs, `errno'
* will have the file error number left in it.
*----------------------------------------------------------------------
*/
@@ -759,11 +760,14 @@ Tcl_AttemptRealloc(ptr, size)
* MemoryCmd --
* 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
- * memory display
- * memory break_on_malloc count
- * memory trace_on_at_malloc count
+ * memory init on|off
+ * memory onexit $file
+ * memory tag $string
* memory trace on|off
+ * memory trace_on_at_malloc $count
* memory validate on|off
*
* Results:
@@ -789,10 +793,10 @@ MemoryCmd (clientData, interp, argc, argv)
return TCL_ERROR;
}
- if (strcmp(argv[1],"active") == 0) {
+ if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " active file\"", (char *) NULL);
+ argv[0], " ", argv[1], " file\"", (char *) NULL);
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -818,14 +822,14 @@ MemoryCmd (clientData, interp, argc, argv)
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- char buffer[400];
- sprintf(buffer, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
+ 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, buffer, TCL_VOLATILE);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if (strcmp(argv[1],"init") == 0) {
@@ -835,6 +839,21 @@ MemoryCmd (clientData, interp, argc, argv)
init_malloced_bodies = (strcmp(argv[2],"on") == 0);
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);
+ return TCL_ERROR;
+ }
+ fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
+ onExitMemDumpFileName = dumpFile;
+ strcpy(onExitMemDumpFileName,fileName);
+ Tcl_DStringFree(&buffer);
+ return TCL_OK;
+ }
if (strcmp(argv[1],"tag") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -875,7 +894,7 @@ MemoryCmd (clientData, interp, argc, argv)
}
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be active, break_on_malloc, info, init, ",
+ "\": should be active, break_on_malloc, info, init, onexit, ",
"tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
return TCL_ERROR;
@@ -1216,6 +1235,8 @@ TclFinalizeMemorySubsystem()
Tcl_MutexLock(ckallocMutexPtr);
if (tclMemDumpFileName != NULL) {
Tcl_DumpActiveMemory(tclMemDumpFileName);
+ } else if (onExitMemDumpFileName != NULL) {
+ Tcl_DumpActiveMemory(onExitMemDumpFileName);
}
if (curTagPtr != NULL) {
TclpFree((char *) curTagPtr);