diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBinary.c | 6 | ||||
| -rw-r--r-- | generic/tclCkalloc.c | 43 | ||||
| -rw-r--r-- | generic/tclListObj.c | 8 | ||||
| -rw-r--r-- | generic/tclObj.c | 20 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 8 |
5 files changed, 53 insertions, 32 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 54f8ff0..a3505d6 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBinary.c,v 1.9 2001/11/29 15:38:40 dkf Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.10 2001/12/28 23:36:31 dgp Exp $ */ #include <math.h> @@ -180,8 +180,8 @@ Tcl_NewByteArrayObj(bytes, length) * TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj * above except that it calls Tcl_DbCkalloc directly with the file name * and line number from its caller. This simplifies debugging since then - * the checkmem command will report the correct file name and line number - * when reporting objects that haven't been freed. + * the [memory active] command will report the correct file name and line + * number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the * result of calling Tcl_NewByteArrayObj. 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); diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 2db0494..864ab35 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclListObj.c,v 1.11 2001/11/16 21:41:14 kennykb Exp $ + * RCS: @(#) $Id: tclListObj.c,v 1.12 2001/12/28 23:36:31 dgp Exp $ */ #include "tclInt.h" @@ -132,9 +132,9 @@ Tcl_NewListObj(objc, objv) * TCL_MEM_DEBUG is defined. It creates new list objects. It is the * same as the Tcl_NewListObj procedure above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the checkmem command - * will report the correct file name and line number when reporting - * objects that haven't been freed. + * caller. This simplifies debugging since then the [memory active] + * command will report the correct file name and line number when + * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the * result of calling Tcl_NewListObj. diff --git a/generic/tclObj.c b/generic/tclObj.c index 8ebb2db..fabb80c 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.26 2001/11/23 01:28:58 das Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.27 2001/12/28 23:36:31 dgp Exp $ */ #include "tclInt.h" @@ -534,7 +534,7 @@ Tcl_NewObj() * empty string. It is the same as the Tcl_NewObj procedure above * except that it calls Tcl_DbCkalloc directly with the file name and * line number from its caller. This simplifies debugging since then - * the checkmem command will report the correct file name and line + * the [memory active] command will report the correct file name and line * number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the @@ -936,9 +936,9 @@ Tcl_NewBooleanObj(boolValue) * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the * same as the Tcl_NewBooleanObj procedure above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the checkmem command - * will report the correct file name and line number when reporting - * objects that haven't been freed. + * caller. This simplifies debugging since then the [memory active] + * command will report the correct file name and line number when + * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the * result of calling Tcl_NewBooleanObj. @@ -1294,9 +1294,9 @@ Tcl_NewDoubleObj(dblValue) * TCL_MEM_DEBUG is defined. It creates new double objects. It is the * same as the Tcl_NewDoubleObj procedure above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the checkmem command - * will report the correct file name and line number when reporting - * objects that haven't been freed. + * caller. This simplifies debugging since then the [memory active] + * command will report the correct file name and line number when + * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the * result of calling Tcl_NewDoubleObj. @@ -1925,8 +1925,8 @@ Tcl_NewLongObj(longValue) * When the core is compiled with TCL_MEM_DEBUG defined, * Tcl_DbNewLongObj calls Tcl_DbCkalloc directly with the file name and * line number from its caller. This simplifies debugging since then - * the checkmem command will report the caller's file name and line - * number when reporting objects that haven't been freed. + * the [memory active] command will report the caller's file name and + * line number when reporting objects that haven't been freed. * * Otherwise, when the core is compiled without TCL_MEM_DEBUG defined, * this procedure just returns the result of calling Tcl_NewLongObj. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index d37b7ba..bd07208 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.21 2001/05/15 21:30:46 hobbs Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.22 2001/12/28 23:36:31 dgp Exp $ */ #include "tclInt.h" @@ -219,9 +219,9 @@ Tcl_NewStringObj(bytes, length) * TCL_MEM_DEBUG is defined. It creates new string objects. It is the * same as the Tcl_NewStringObj procedure above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the checkmem command - * will report the correct file name and line number when reporting - * objects that haven't been freed. + * caller. This simplifies debugging since then the [memory active] + * command will report the correct file name and line number when + * reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, this procedure just returns the * result of calling Tcl_NewStringObj. |