[m-rev.] Re: for review: user-friendly representation of streams

Fergus Henderson fjh at cs.mu.OZ.AU
Wed Sep 25 19:56:05 AEST 2002


Here's the medium part extracted out.

----------

The medium change is that the predicates to report stats now return the
statistics as strings, instead of printing them out. Amongst other things,
this allows the stats to be printed to streams other than the current one.

library/io.m:
	Add predicates to report statistics to user-supplied streams.

Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.51
diff -u -b -r1.51 benchmarking.m
--- library/benchmarking.m	21 Aug 2002 11:27:32 -0000	1.51
+++ library/benchmarking.m	26 Aug 2002 08:03:34 -0000
@@ -17,18 +17,18 @@
 :- module benchmarking.
 :- interface.
 
-% `report_stats' is a non-logical procedure intended for use in profiling
+% `report_stats' is a non-logical function intended for use in profiling
 % the performance of a program.
-% It has the side-effect of reporting some memory and time usage statistics
-% about the time period since the last call to report_stats to stderr.
+% It returns a string reporting some memory and time usage statistics
+% about the time period since the last call.
 
-:- impure pred report_stats is det.
+:- impure pred report_stats(string::out) is det.
 
-% `report_full_memory_stats' is a non-logical procedure intended for use
-% in profiling the memory usage of a program.  It has the side-effect of
-% reporting a full memory profile to stderr.
+% `report_full_memory_stats' is a non-logical function intended for use
+% in profiling the memory usage of a program. It returns a string
+% reporting a full memory profile.
 
-:- impure pred report_full_memory_stats is det.
+:- impure pred report_full_memory_stats(string::out) is det.
 
 % benchmark_det(Pred, In, Out, Repeats, Time) is for benchmarking the
 % det predicate Pred. We call Pred with the input In and the output Out,
@@ -69,33 +69,43 @@
 #include ""mercury_timing.h""
 #include ""mercury_heap.h""
 
-extern void ML_report_stats(void);
+extern MR_String	ML_report_stats(void);
 
-extern void ML_report_full_memory_stats(void);
+extern MR_String	ML_report_full_memory_stats(void);
 
 "). % end pragma foreign_decl
 
