diff options
author | hobbs <hobbs@noemail.net> | 2010-10-02 00:23:44 (GMT) |
---|---|---|
committer | hobbs <hobbs@noemail.net> | 2010-10-02 00:23:44 (GMT) |
commit | e34340a05ce8070457c50828f3e808812c00d9c7 (patch) | |
tree | 2da57bc4de7200cdacb7d36df31d213befedb5d7 /generic/tclCkalloc.c | |
parent | 380a233e6334d13ff3cc8cd13353a16135b5788b (diff) | |
download | tcl-e34340a05ce8070457c50828f3e808812c00d9c7.zip tcl-e34340a05ce8070457c50828f3e808812c00d9c7.tar.gz tcl-e34340a05ce8070457c50828f3e808812c00d9c7.tar.bz2 |
* generic/tclExecute.c (EvalStatsCmd): change 'evalstats' to
return data to interp by default, or if given an arg, use that as
filename to output to (accepts 'stdout' and 'stderr').
Fix output to print used inst count data.
* generic/tclCkalloc.c: change TclDumpMemoryInfo sig to allow
* generic/tclInt.decls: objPtr as well as FILE* as output.
* generic/tclIntDecls.h:
FossilOrigin-Name: 4a9ba4606457fef4b186e6e3de296d5b39a6c2b4
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r-- | generic/tclCkalloc.c | 54 |
1 files changed, 32 insertions, 22 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 70aead9..8ffdda1 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -14,7 +14,7 @@ * * This code contributed by Karl Lehenbauer and Mark Diekhans * - * RCS: @(#) $Id: tclCkalloc.c,v 1.38 2010/02/25 22:20:10 nijtmans Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.39 2010/10/02 00:23:44 hobbs Exp $ */ #include "tclInt.h" @@ -165,22 +165,32 @@ TclInitDbCkalloc(void) *---------------------------------------------------------------------- */ -void -TclDumpMemoryInfo( - 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 %10lu\n", - current_bytes_malloced); - fprintf(outFile,"maximum packets allocated %10d\n", - maximum_malloc_packets); - fprintf(outFile,"maximum bytes allocated %10lu\n", + 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, + current_bytes_malloced, + maximum_malloc_packets, maximum_bytes_malloced); + if (flags == 0) { + fprintf((FILE *)clientData, buf); + } else { + /* Assume objPtr to append to */ + Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1); + } + return 1; } /* @@ -228,7 +238,7 @@ ValidateMemory( } } if (guard_failed) { - TclDumpMemoryInfo(stderr); + TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "low guard failed at %lx, %s %d\n", (long unsigned) memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ @@ -250,7 +260,7 @@ ValidateMemory( } if (guard_failed) { - TclDumpMemoryInfo(stderr); + TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "high guard failed at %lx, %s %d\n", (long unsigned) memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ @@ -389,7 +399,7 @@ Tcl_DbCkalloc( } if (result == NULL) { fflush(stdout); - TclDumpMemoryInfo(stderr); + TclDumpMemoryInfo((ClientData) stderr, 0); Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } @@ -483,7 +493,7 @@ Tcl_AttemptDbCkalloc( } if (result == NULL) { fflush(stdout); - TclDumpMemoryInfo(stderr); + TclDumpMemoryInfo((ClientData) stderr, 0); return NULL; } @@ -1247,10 +1257,10 @@ Tcl_ValidateAllMemory( { } -void -TclDumpMemoryInfo( - FILE *outFile) +int +TclDumpMemoryInfo(ClientData clientData, int flags) { + return 1; } #endif /* TCL_MEM_DEBUG */ |