summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
authorhobbs <hobbs>2010-10-02 00:23:44 (GMT)
committerhobbs <hobbs>2010-10-02 00:23:44 (GMT)
commit49efeab465625d855a9394d4fa38c7f9a5039f77 (patch)
tree2da57bc4de7200cdacb7d36df31d213befedb5d7 /generic/tclExecute.c
parent0ee4b2f57c83341c5896b9abe552e28874292a12 (diff)
downloadtcl-49efeab465625d855a9394d4fa38c7f9a5039f77.zip
tcl-49efeab465625d855a9394d4fa38c7f9a5039f77.tar.gz
tcl-49efeab465625d855a9394d4fa38c7f9a5039f77.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:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c193
1 files changed, 107 insertions, 86 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ade67b6..606cca2 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.502 2010/09/28 15:22:54 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.503 2010/10/02 00:23:44 hobbs Exp $
*/
#include "tclInt.h"
@@ -2077,7 +2077,6 @@ TEBCresume(
NRE_ASSERT(TOP_CB(interp)->procPtr == TEBCreturn);
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
-
if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
iPtr->flags |= ERR_ALREADY_LOGGED;
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
@@ -8338,9 +8337,13 @@ EvalStatsCmd(
int decadeHigh, minSizeDecade, maxSizeDecade, length, i;
char *litTableStats;
LiteralEntry *entryPtr;
+ Tcl_Obj *objPtr;
#define Percent(a,b) ((a) * 100.0 / (b))
+ objPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(objPtr);
+
numInstructions = 0.0;
for (i = 0; i < 256; i++) {
if (statsPtr->instructionCount[i] != 0) {
@@ -8371,65 +8374,65 @@ EvalStatsCmd(
* Summary statistics, total and current source and ByteCode sizes.
*/
- fprintf(stdout, "\n----------------------------------------------------------------\n");
- fprintf(stdout,
- "Compilation and execution statistics for interpreter 0x%p\n",
+ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
+ Tcl_AppendPrintfToObj(objPtr,
+ "Compilation and execution statistics for interpreter %#lx\n",
iPtr);
- fprintf(stdout, "\nNumber ByteCodes executed\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n",
statsPtr->numExecutions);
- fprintf(stdout, "Number ByteCodes compiled\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n",
statsPtr->numCompilations);
- fprintf(stdout, " Mean executions/compile\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n",
statsPtr->numExecutions / (float)statsPtr->numCompilations);
- fprintf(stdout, "\nInstructions executed\t\t%.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
numInstructions);
- fprintf(stdout, " Mean inst/compile\t\t%.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean inst/compile\t\t%.0f\n",
numInstructions / statsPtr->numCompilations);
- fprintf(stdout, " Mean inst/execution\t\t%.0f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n",
numInstructions / statsPtr->numExecutions);
- fprintf(stdout, "\nTotal ByteCodes\t\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n",
statsPtr->numCompilations);
- fprintf(stdout, " Source bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n",
statsPtr->totalSrcBytes);
- fprintf(stdout, " Code bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n",
totalCodeBytes);
- fprintf(stdout, " ByteCode bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n",
statsPtr->totalByteCodeBytes);
- fprintf(stdout, " Literal bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n",
totalLiteralBytes);
- fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)),
(unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)),
statsPtr->totalLitStringBytes);
- fprintf(stdout, " Mean code/compile\t\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n",
totalCodeBytes / statsPtr->numCompilations);
- fprintf(stdout, " Mean code/source\t\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n",
totalCodeBytes / statsPtr->totalSrcBytes);
- fprintf(stdout, "\nCurrent (active) ByteCodes\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n",
numCurrentByteCodes);
- fprintf(stdout, " Source bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n",
statsPtr->currentSrcBytes);
- fprintf(stdout, " Code bytes\t\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code bytes\t\t\t%.6g\n",
currentCodeBytes);
- fprintf(stdout, " ByteCode bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode bytes\t\t%.6g\n",
statsPtr->currentByteCodeBytes);
- fprintf(stdout, " Literal bytes\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n",
currentLiteralBytes);
- fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
statsPtr->currentLitStringBytes);
- fprintf(stdout, " Mean code/source\t\t%.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n",
currentCodeBytes / statsPtr->currentSrcBytes);
- fprintf(stdout, " Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
+ Tcl_AppendPrintfToObj(objPtr, " Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
(currentCodeBytes + statsPtr->currentSrcBytes),
(currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
@@ -8441,18 +8444,18 @@ EvalStatsCmd(
*/
numSharedMultX = 0;
- fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
- fprintf(stdout, " Object had refcount <=1 (not shared)\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
+ Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%ld\n",
tclObjsShared[1]);
for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) {
- fprintf(stdout, " refcount ==%d\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, " refcount ==%d\t\t%ld\n",
i, tclObjsShared[i]);
numSharedMultX += tclObjsShared[i];
}
- fprintf(stdout, " refcount >=%d\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, " refcount >=%d\t\t%ld\n",
i, tclObjsShared[0]);
numSharedMultX += tclObjsShared[0];
- fprintf(stdout, " Total shared objects\t\t\t%d\n",
+ Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%d\n",
numSharedMultX);
/*
@@ -8489,48 +8492,48 @@ EvalStatsCmd(
sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
- currentLiteralBytes;
- fprintf(stdout, "\nTotal objects (all interps)\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n",
tclObjsAlloced);
- fprintf(stdout, "Current objects\t\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n",
(tclObjsAlloced - tclObjsFreed));
- fprintf(stdout, "Total literal objects\t\t%ld\n",
+ Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n",
statsPtr->numLiteralsCreated);
- fprintf(stdout, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
globalTablePtr->numEntries,
Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
- fprintf(stdout, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
+ Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
numByteCodeLits,
Percent(numByteCodeLits, globalTablePtr->numEntries));
- fprintf(stdout, " Literals reused > 1x\t\t%d\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%d\n",
numSharedMultX);
- fprintf(stdout, " Mean reference count\t\t%.2f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean reference count\t\t%.2f\n",
((double) refCountSum) / globalTablePtr->numEntries);
- fprintf(stdout, " Mean len, str reused >1x \t%.2f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean len, str reused >1x \t%.2f\n",
(numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
- fprintf(stdout, " Mean len, str used 1x\t\t%.2f\n",
+ Tcl_AppendPrintfToObj(objPtr, " Mean len, str used 1x\t\t%.2f\n",
(numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
- fprintf(stdout, " Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
+ Tcl_AppendPrintfToObj(objPtr, " Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
sharingBytesSaved,
Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared));
- fprintf(stdout, " Bytes with sharing\t\t%.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Bytes with sharing\t\t%.6g\n",
currentLiteralBytes);
- fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
statsPtr->currentLitStringBytes);
- fprintf(stdout, " Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
(objBytesIfUnshared + strBytesIfUnshared),
objBytesIfUnshared, strBytesIfUnshared);
- fprintf(stdout, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
+ Tcl_AppendPrintfToObj(objPtr, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
(strBytesIfUnshared - statsPtr->currentLitStringBytes),
strBytesIfUnshared, statsPtr->currentLitStringBytes);
- fprintf(stdout, " Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n",
+ Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n",
literalMgmtBytes,
Percent(literalMgmtBytes, currentLiteralBytes));
- fprintf(stdout, " table %lu + buckets %lu + entries %lu\n",
+ Tcl_AppendPrintfToObj(objPtr, " table %lu + buckets %lu + entries %lu\n",
(unsigned long) sizeof(LiteralTable),
(unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
(unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)));
@@ -8539,33 +8542,33 @@ EvalStatsCmd(
* Breakdown of current ByteCode space requirements.
*/
- fprintf(stdout, "\nBreakdown of current ByteCode requirements:\n");
- fprintf(stdout, " Bytes Pct of Avg per\n");
- fprintf(stdout, " total ByteCode\n");
- fprintf(stdout, "Total %12.6g 100.00%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nBreakdown of current ByteCode requirements:\n");
+ Tcl_AppendPrintfToObj(objPtr, " Bytes Pct of Avg per\n");
+ Tcl_AppendPrintfToObj(objPtr, " total ByteCode\n");
+ Tcl_AppendPrintfToObj(objPtr, "Total %12.6g 100.00%% %8.1f\n",
statsPtr->currentByteCodeBytes,
statsPtr->currentByteCodeBytes / numCurrentByteCodes);
- fprintf(stdout, "Header %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Header %12.6g %8.1f%% %8.1f\n",
currentHeaderBytes,
Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes),
currentHeaderBytes / numCurrentByteCodes);
- fprintf(stdout, "Instructions %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Instructions %12.6g %8.1f%% %8.1f\n",
statsPtr->currentInstBytes,
Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentInstBytes / numCurrentByteCodes);
- fprintf(stdout, "Literal ptr array %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g %8.1f%% %8.1f\n",
statsPtr->currentLitBytes,
Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentLitBytes / numCurrentByteCodes);
- fprintf(stdout, "Exception table %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Exception table %12.6g %8.1f%% %8.1f\n",
statsPtr->currentExceptBytes,
Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentExceptBytes / numCurrentByteCodes);
- fprintf(stdout, "Auxiliary data %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Auxiliary data %12.6g %8.1f%% %8.1f\n",
statsPtr->currentAuxBytes,
Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentAuxBytes / numCurrentByteCodes);
- fprintf(stdout, "Command map %12.6g %8.1f%% %8.1f\n",
+ Tcl_AppendPrintfToObj(objPtr, "Command map %12.6g %8.1f%% %8.1f\n",
statsPtr->currentCmdMapBytes,
Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes),
statsPtr->currentCmdMapBytes / numCurrentByteCodes);
@@ -8574,8 +8577,8 @@ EvalStatsCmd(
* Detailed literal statistics.
*/
- fprintf(stdout, "\nLiteral string sizes:\n");
- fprintf(stdout, "\t Up to length\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n");
maxSizeDecade = 0;
for (i = 31; i >= 0; i--) {
if (statsPtr->literalCount[i] > 0) {
@@ -8587,12 +8590,12 @@ EvalStatsCmd(
for (i = 0; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->literalCount[i];
- fprintf(stdout, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
}
litTableStats = TclLiteralStats(globalTablePtr);
- fprintf(stdout, "\nCurrent literal table statistics:\n%s\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
litTableStats);
ckfree((char *) litTableStats);
@@ -8600,8 +8603,8 @@ EvalStatsCmd(
* Source and ByteCode size distributions.
*/
- fprintf(stdout, "\nSource sizes:\n");
- fprintf(stdout, "\t Up to size\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->srcCount[i] > 0) {
@@ -8619,12 +8622,12 @@ EvalStatsCmd(
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->srcCount[i];
- fprintf(stdout, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
- fprintf(stdout, "\nByteCode sizes:\n");
- fprintf(stdout, "\t Up to size\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->byteCodeCount[i] > 0) {
@@ -8642,12 +8645,12 @@ EvalStatsCmd(
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->byteCodeCount[i];
- fprintf(stdout, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
- fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
- fprintf(stdout, "\t Up to ms\t\tPercentage\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
+ Tcl_AppendPrintfToObj(objPtr, "\t Up to ms\t\tPercentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->lifetimeCount[i] > 0) {
@@ -8665,7 +8668,7 @@ EvalStatsCmd(
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->lifetimeCount[i];
- fprintf(stdout, "\t%12.3f\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
}
@@ -8673,28 +8676,46 @@ EvalStatsCmd(
* Instruction counts.
*/
- fprintf(stdout, "\nInstruction counts:\n");
+ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
for (i = 0; i <= LAST_INST_OPCODE; i++) {
- if (statsPtr->instructionCount[i] == 0) {
- fprintf(stdout, "%20s %8ld %6.1f%%\n",
- tclInstructionTable[i].name,
- statsPtr->instructionCount[i],
+ Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ",
+ tclInstructionTable[i].name, statsPtr->instructionCount[i]);
+ if (statsPtr->instructionCount[i]) {
+ Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
Percent(statsPtr->instructionCount[i], numInstructions));
- }
- }
-
- fprintf(stdout, "\nInstructions NEVER executed:\n");
- for (i = 0; i <= LAST_INST_OPCODE; i++) {
- if (statsPtr->instructionCount[i] == 0) {
- fprintf(stdout, "%20s\n", tclInstructionTable[i].name);
+ } else {
+ Tcl_AppendPrintfToObj(objPtr, "0\n");
}
}
#ifdef TCL_MEM_DEBUG
- fprintf(stdout, "\nHeap Statistics:\n");
- TclDumpMemoryInfo(stdout);
+ Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
+ TclDumpMemoryInfo((ClientData) objPtr, 1);
#endif
- fprintf(stdout, "\n----------------------------------------------------------------\n");
+ Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
+
+ if (objc == 1) {
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ Tcl_Channel outChan;
+ char *str = Tcl_GetStringFromObj(objv[1], &length);
+
+ if (length) {
+ if (strcmp(str, "stdout") == 0) {
+ outChan = Tcl_GetStdChannel(TCL_STDOUT);
+ } else if (strcmp(str, "stderr") == 0) {
+ outChan = Tcl_GetStdChannel(TCL_STDERR);
+ } else {
+ outChan = Tcl_OpenFileChannel(NULL, str, "w", 0664);
+ }
+ } else {
+ outChan = Tcl_GetStdChannel(TCL_STDOUT);
+ }
+ if (outChan != NULL) {
+ Tcl_WriteObj(outChan, objPtr);
+ }
+ }
+ Tcl_DecrRefCount(objPtr);
return TCL_OK;
}
#endif /* TCL_COMPILE_STATS */