-:- pragma foreign_proc("C", report_stats,
+:- pragma foreign_proc("C",
+	report_stats(Stats::out),
 	[will_not_call_mercury],
 "
-	ML_report_stats();
+	MR_String	Stats0;
+
+	Stats0 = ML_report_stats();
+	MR_make_aligned_string_copy(Stats, Stats0);
 ").
 
-:- pragma foreign_proc("C", report_full_memory_stats,
+:- pragma foreign_proc("C",
+	report_full_memory_stats(Stats::out),
 	[will_not_call_mercury],
 "
 #ifdef	MR_MPROF_PROFILE_MEMORY
-	ML_report_full_memory_stats();
+	MR_String	Stats0;
+
+	Stats0 = ML_report_full_memory_stats();
+	MR_make_aligned_string_copy(Stats, Stats0);
+#else
+	MR_make_aligned_string_copy(Stats, """");
 #endif
 ").
 
-report_stats :-
+report_stats(_) :-
 	% This version is only used for back-ends for which there is no
 	% matching foreign_proc version.
 	impure private_builtin__imp,
 	private_builtin__sorry("report_stats").
 
-report_full_memory_stats :-
+report_full_memory_stats(_) :-
 	% This version is only used for back-ends for which there is no
 	% matching foreign_proc version.
 	impure private_builtin__imp,
@@ -153,14 +163,17 @@
   static int  ML_memory_profile_fill_table(MR_memprof_record *node,
 				ML_memprof_report_entry *table, int next_slot);
 
-  static void ML_memory_profile_report(const ML_memprof_report_entry *,
+  static MR_String ML_memory_profile_report(const ML_memprof_report_entry *,
 				int num_entries, MR_bool complete);
 
   static int  ML_memory_profile_compare_final(const void *, const void *);
 
 #endif /* MR_MPROF_PROFILE_MEMORY */
 
-void
+#define	ML_BUF_SIZE	1024
+#define	ML_ARENA_INIT	1024
+
+MR_String
 ML_report_stats(void)
 {
 	int			time_at_prev_stat;
@@ -171,6 +184,17 @@
 	int			num_table_entries;
 	ML_memprof_report_entry	table[MEMORY_PROFILE_SIZE];
 #endif
+	char			buf1[ML_BUF_SIZE];
+	char			buf2[ML_BUF_SIZE];
+	char			buf3[ML_BUF_SIZE];
+	char			buf4[ML_BUF_SIZE];
+	char			buf5[ML_BUF_SIZE];
+	MR_String		profile_by_proc;
+	MR_String		profile_by_type;
+	char			*profile_buf;
+	int			profile_buf_size;
+	char			*buf;
+	int			buf_size;
   
 	/*
 	** Print timing and stack usage information
@@ -183,14 +207,15 @@
 	eng = MR_get_engine();
 #endif
 
-	fprintf(stderr, 
-		""[Time: +%.3fs, %.3fs,"",
+	snprintf(buf1, ML_BUF_SIZE,
+		""Time: +%.3fs, %.3fs,"",
 		(MR_time_at_last_stat - time_at_prev_stat) / 1000.0,
 		(MR_time_at_last_stat - MR_time_at_start) / 1000.0
 	);
 
 #ifndef MR_HIGHLEVEL_CODE
-	fprintf(stderr, "" D Stack: %.3fk, ND Stack: %.3fk,"",
+	snprintf(buf2, ML_BUF_SIZE,
+		"" D Stack: %.3fk, ND Stack: %.3fk,"",
 		((char *) MR_sp - (char *)
 			eng->MR_eng_context.MR_ctxt_detstack_zone->min)
 				/ 1024.0,
@@ -198,21 +223,27 @@
 			eng->MR_eng_context.MR_ctxt_nondetstack_zone->min)
 				/ 1024.0
 	);
+#else
+	sprintf(buf2, """");
 #endif
 
 #ifdef MR_CONSERVATIVE_GC
 	{ char local_var;
-	  fprintf(stderr, "" C Stack: %.3fk,"",
+	  snprintf(buf3, ML_BUF_SIZE, "" C Stack: %.3fk,"",
 		labs(&local_var - (char *) GC_stackbottom) / 1024.0);
 	}
+#else
+	snprintf(buf3, ML_BUF_SIZE, """");
 #endif
 
 #ifdef MR_USE_TRAIL
-	fprintf(stderr,
+	snprintf(buf4, ML_BUF_SIZE,
 		"" Trail: %.3fk,"",
 		((char *) MR_trail_ptr - (char *)
 			MR_trail_zone->min) / 1024.0
 	);
+#else
+	snprintf(buf4, ML_BUF_SIZE, """");
 #endif
 
 	/*
@@ -227,7 +258,7 @@
 		committed = mps_arena_committed(mercury_mps_arena);
 		spare = mps_arena_spare_committed(mercury_mps_arena);
 
-		fprintf(stderr, 
+		snprintf(buf5, ML_BUF_SIZE,
 			""\\nHeap in use: %.3fk, spare: %.3fk, total: %.3fk"",
 			(committed - spare) / 1024.0,
 			spare / 1024.0,
@@ -235,7 +266,7 @@
 	}
   #endif /* MR_MPS_GC */
   #ifdef MR_BOEHM_GC
-	fprintf(stderr, 
+	snprintf(buf5, ML_BUF_SIZE,
 		""\\n#GCs: %lu, ""
 		""Heap used since last GC: %.3fk, Total used: %.3fk"",
 		(unsigned long) GC_gc_no,
@@ -244,7 +275,7 @@
 	);
   #endif
 #else /* !MR_CONSERVATIVE_GC */
-	fprintf(stderr, 
+	snprintf(buf5, ML_BUF_SIZE,
 		""\\nHeap: %.3fk"",
 		((char *) MR_hp - (char *) eng->MR_eng_heap_zone->min) / 1024.0
 	);
@@ -259,46 +290,87 @@
 	ML_update_counter(&MR_memprof_overall, &ML_overall_counter);
 
 	/*
-	** Print out the per-procedure memory profile (top N entries)
+	** Format the per-procedure memory profile (top N entries)
 	*/
 	num_table_entries = ML_memory_profile_top_table(MR_memprof_procs.root,
 		table, MEMORY_PROFILE_SIZE, 0);
-	fprintf(stderr, ""\\nMemory profile by procedure\\n"");
-	ML_memory_profile_report(table, num_table_entries, MR_FALSE);
+	profile_by_proc = ML_memory_profile_report(table, num_table_entries,
+		MR_FALSE);
 
 	/*
-	** Print out the per-type memory profile (top N entries)
+	** Format the per-type memory profile (top N entries)
 	*/
 	num_table_entries = ML_memory_profile_top_table(MR_memprof_types.root,
 		table, MEMORY_PROFILE_SIZE, 0);
-	fprintf(stderr, ""\\nMemory profile by type\\n"");
-	ML_memory_profile_report(table, num_table_entries, MR_FALSE);
+	profile_by_type = ML_memory_profile_report(table, num_table_entries,
+		MR_FALSE);
 
-	/*
-	** Print out the overall memory usage.
-	*/
-	fprintf(stderr, 
+	profile_buf_size = strlen(profile_by_proc) + strlen(profile_by_type)
+		+ ML_BUF_SIZE;
+
+	profile_buf = MR_malloc(profile_buf_size);
+	if (profile_buf == NULL) {
+		MR_fatal_error(""ML_report_stats: out of memory"");
+	}
+
+	snprintf(profile_buf, profile_buf_size,
+		""\\nMemory profile by procedure\\n%s""
+		""\\nMemory profile by type\\n%s""
 		""Overall memory usage:""
 		""+%8.8g %8.8g cells, +%8.8g %8.8g words\\n"",
+		profile_by_proc, profile_by_type,
 		ML_overall_counter.cells_since_period_start,
 		ML_overall_counter.cells_at_period_end,
 		ML_overall_counter.words_since_period_start,
 		ML_overall_counter.words_at_period_end
 	);
 
+	MR_free(profile_by_proc);
+	MR_free(profile_by_type);
+
+#else
+
+	profile_buf = MR_malloc(profile_buf_size);
+	if (profile_buf == NULL) {
+		MR_fatal_error(""ML_report_stats: out of memory"");
+	}
+
+	strcpy(profile_buf, """");
+
 #endif /* MR_MPROF_PROFILE_MEMORY */
 
-	fprintf(stderr, ""]\\n"");
+	buf_size = strlen(buf1) + strlen(buf2) + strlen(buf3) + strlen(buf4)
+		+ strlen(buf5) + strlen(profile_buf) + ML_BUF_SIZE;
+
+	buf = MR_malloc(buf_size);
+	if (buf == NULL) {
+		MR_fatal_error(""ML_report_stats: out of memory"");
+	}
+
+	snprintf(buf, buf_size,
+		""[%s%s%s%s%s%s]\\n"",
+		buf1, buf2, buf3, buf4, buf5, profile_buf);
+
+	MR_free(profile_buf);
+	return buf;
 }
 
 #ifdef MR_MPROF_PROFILE_MEMORY
 
-void
+MR_String
 ML_report_full_memory_stats(void)
 {
 	int			num_table_entries;
 	int			table_size;
 	ML_memprof_report_entry	*table;
+	char			*reports = NULL;
+	int			report_max = 0;
+	int			len_so_far;
+	int			len_cur;
+	MR_String		profile_by_proc;
+	MR_String		profile_by_type;
+	char			*buf;
+	int			buf_size;
 
 	/*
 	** Update the overall counter (this needs to be done first,
@@ -324,10 +396,8 @@
 	qsort(table, MR_memprof_procs.num_entries,
 		sizeof(ML_memprof_report_entry),
 		ML_memory_profile_compare_final);
-	fprintf(stderr, ""\\nMemory profile by procedure\\n"");
-	fprintf(stderr, ""%14s %14s  %s\\n"",
-		""Cells"", ""Words"", ""Procedure label"");
-	ML_memory_profile_report(table, num_table_entries, MR_TRUE);
+	profile_by_proc = ML_memory_profile_report(table, num_table_entries,
+		MR_TRUE);
 
 	/*
 	** Print the by-type memory profile
@@ -337,24 +407,40 @@
 	qsort(table, MR_memprof_types.num_entries,
 		sizeof(ML_memprof_report_entry),
 		ML_memory_profile_compare_final);
-	fprintf(stderr, ""\\nMemory profile by type\\n"");
-	fprintf(stderr, ""%14s %14s  %s\\n"",
-		""Cells"", ""Words"", ""Procedure label"");
-	ML_memory_profile_report(table, num_table_entries, MR_TRUE);
+	profile_by_type = ML_memory_profile_report(table, num_table_entries,
+		MR_TRUE);
 
 	/*
 	** Deallocate space for the table
 	*/
 	MR_GC_free(table);
 
+	buf_size = strlen(profile_by_proc) + strlen(profile_by_type)
+		+ ML_BUF_SIZE;
+
 	/*
 	** Print the overall memory usage
 	*/
-	fprintf(stderr, 
+	buf = MR_malloc(buf_size);
+	if (buf == NULL) {
+		return """";
+	}
+
+	snprintf(buf, buf_size,
+		""\\nMemory profile by procedure\\n""
+		""%14s %14s  %s\\n%s""
+		""\\nMemory profile by type\\n""
+		""%14s %14s  %s\\n%s""
 		""\\nOverall memory usage: %8.8g cells, %8.8g words\\n"",
+		""Cells"", ""Words"", ""Procedure label"", profile_by_proc,
+		""Cells"", ""Words"", ""Procedure label"", profile_by_type,
 		ML_overall_counter.cells_at_period_end,
 		ML_overall_counter.words_at_period_end
 	);
+
+	MR_free(profile_by_proc);
+	MR_free(profile_by_type);
+	return buf;
 }
 
 /*
@@ -508,24 +594,27 @@
 ** ML_memory_profile_report(table, num_entries, complete):
 **	Print out a profiling report for the specified table.
 */
-static void
+static MR_String
 ML_memory_profile_report(const ML_memprof_report_entry *table, int num_entries,
 	MR_bool complete)
 {
 	int		i;
 	const char	*name;
+	char		*reports = NULL;
+	int		report_max = 0;
+	int		len_so_far;
+	int		len_cur;
+	char		buf[ML_BUF_SIZE];
 
 	if (complete) {
 		if (ML_overall_counter.cells_at_period_end < 1.0
 		||  ML_overall_counter.words_at_period_end < 1.0) {
-			fprintf(stderr, ""no allocations to report\\n"");
-			return;
+			return ""no allocations to report\\n"";
 		}
 	} else {
 		if (ML_overall_counter.cells_since_period_start < 1.0
 		||  ML_overall_counter.words_since_period_start < 1.0) {
-			fprintf(stderr, ""no allocations to report\\n"");
-			return;
+			return ""no allocations to report\\n"";
 		}
 	}
 
@@ -533,9 +622,10 @@
 		num_entries = MAX_REPORT_LINES;
 	}
 
+	len_so_far = 0;
 	for (i = 0; i < num_entries; i++) {
 		if (complete) {
-			fprintf(stderr,
+			snprintf(buf, ML_BUF_SIZE,
 				""%8.8g/%4.1f%% %8.8g/%4.1f%%  %s\\n"",
 				table[i].counter.cells_at_period_end,
 				100 * table[i].counter.cells_at_period_end /
@@ -546,7 +636,7 @@
 				table[i].name
 			);
 		} else {
-			fprintf(stderr,
+			snprintf(buf, ML_BUF_SIZE,
 				""%8.8g/%4.1f%% %8.8g/%4.1f%%  %s\\n"",
 				table[i].counter.cells_since_period_start,
 				100 *
@@ -559,7 +649,15 @@
 				table[i].name
 			);
 		}
+
+		len_cur = strlen(buf);
+		MR_ensure_big_enough(len_so_far + len_cur + 1, report,
+			char, ML_ARENA_INIT);
+		strcpy(reports + len_so_far, buf);
+		len_so_far += len_cur;
 	}
+
+	return reports;
 }
 
 /*
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.266
diff -u -b -r1.266 io.m
--- library/io.m	24 Sep 2002 06:55:17 -0000	1.266
+++ library/io.m	24 Sep 2002 10:14:10 -0000
@@ -1138,6 +1135,11 @@
 :- pred io__report_stats(io__state, io__state).
 :- mode io__report_stats(di, uo) is det.
 
+	% Write memory/time usage statistics to the specified stream.
+
+:- pred io__report_standard_stats(io__output_stream, io__state, io__state).
+:- mode io__report_standard_stats(in, di, uo) is det.
+
 	% Write complete memory usage statistics to stderr,
 	% including information about all procedures and types.
 	% (You need to compile with memory profiling enabled.)
@@ -1149,10 +1151,10 @@
 :- pred io__report_full_memory_stats(io__state, io__state).
 :- mode io__report_full_memory_stats(di, uo) is det.
 
-	% Write statistics to stderr; what statistics will be written
-	% is controlled by the first argument, which acts a selector.
-	% What selector values cause what statistics to be printed
-	% is implementation defined.
+	% Write statistics to the specified stream (the default being stderr).
+	% What statistics will be written is controlled by the first argument,
+	% which acts a selector. What selector values cause what statistics
+	% to be printed is implementation defined.
 	%
 	% The Melbourne implementation supports the following selectors:
 	%
@@ -1168,6 +1170,9 @@
 	%			to have been compiled with the macro
 	%			MR_TABLE_STATISTICS defined.
 
+:- pred io__report_stats(io__output_stream, string, io__state, io__state).
+:- mode io__report_stats(in, in, di, uo) is det.
+
 :- pred io__report_stats(string, io__state, io__state).
 :- mode io__report_stats(in, di, uo) is det.
 
@@ -3155,26 +3119,37 @@
 % statistics reporting predicates
 
 io__report_stats -->
-	io__report_stats("standard").
+	io__stderr_stream(StdErr),
+	io__report_standard_stats(StdErr).
+
+io__report_standard_stats(Stream) -->
+	io__report_stats(Stream, "standard").
 
 io__report_full_memory_stats -->
 	io__report_stats("full_memory_stats").
 
-:- pragma promise_pure(io__report_stats/3).
-
 io__report_stats(Selector) -->
-	{ Selector = "standard" ->
-		impure report_stats
-	; Selector = "full_memory_stats" ->
-		impure report_full_memory_stats
-	; Selector = "tabling" ->
-		impure table_builtin__table_report_statistics
+	io__stderr_stream(StdErr),
+	io__report_stats(StdErr, Selector).
+
+:- pragma promise_pure(io__report_stats/4).
+
+io__report_stats(Stream, Selector) -->
+	( { Selector = "standard" } ->
+		{ impure report_stats(Stats) },
+		io__write_string(Stream, Stats)
+	; { Selector = "full_memory_stats" } ->
+		{ impure report_full_memory_stats(Stats) },
+		io__write_string(Stream, Stats)
+	; { Selector = "tabling" } ->
+		{ impure table_builtin__table_report_statistics(Stats) },
+		io__write_string(Stream, Stats)
 	;
-		string__format(
+		{ string__format(
 			"io__report_stats: selector `%s' not understood",
-			[s(Selector)], Message),
-		error(Message)
-	}.
+			[s(Selector)], Message) },
+		{ error(Message) }
+	).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list