* generic/tclCkalloc.c (MemoryCmd, TclFinalizeMemorySubsystem):

        Added the [memory onexit] command, intended to replace [checkmem].

        * doc/DumpActiveMemory.3:
        * doc/memory.n: Updated documentation for [memory] and related
        matters.  [Bug 487677]

        * mac/tclMacBOAMain.c (Tcl_Main, CheckmemCmd): Removed all the
        machinery for the [checkmem] command that is completely duplicated
        by code in generic/tclCkalloc.c.

        * generic/tclBinary.c:
        * generic/tclListObj.c:
        * generic/tclObj.c:
        * generic/tclStringObj.c: Removed references to [checkmem] in
        comments, referencing [memory active] instead, since it is
        documented.

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);