for review: memory profiling [1/2]

Fergus Henderson fjh at cs.mu.oz.au
Sun Nov 30 01:53:25 AEDT 1997


Hi,

Zoltan, can you please review this one?

--------------------------------------------------

Estimated hours taken: 30 (+ unknown time by Zoltan)

Add support for memory profiling.

(A significant part of this change is actually Zoltan's work.  Zoltan
did the changes to the compiler and a first go at the changes to the
runtime and library.  I rewrote much of Zoltan's changes to the runtime
and library, added support for the new options/grades, added code to
interface with mprof, and did the changes to the profiler.)

[TODO: add test cases.]

runtime/mercury_heap_profile.h:
runtime/mercury_heap_profile.c:
	New files.  These contain code to record heap profiling information.

runtime/mercury_heap.h:
	Add new macros incr_hp_msg(), tag_incr_hp_msg(),
	incr_hp_atomic_msg(), and tag_incr_hp_atomic_msg().
	These are like the non-`msg' versions, except that if
	PROFILE_MEMORY is defined, they also call MR_record_allocation()
	from mercury_heap_profile.h to record heap profiling information.
	Also, fix up the indentation in lots of places.

runtime/mercury_prof.h:
runtime/mercury_prof.c:
	Added code to dump out memory profiling information to files
	`Prof.MemoryWords' and `Prof.MemoryCells' (for use by mprof).
	Change the format of the `Prof.Counts' file so that the
	first line says what it is counting, the units, and a scale
	factor.  Prof.MemoryWords and Prof.MemoryCells can thus have
	exactly the same format as Prof.Counts.
	Also cleaned up the interface to mercury_prof.c a bit, and did
	various other minor cleanups -- indentation changes, changes to
	use MR_ prefixes, additional comments, etc.

runtime/mercury_prof_mem.h:
runtime/mercury_prof_mem.c:
	Rename prof_malloc() as MR_prof_malloc().
	Rename prof_make() as MR_PROF_NEW() and add MR_PROF_NEW_ARRAY().

runtime/mercury_wrapper.h:
	Minor modifications to reflect the new interface to mercury_prof.c.

runtime/mercury_wrapper.c:
runtime/mercury_label.c:
	Rename the old `-p' (primary cache size) option as `-C'.
	Add a new `-p' option to disable profiling.

runtime/Mmakefile:
	Add mercury_heap_profile.[ch].
	Put the list of files in alphabetical order.
	Delete some obsolete stuff for supporting `.mod' files.

compiler/llds.m:
	Add a new field to `create' and `incr_hp' instructions
	holding the name of the type, for heap profiling.

compiler/unify_gen.m:
	Initialize the new field of `create' instructions with
	the appropriate type name.

compiler/llds_out.m:
	Output incr_hp_msg() / tag_incr_hp_msg() instead of
	incr_hp() / tag_incr_hp().

compiler/*.m:
	Minor changes to most files in the compiler back-end to 
	accomodate the new field in `incr_hp' and `create' instructions.

library/io.m:
	Add `io__report_full_memory_stats'.

library/benchmarking.m:
	Add `report_full_memory_stats'.  This uses the information saved
	by runtime/mercury_heap_profile.{c,h} to print out a report
	of memory usage by procedures and by types.
	Also modify `report_stats' to print out some of that information.

compiler/mercury_compile.m:
	If `--statistics' is enabled, call io__report_full_memory_stats
	at the end of main/2.  This will print out full memory statistics,
	if the compiler was compiled with memory profiling enabled.

compiler/options.m:
compiler/handle_options.m:
runtime/mercury_grade.h:
scripts/ml.in:
scripts/mgnuc.in:
scripts/init_grade_options.sh-subr:
scripts/parse_grade_options.sh-subr:
	Add new option `--memory-profiling' and new grade `.memprof'.
	Add `--time-profiling' as a new synonym for `--profiling'.
	Also add `--profile-memory' for more fine-grained control:
	`--memory-profiling' implies both `--profile-memory' and
	`--profile-calls'.

scripts/mprof_merge_runs:
	Update to handle the new format of Prof.Counts and to
	also merge Prof.MemoryWords and Prof.MemoryCells.

profiler/options.m:
profiler/mercury_profile.m:
	Add new options `--profile memory-words' (`-m'),
	`--profile memory-cells' (`-M') and `--profile time' (`-t').
	Thes options make the profiler select a different count file,
	Prof.MemoryWords or Prof.MemoryCells instead of Prof.Counts.
	specific to time profiling.

profiler/read.m:
profiler/process_file.m:
profiler/prof_info.m:
profiler/generate_output.m:
	Update to handle the new format of the counts file.
	When reading the counts file, look at the first line of
	the file to determine what is being profiled.

profiler/globals.m:
	Add a new global variable `what_to_profile' that records
	what is being profiled.

profiler/output.m:
	Change the headings to reflect what is being profiled.

doc/user_guide.texi:
	Document memory profiling.
	Document new options.

doc/user_guide.texi:
compiler/options.m:
	Comment out the documentation for `.proftime'/`--profile-time',
	since doing time and call profiling seperately doesn't work,
	because the code addresses change when you recompile with a
	different grade.  Ditto for `.profmem'/`--profile-memory'.
	Also comment out the documentation for
	`.profcalls'/`--profile-calls', since it is redundant --
	`.memprof' produces the same information and more.

configure.in:
	Build a `.memprof' grade.  (Hmm, should we do this only
	if `--enable-all-grades' is specified?)
	Don't ever build a `.profcalls' grade.

cvs diff: Diffing .
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.119
diff -u -u -r1.119 configure.in
--- configure.in	1997/11/21 12:34:14	1.119
+++ configure.in	1997/11/29 13:49:48
@@ -1277,8 +1277,8 @@
 	LIBGRADES="$LIBGRADES $grade.gc"
 done
 
-# add `.prof' (--profiling) grades, or, if time profiling is not supported,
-# a `.profcalls' (--profile-calls) grade.
+# add `.prof' (--profiling) grades, if time profiling is supported,
+# and a `.memprof' (--memory-profiling) grade.
 if test $mercury_cv_profiling = yes; then
 	DEFAULT_GRADE_NOGC="`echo $DEFAULT_GRADE | sed 's/\.gc$//'`"
 	LIBGRADES="$LIBGRADES $DEFAULT_GRADE.prof $DEFAULT_GRADE_NOGC.prof"
@@ -1286,9 +1286,8 @@
 		GRADE_NOGC="`echo $GRADE | sed 's/\.gc$//'`"
 		LIBGRADES="$LIBGRADES $GRADE.prof $GRADE_NOGC.prof"
 	fi
-else
-	LIBGRADES="$LIBGRADES $DEFAULT_GRADE.profcalls"
 fi
+LIBGRADES="$LIBGRADES $DEFAULT_GRADE.memprof"
 
 # add `.tr' (--trailing) grades
 LIBGRADES="$LIBGRADES $DEFAULT_GRADE.tr"
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing bytecode
cvs diff: Diffing bytecode/test
cvs diff: Diffing compiler
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_type_layout.m,v
retrieving revision 1.23
diff -u -u -r1.23 base_type_layout.m
--- base_type_layout.m	1997/11/08 13:11:06	1.23
+++ base_type_layout.m	1997/11/24 07:55:02
@@ -528,9 +528,11 @@
 		MaxTags < 4
 	->
 		Rvals = [yes(const(int_const(Tag))), 
-			yes(create(0, Rvals0, Unique, CellNumber))]
+			yes(create(0, Rvals0, Unique, CellNumber,
+				"type_layout"))]
 	;
-		Rvals = [yes(create(Tag, Rvals0, Unique, CellNumber))]
+		Rvals = [yes(create(Tag, Rvals0, Unique, CellNumber,
+			"type_layout"))]
 	).
 
 	% Encode a cons tag (simple or complicated) in rvals.
@@ -983,7 +985,8 @@
 		LayoutInfo),
 	base_type_layout__functors_value(enum, EnumIndicator),
 	EnumRval = yes(const(int_const(EnumIndicator))),
-	CreateRval = yes(create(0, VectorRvals, no, NextCellNumber)),
+	CreateRval = yes(create(0, VectorRvals, no, NextCellNumber,
+		"type_layout")),
 	Rvals = [EnumRval, CreateRval].
 
 	% base_type_functors of a no_tag:
@@ -1004,7 +1007,8 @@
 
 	base_type_layout__get_next_cell_number(NextCellNumber, LayoutInfo1,
 		LayoutInfo),
-	CreateRval = yes(create(0, VectorRvals, no, NextCellNumber)),
+	CreateRval = yes(create(0, VectorRvals, no, NextCellNumber,
+		"type_layout")),
 
 	base_type_layout__functors_value(no_tag, NoTagIndicator),
 	NoTagRval = yes(const(int_const(NoTagIndicator))),
@@ -1035,7 +1039,7 @@
 			base_type_layout__get_next_cell_number(NextCellNumber,
 				LayoutInfoB, LayoutInfoC),
 			VectorRval = yes(create(0, VectorRvalList, no, 
-				NextCellNumber)),
+				NextCellNumber, "type_layout")),
 			Rvals1 = [VectorRval | Rvals0],
 			NewAcc = Rvals1 - LayoutInfoC)),
 		ConsList, [] - LayoutInfo0, VectorRvals - LayoutInfo),
@@ -1109,7 +1113,7 @@
 		list__append(RealArityArg, PseudoArgs1, PseudoArgs),
 
 		Pseudo = create(0, [Pseudo0 | PseudoArgs], no, 
-			CNum0)
+			CNum0, "type_layout")
 	;
 		type_util__var(Type, Var)
 	->
@@ -1131,7 +1135,7 @@
 
 base_type_layout__remove_create(Rval0, Rval) :-
 	(
-		Rval0 = create(_, [PTI], _, _)
+		Rval0 = create(_, [PTI], _, _, _)
 	->
 		Rval = PTI
 	;
Index: compiler/code_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_exprn.m,v
retrieving revision 1.52
diff -u -u -r1.52 code_exprn.m
--- code_exprn.m	1997/11/24 07:37:53	1.52
+++ code_exprn.m	1997/11/24 21:04:00
@@ -403,7 +403,7 @@
 		code_exprn__filter_out_reg_depending(Rvals0, Vars, Rvals),
 		set__empty(Rvals)
 	).
-code_exprn__rval_depends_on_reg(create(_Tag, Rvals, _Unique, _LabNum), Vars) :-
+code_exprn__rval_depends_on_reg(create(_, Rvals, _, _, _), Vars) :-
 	code_exprn__args_depend_on_reg(Rvals, Vars).
 code_exprn__rval_depends_on_reg(mkword(_Tag, Rval), Vars) :-
 	code_exprn__rval_depends_on_reg(Rval, Vars).
@@ -605,7 +605,7 @@
 code_exprn__add_rval_reg_dependencies(lval(Lval)) -->
 	code_exprn__add_lval_reg_dependencies(Lval).
 code_exprn__add_rval_reg_dependencies(var(_Var)) --> [].
-code_exprn__add_rval_reg_dependencies(create(_, Rvals, _, _)) -->
+code_exprn__add_rval_reg_dependencies(create(_, Rvals, _, _, _)) -->
 	code_exprn__add_arg_reg_dependencies(Rvals).
 code_exprn__add_rval_reg_dependencies(mkword(_Tag, Rval)) -->
 	code_exprn__add_rval_reg_dependencies(Rval).
@@ -678,7 +678,7 @@
 code_exprn__rem_rval_reg_dependencies(lval(Lval)) -->
 	code_exprn__rem_lval_reg_dependencies(Lval).
 code_exprn__rem_rval_reg_dependencies(var(_Var)) --> [].
-code_exprn__rem_rval_reg_dependencies(create(_, Rvals, _, _)) -->
+code_exprn__rem_rval_reg_dependencies(create(_, Rvals, _, _, _)) -->
 	code_exprn__rem_arg_reg_dependencies(Rvals).
 code_exprn__rem_rval_reg_dependencies(mkword(_Tag, Rval)) -->
 	code_exprn__rem_rval_reg_dependencies(Rval).
@@ -904,8 +904,8 @@
 		mkword(Tag, Expr)) :-
 	code_exprn__expr_is_constant(Expr0, Vars, ExprnOpts, Expr).
 
-code_exprn__expr_is_constant(create(Tag, Args0, Unique, Label), Vars, ExprnOpts,
-		create(Tag, Args, Unique, Label)) :-
+code_exprn__expr_is_constant(create(Tag, Args0, Unique, Label, Msg),
+		Vars, ExprnOpts, create(Tag, Args, Unique, Label, Msg)) :-
 	ExprnOpts = nlg_asm_sgt_ubf(_, _, StaticGroundTerms, _),
 	StaticGroundTerms = yes,
 	code_exprn__args_are_constant(Args0, Vars, ExprnOpts, Args).
@@ -1236,7 +1236,7 @@
 
 code_exprn__rval_is_real_create(Rval) -->
 	(
-		{ Rval = create(_, _, _, _) },
+		{ Rval = create(_, _, _, _, _) },
 		code_exprn__get_vars(Vars0),
 		code_exprn__get_options(ExprnOpts),
 		{ \+ code_exprn__expr_is_constant(Rval, Vars0, ExprnOpts, _) }
@@ -1262,7 +1262,7 @@
 code_exprn__construct_code(Lval, VarName, Rval0, Code) -->
 	{ exprn_aux__simplify_rval(Rval0, Rval) },
 	(
-		{ Rval = create(Tag, Rvals, _Unique, _Label) }
+		{ Rval = create(Tag, Rvals, _Unique, _Label, Msg) }
 	->
 		{ list__length(Rvals, Arity) },
 		(
@@ -1275,8 +1275,8 @@
 		;
 			( { Lval = field(_, _, _) } ->
 				code_exprn__acquire_reg(r, Reg),
-				code_exprn__construct_cell(Reg,
-					VarName, Tag, Arity, Rvals, Code0),
+				code_exprn__construct_cell(Reg, VarName,
+					Tag, Arity, Rvals, Msg, Code0),
 				{ string__append(VarName, " placement",
 					Comment) },
 				{ Code1 = node([
@@ -1285,8 +1285,8 @@
 				{ Code = tree(Code0, Code1) },
 				code_exprn__release_reg(Reg)
 			;
-				code_exprn__construct_cell(Lval,
-					VarName, Tag, Arity, Rvals, Code)
+				code_exprn__construct_cell(Lval, VarName,
+					Tag, Arity, Rvals, Msg, Code)
 			)
 		)
 	;
@@ -1295,13 +1295,14 @@
 	).
 
 :- pred code_exprn__construct_cell(lval, string, tag, int, list(maybe(rval)),
-	code_tree, exprn_info, exprn_info).
-:- mode code_exprn__construct_cell(in, in, in, in, in, out, in, out) is det.
+	string, code_tree, exprn_info, exprn_info).
+:- mode code_exprn__construct_cell(in, in, in, in, in, in, out, in, out) is det.
 
-code_exprn__construct_cell(Lval, VarName, Tag, Arity, Rvals, Code) -->
+code_exprn__construct_cell(Lval, VarName, Tag, Arity, Rvals, TypeMsg, Code) -->
 	{ string__append("Allocating heap for ", VarName, Comment) },
 	{ Code0 = node([
-		incr_hp(Lval, yes(Tag), const(int_const(Arity))) - Comment
+		incr_hp(Lval, yes(Tag), const(int_const(Arity)), TypeMsg)
+			- Comment
 	]) },
 	code_exprn__construct_args(Rvals, Tag, Lval, 0, Targets, Code1),
 	code_exprn__free_arg_dependenciess(Targets),
@@ -1367,7 +1368,7 @@
 			;
 				RvalX = unop(_, _)
 			;
-				RvalX = create(_, _, _, _)
+				RvalX = create(_, _, _, _, _)
 			;
 				RvalX = mkword(_, _)
 			}
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.24
diff -u -u -r1.24 dupelim.m
--- dupelim.m	1997/11/08 13:11:14	1.24
+++ dupelim.m	1997/11/24 07:55:02
@@ -167,8 +167,8 @@
 		if_val(Rval, Target)) :-
 	dupelim__replace_labels_rval(Rval0, Replmap, Rval),
 	dupelim__replace_labels_code_addr(Target0, Replmap, Target).
-dupelim__replace_labels_instr(incr_hp(Lval0, MaybeTag, Rval0), Replmap,
-		incr_hp(Lval, MaybeTag, Rval)) :-
+dupelim__replace_labels_instr(incr_hp(Lval0, MaybeTag, Rval0, Msg), Replmap,
+		incr_hp(Lval, MaybeTag, Rval, Msg)) :-
 	dupelim__replace_labels_lval(Lval0, Replmap, Lval),
 	dupelim__replace_labels_rval(Rval0, Replmap, Rval).
 dupelim__replace_labels_instr(mark_hp(Lval0), Replmap, mark_hp(Lval)) :-
@@ -228,8 +228,8 @@
 dupelim__replace_labels_rval(lval(Lval0), Replmap, lval(Lval)) :-
 	dupelim__replace_labels_lval(Lval0, Replmap, Lval).
 dupelim__replace_labels_rval(var(Var), _, var(Var)).
-dupelim__replace_labels_rval(create(Tag, Rvals, Unique, N), _,
-		create(Tag, Rvals, Unique, N)).
+dupelim__replace_labels_rval(create(Tag, Rvals, Unique, N, Msg), _,
+		create(Tag, Rvals, Unique, N, Msg)).
 dupelim__replace_labels_rval(mkword(Tag, Rval0), Replmap, mkword(Tag, Rval)) :-
 	dupelim__replace_labels_rval(Rval0, Replmap, Rval).
 dupelim__replace_labels_rval(const(Const0), Replmap, const(Const)) :-
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.23
diff -u -u -r1.23 exprn_aux.m
--- exprn_aux.m	1997/11/08 13:11:19	1.23
+++ exprn_aux.m	1997/11/24 07:55:02
@@ -187,7 +187,7 @@
 
 exprn_aux__rval_contains_lval(lval(Lval0), Lval) :-
 	exprn_aux__lval_contains_lval(Lval0, Lval).
-exprn_aux__rval_contains_lval(create(_, Rvals, _, _), Lval) :-
+exprn_aux__rval_contains_lval(create(_, Rvals, _, _, _), Lval) :-
 	exprn_aux__args_contain_lval(Rvals, Lval).
 exprn_aux__rval_contains_lval(mkword(_, Rval), Lval) :-
 	exprn_aux__rval_contains_lval(Rval, Lval).
@@ -247,7 +247,7 @@
 			Rval0 = lval(Lval),
 			exprn_aux__lval_contains_rval(Lval, Rval)
 		;
-			Rval0 = create(_, Rvals, _, _),
+			Rval0 = create(_, Rvals, _, _, _),
 			exprn_aux__args_contain_rval(Rvals, Rval)
 		;
 			Rval0 = mkword(_, Rval1),
@@ -289,7 +289,7 @@
 exprn_aux__vars_in_rval(lval(Lval), Vars) :-
 	exprn_aux__vars_in_lval(Lval, Vars).
 exprn_aux__vars_in_rval(var(Var), [Var]).
-exprn_aux__vars_in_rval(create(_, Rvals, _, _), Vars) :-
+exprn_aux__vars_in_rval(create(_, Rvals, _, _, _), Vars) :-
 	exprn_aux__vars_in_args(Rvals, Vars).
 exprn_aux__vars_in_rval(mkword(_, Rval), Vars) :-
 	exprn_aux__vars_in_rval(Rval, Vars).
@@ -363,10 +363,10 @@
 		Rval0 = var(_Var),
 		Rval = Rval0
 	;
-		Rval0 = create(Tag, Rvals0, Unique, Num),
+		Rval0 = create(Tag, Rvals0, Unique, Num, Msg),
 		exprn_aux__substitute_lval_in_args(OldLval, NewLval,
 			Rvals0, Rvals),
-		Rval = create(Tag, Rvals, Unique, Num)
+		Rval = create(Tag, Rvals, Unique, Num, Msg)
 	;
 		Rval0 = mkword(Tag, Rval1),
 		exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
@@ -524,10 +524,10 @@
 			Rval0 = var(_),
 			Rval = Rval0
 		;
-			Rval0 = create(Tag, Rvals0, Unique, Num),
+			Rval0 = create(Tag, Rvals0, Unique, Num, Msg),
 			exprn_aux__substitute_rval_in_args(OldRval, NewRval,
 				Rvals0, Rvals),
-			Rval = create(Tag, Rvals, Unique, Num)
+			Rval = create(Tag, Rvals, Unique, Num, Msg)
 		;
 			Rval0 = mkword(Tag, Rval1),
 			exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
@@ -714,7 +714,7 @@
 
 exprn_aux__simplify_rval_2(Rval0, Rval) :-
 	(
-		Rval0 = lval(field(Tag, create(Tag, Args, _, _), Field)),
+		Rval0 = lval(field(Tag, create(Tag, Args, _, _, _), Field)),
 		Field = const(int_const(FieldNum))
 	->
 		list__index0_det(Args, FieldNum, yes(Rval))
@@ -724,11 +724,11 @@
 	->
 		Rval = lval(field(Tag, Rval2, Num))
 	;
-		Rval0 = create(Tag, Args0, Unique, CNum),
+		Rval0 = create(Tag, Args0, Unique, CNum, Msg),
 		exprn_aux__simplify_args(Args0, Args),
 		Args \= Args0
 	->
-		Rval = create(Tag, Args, Unique, CNum)
+		Rval = create(Tag, Args, Unique, CNum, Msg)
 	;
 		Rval0 = unop(UOp, Rval1),
 		exprn_aux__simplify_rval_2(Rval1, Rval2)
@@ -771,7 +771,7 @@
 exprn_aux__rval_addrs(lval(Lval), CodeAddrs, DataAddrs) :-
 	exprn_aux__lval_addrs(Lval, CodeAddrs, DataAddrs).
 exprn_aux__rval_addrs(var(_), [], []).
-exprn_aux__rval_addrs(create(_, MaybeRvals, _, _), CodeAddrs, DataAddrs) :-
+exprn_aux__rval_addrs(create(_, MaybeRvals, _, _, _), CodeAddrs, DataAddrs) :-
 	exprn_aux__maybe_rval_list_addrs(MaybeRvals, CodeAddrs, DataAddrs).
 exprn_aux__rval_addrs(mkword(_Tag, Rval), CodeAddrs, DataAddrs) :-
 	exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.63
diff -u -u -r1.63 frameopt.m
--- frameopt.m	1997/08/25 17:48:12	1.63
+++ frameopt.m	1997/11/24 07:55:02
@@ -677,7 +677,7 @@
 	;
 		Targets = []
 	).
-possible_targets(incr_hp(_, _, _), []).
+possible_targets(incr_hp(_, _, _, _), []).
 possible_targets(mark_hp(_), []).
 possible_targets(restore_hp(_), []).
 possible_targets(store_ticket(_), []).
@@ -1288,8 +1288,8 @@
 	;
 		CodeAddr = CodeAddr0
 	).
-substitute_labels_instr(incr_hp(Lval, Tag, Rval), _,
-		incr_hp(Lval, Tag, Rval)).
+substitute_labels_instr(incr_hp(Lval, Tag, Rval, Msg), _,
+		incr_hp(Lval, Tag, Rval, Msg)).
 substitute_labels_instr(mark_hp(Lval), _, mark_hp(Lval)).
 substitute_labels_instr(restore_hp(Rval), _, restore_hp(Rval)).
 substitute_labels_instr(store_ticket(Lval), _, store_ticket(Lval)).
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.35
diff -u -u -r1.35 handle_options.m
--- handle_options.m	1997/11/08 13:11:22	1.35
+++ handle_options.m	1997/11/24 22:38:39
@@ -353,6 +353,7 @@
 	globals__get_gc_method(Globals, GC_Method),
 	globals__lookup_bool_option(Globals, profile_time, ProfileTime),
 	globals__lookup_bool_option(Globals, profile_calls, ProfileCalls),
+	globals__lookup_bool_option(Globals, profile_memory, ProfileMemory),
 	globals__lookup_bool_option(Globals, use_trail, UseTrail),
 /*
 % These vary from machine to machine, and (for backwards compatibility,
@@ -392,15 +393,33 @@
 	),
 	( ProfileTime = yes ->
 		( ProfileCalls = yes ->
-			Part4 = ".prof"
-		; 
-			Part4 = ".proftime"
+			( ProfileMemory = yes ->
+				Part4 = ".profall"
+			; 
+				Part4 = ".prof"
+			)
+		;
+			( ProfileMemory = yes ->
+				Part4 = ".profmemtime" /* not allowed */
+					/* `ml' which catch the error */
+			; 
+				Part4 = ".proftime" /* currently useless */
+			)
 		)
 	;
 		( ProfileCalls = yes ->
-			Part4 = ".profcalls"
+			( ProfileMemory = yes ->
+				Part4 = ".memprof"
+			; 
+				Part4 = ".profcalls"
+			)
 		; 
-			Part4 = ""
+			( ProfileMemory = yes ->
+				Part4 = ".profmem" /* not allowed */
+					/* `ml' which catch the error */
+			; 
+				Part4 = ""
+			)
 		)
 	),
 	( UseTrail = yes ->
@@ -496,19 +515,33 @@
 	( { string__remove_suffix(Grade12, ".prof", Grade13) } ->
 		{ Grade14 = Grade13 },
 		set_bool_opt(profile_time, yes),
-		set_bool_opt(profile_calls, yes)
+		set_bool_opt(profile_calls, yes),
+		set_bool_opt(profile_memory, no)
 	; { string__remove_suffix(Grade12, ".proftime", Grade13) } ->
 		{ Grade14 = Grade13 },
 		set_bool_opt(profile_time, yes),
-		set_bool_opt(profile_calls, no)
+		set_bool_opt(profile_calls, no),
+		set_bool_opt(profile_memory, no)
 	; { string__remove_suffix(Grade12, ".profcalls", Grade13) } ->
 		{ Grade14 = Grade13 },
 		set_bool_opt(profile_time, no),
-		set_bool_opt(profile_calls, yes)
+		set_bool_opt(profile_calls, yes),
+		set_bool_opt(profile_memory, no)
+	; { string__remove_suffix(Grade12, ".profall", Grade13) } ->
+		{ Grade14 = Grade13 },
+		set_bool_opt(profile_time, yes),
+		set_bool_opt(profile_calls, yes),
+		set_bool_opt(profile_memory, yes)
+	; { string__remove_suffix(Grade12, ".memprof", Grade13) } ->
+		{ Grade14 = Grade13 },
+		set_bool_opt(profile_time, no),
+		set_bool_opt(profile_calls, yes),
+		set_bool_opt(profile_memory, yes)
 	;
 		{ Grade14 = Grade12 },
 		set_bool_opt(profile_time, no),
-		set_bool_opt(profile_calls, no)
+		set_bool_opt(profile_calls, no),
+		set_bool_opt(profile_memory, no)
 	),
 	% part 3
 	( { string__remove_suffix(Grade14, ".gc", Grade15) } ->
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.27
diff -u -u -r1.27 livemap.m
--- livemap.m	1997/08/25 17:48:18	1.27
+++ livemap.m	1997/11/24 07:55:02
@@ -227,7 +227,8 @@
 			Livevals3 = Livevals1
 		;
 			Found = no,
-			livemap__make_live_in_rvals([Rval], Livevals1, Livevals2),
+			livemap__make_live_in_rvals([Rval],
+				Livevals1, Livevals2),
 			( CodeAddr = label(Label) ->
 				livemap__insert_label_livevals([Label],
 					Livemap0, Livevals2, Livevals3)
@@ -244,7 +245,7 @@
 		Livemap = Livemap0,
 		Ccode = Ccode0
 	;
-		Uinstr0 = incr_hp(Lval, _Tag, Rval),
+		Uinstr0 = incr_hp(Lval, _, Rval, _),
 
 		% Make dead the variable assigned, but make any variables
 		% needed to access it live. Make the variables in the size
@@ -255,7 +256,8 @@
 
 		set__delete(Livevals0, Lval, Livevals1),
 		opt_util__lval_access_rvals(Lval, Rvals),
-		livemap__make_live_in_rvals([Rval | Rvals], Livevals1, Livevals),
+		livemap__make_live_in_rvals([Rval | Rvals],
+			Livevals1, Livevals),
 		Livemap = Livemap0,
 		Instrs = Instrs0,
 		Ccode = Ccode0
@@ -391,7 +393,7 @@
 	),
 	opt_util__lval_access_rvals(Lval, AccessRvals),
 	livemap__make_live_in_rvals(AccessRvals, Live1, Live).
-livemap__make_live_in_rval(create(_, _, _, _), Live, Live).
+livemap__make_live_in_rval(create(_, _, _, _, _), Live, Live).
 	% All terms inside creates in the optimizer must be static.
 livemap__make_live_in_rval(mkword(_, Rval), Live0, Live) :-
 	livemap__make_live_in_rval(Rval, Live0, Live).
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.212
diff -u -u -r1.212 llds.m
--- llds.m	1997/11/08 13:11:26	1.212
+++ llds.m	1997/11/24 07:55:02
@@ -160,10 +160,12 @@
 	;	if_val(rval, code_addr)
 			% If rval is true, then goto code_addr.
 
-	;	incr_hp(lval, maybe(tag), rval)
+	;	incr_hp(lval, maybe(tag), rval, string)
 			% Get a memory block of a size given by an rval
 			% and put its address in the given lval,
 			% possibly after tagging it with a given tag.
+			% The string gives the name of the type constructor
+			% of the memory cell for use in memory profiling.
 
 	;	mark_hp(lval)
 			% Tell the heap sub-system to store a marker
@@ -383,7 +385,7 @@
 		% `var' rvals are used during code generation,
 		% but should not be present in the LLDS at any
 		% stage after code generation.
-	;	create(tag, list(maybe(rval)), bool, int)
+	;	create(tag, list(maybe(rval)), bool, int, string)
 		% create(Tag, Arguments, IsUnique, LabelNumber):
 		% A `create' instruction is used during code generation
 		% for creating a term, either on the heap or
@@ -402,6 +404,10 @@
 		% The label number is needed for the case when
 		% we can construct the term at compile-time
 		% and just reference the label.
+		%
+		% The last argument gives the name of the type constructor
+		% of the function symbol of which this is a cell, for use
+		% in memory profiling.
 	;	mkword(tag, rval)
 		% given a pointer and a tag,
 		% mkword returns a tagged pointer
@@ -617,7 +623,7 @@
 	llds__lval_type(Lval, Type).
 llds__rval_type(var(_), _) :-
 	error("var unexpected in llds__rval_type").
-llds__rval_type(create(_, _, _, _), data_ptr).
+llds__rval_type(create(_, _, _, _, _), data_ptr).
 	%
 	% Note that create and mkword must both be of type data_ptr,
 	% not of type word, to ensure that static consts containing
Index: compiler/llds_common.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_common.m,v
retrieving revision 1.11
diff -u -u -r1.11 llds_common.m
--- llds_common.m	1997/11/08 13:11:28	1.11
+++ llds_common.m	1997/11/24 07:55:02
@@ -208,9 +208,9 @@
 		Instr = if_val(Rval, Target)
 	;
 		% unlikely to find anything to share, but why not try?
-		Instr0 = incr_hp(Lval, MaybeTag, Rval0),
+		Instr0 = incr_hp(Lval, MaybeTag, Rval0, Msg),
 		llds_common__process_rval(Rval0, Info0, Info, Rval),
-		Instr = incr_hp(Lval, MaybeTag, Rval)
+		Instr = incr_hp(Lval, MaybeTag, Rval, Msg)
 	;
 		Instr0 = mark_hp(_),
 		Instr = Instr0,
@@ -267,7 +267,7 @@
 		Rval0 = var(_),
 		error("var rval found in llds_common__process_rval")
 	;
-		Rval0 = create(Tag, Args, Unique, _LabelNo),
+		Rval0 = create(Tag, Args, Unique, _LabelNo, _Msg),
 		( Unique = no ->
 			llds_common__process_create(Tag, Args, Info0,
 				Info, Rval)
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.63
diff -u -u -r1.63 llds_out.m
--- llds_out.m	1997/11/23 09:02:35	1.63
+++ llds_out.m	1997/11/24 19:31:41
@@ -795,7 +795,7 @@
 output_instruction_decls(if_val(Rval, Target), DeclSet0, DeclSet) -->
 	output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet1),
 	output_code_addr_decls(Target, "", "", 0, _, DeclSet1, DeclSet).
-output_instruction_decls(incr_hp(Lval, _Tag, Rval), DeclSet0, DeclSet) -->
+output_instruction_decls(incr_hp(Lval, _Tag, Rval, _), DeclSet0, DeclSet) -->
 	output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
 	output_rval_decls(Rval, "", "", 0, _, DeclSet1, DeclSet).
 output_instruction_decls(mark_hp(Lval), DeclSet0, DeclSet) -->
@@ -1008,21 +1008,26 @@
 	io__write_string(")\n\t\t"),
 	output_goto(Target, CallerLabel).
 
-output_instruction(incr_hp(Lval, MaybeTag, Rval), _) -->
+output_instruction(incr_hp(Lval, MaybeTag, Rval, TypeMsg), ProfInfo) -->
 	(
 		{ MaybeTag = no },
-		io__write_string("\tincr_hp("),
+		io__write_string("\tincr_hp_msg("),
 		output_lval_as_word(Lval)
 	;
 		{ MaybeTag = yes(Tag) },
-		io__write_string("\ttag_incr_hp("),
+		io__write_string("\ttag_incr_hp_msg("),
 		output_lval_as_word(Lval),
 		io__write_string(", "),
 		output_tag(Tag)
 	),
 	io__write_string(", "),
 	output_rval_as_type(Rval, word),
-	io__write_string(");\n").
+	io__write_string(", "),
+	{ ProfInfo = CallerLabel - _ },
+	output_label(CallerLabel),
+	io__write_string(", """),
+	io__write_string(TypeMsg),
+	io__write_string(""");\n").
 
 output_instruction(mark_hp(Lval), _) -->
 	io__write_string("\tmark_hp("),
@@ -1459,7 +1464,7 @@
 	    { N = N2 },
 	    { DeclSet = DeclSet2 }
 	).
-output_rval_decls(create(_Tag, ArgVals, _, Label), FirstIndent, LaterIndent,
+output_rval_decls(create(_Tag, ArgVals, _, Label, _), FirstIndent, LaterIndent,
 		N0, N, DeclSet0, DeclSet) -->
 	{ CreateLabel = create_label(Label) },
 	( { set__member(CreateLabel, DeclSet0) } ->
@@ -2592,7 +2597,7 @@
 	;
 		output_lval(Lval)
 	).
-output_rval(create(Tag, _Args, _Unique, CellNum)) -->
+output_rval(create(Tag, _Args, _Unique, CellNum, _Msg)) -->
 		% emit a reference to the static constant which we
 		% declared in output_rval_decls.
 	% XXX we should change the definition of mkword()
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.25
diff -u -u -r1.25 lookup_switch.m
--- lookup_switch.m	1997/09/23 08:17:14	1.25
+++ lookup_switch.m	1997/11/24 07:55:03
@@ -244,7 +244,7 @@
 	lookup_switch__rval_is_constant(Exprn1, ExprnOpts).
 lookup_switch__rval_is_constant(mkword(_, Exprn0), ExprnOpts) :-
 	lookup_switch__rval_is_constant(Exprn0, ExprnOpts).
-lookup_switch__rval_is_constant(create(_, Args, _, _), ExprnOpts) :-
+lookup_switch__rval_is_constant(create(_, Args, _, _, _), ExprnOpts) :-
 	ExprnOpts = nlg_asm_sgt_ubf(_, _, StaticGroundTerms, _),
 	StaticGroundTerms = yes,
 	lookup_switch__rvals_are_constant(Args, ExprnOpts).
@@ -343,7 +343,7 @@
 		% low bits specify which bit.
 		%
 	{
-		BitVec = create(_, [yes(SingleWord)], _, _)
+		BitVec = create(_, [yes(SingleWord)], _, _, _)
 	->
 		Word = SingleWord,
 		BitNum = UIndex
@@ -387,7 +387,7 @@
 	{ map__to_assoc_list(BitMap, WordVals) },
 	{ generate_bit_vec_args(WordVals, 0, Args) },
 	code_info__get_next_cell_number(CellNo),
-	{ BitVec = create(0, Args, no, CellNo) }.
+	{ BitVec = create(0, Args, no, CellNo, "lookup_switch_bit_vector") }.
 
 :- pred generate_bit_vec_2(case_consts, int, int,
 			map(int, int), map(int, int)).
@@ -453,7 +453,7 @@
 	{ list__sort(Vals0, Vals) },
 	{ construct_args(Vals, 0, Args) },
 	code_info__get_next_cell_number(CellNo),
-	{ ArrayTerm = create(0, Args, no, CellNo) },
+	{ ArrayTerm = create(0, Args, no, CellNo, "lookup_switch_data") },
 	{ LookupTerm = lval(field(0, ArrayTerm, Index)) },
 	code_info__cache_expression(Var, LookupTerm),
 	lookup_switch__generate_terms_2(Index, Vars, Map).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.60
diff -u -u -r1.60 mercury_compile.m
--- mercury_compile.m	1997/11/08 13:11:34	1.60
+++ mercury_compile.m	1997/11/24 07:55:03
@@ -87,6 +87,12 @@
 			;
 				[]
 			)
+		),
+		globals__io_lookup_bool_option(statistics, Statistics),
+		( { Statistics = yes } ->
+			io__report_full_memory_stats
+		;
+			[]
 		)
 	).
 
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.66
diff -u -u -r1.66 middle_rec.m
--- middle_rec.m	1997/08/25 17:48:28	1.66
+++ middle_rec.m	1997/11/24 07:55:03
@@ -396,7 +396,7 @@
 middle_rec__find_used_registers_instr(c_code(_), Used, Used).
 middle_rec__find_used_registers_instr(if_val(Rval, _), Used0, Used) :-
 	middle_rec__find_used_registers_rval(Rval, Used0, Used).
-middle_rec__find_used_registers_instr(incr_hp(Lval, _, Rval), Used0, Used) :-
+middle_rec__find_used_registers_instr(incr_hp(Lval, _, Rval, _), Used0, Used) :-
 	middle_rec__find_used_registers_lval(Lval, Used0, Used1),
 	middle_rec__find_used_registers_rval(Rval, Used1, Used).
 middle_rec__find_used_registers_instr(mark_hp(Lval), Used0, Used) :-
@@ -454,7 +454,7 @@
 		Rval = var(_),
 		error("var found in middle_rec__find_used_registers_rval")
 	;
-		Rval = create(_, MaybeRvals, _, _),
+		Rval = create(_, MaybeRvals, _, _, _),
 		middle_rec__find_used_registers_maybe_rvals(MaybeRvals,
 			Used0, Used)
 	;
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.74
diff -u -u -r1.74 opt_debug.m
--- opt_debug.m	1997/11/08 13:11:38	1.74
+++ opt_debug.m	1997/11/24 07:55:03
@@ -531,7 +531,7 @@
 opt_debug__dump_vnrval(vn_const(C), Str) :-
 	opt_debug__dump_const(C, C_str),
 	string__append_list(["vn_const(", C_str, ")"], Str).
-opt_debug__dump_vnrval(vn_create(T, MA, _U, L), Str) :-
+opt_debug__dump_vnrval(vn_create(T, MA, _U, L, _M), Str) :-
 	string__int_to_string(T, T_str),
 	opt_debug__dump_maybe_rvals(MA, 3, MA_str),
 	string__int_to_string(L, L_str),
@@ -618,7 +618,7 @@
 opt_debug__dump_rval(const(C), Str) :-
 	opt_debug__dump_const(C, C_str),
 	string__append_list(["const(", C_str, ")"], Str).
-opt_debug__dump_rval(create(T, MA, U, L), Str) :-
+opt_debug__dump_rval(create(T, MA, U, L, _), Str) :-
 	string__int_to_string(T, T_str),
 	opt_debug__dump_maybe_rvals(MA, 3, MA_str),
 	(
@@ -839,7 +839,7 @@
 	opt_debug__dump_rval(Rval, R_str),
 	opt_debug__dump_code_addr(CodeAddr, C_str),
 	string__append_list(["if_val(", R_str, ", ", C_str, ")"], Str).
-opt_debug__dump_instr(incr_hp(Lval, MaybeTag, Size), Str) :-
+opt_debug__dump_instr(incr_hp(Lval, MaybeTag, Size, _), Str) :-
 	opt_debug__dump_lval(Lval, L_str),
 	(
 		MaybeTag = no,
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.84
diff -u -u -r1.84 opt_util.m
--- opt_util.m	1997/08/25 17:48:34	1.84
+++ opt_util.m	1997/11/24 07:55:03
@@ -686,7 +686,7 @@
 	opt_util__lval_refers_stackvars(Lval, Refers).
 opt_util__rval_refers_stackvars(var(_), _) :-
 	error("found var in rval_refers_stackvars").
-opt_util__rval_refers_stackvars(create(_, Rvals, _, _), Refers) :-
+opt_util__rval_refers_stackvars(create(_, Rvals, _, _, _), Refers) :-
 	opt_util__rvals_refer_stackvars(Rvals, Refers).
 opt_util__rval_refers_stackvars(mkword(_, Rval), Refers) :-
 	opt_util__rval_refers_stackvars(Rval, Refers).
@@ -752,7 +752,7 @@
 			Between = [Instr0 | Between0]
 		)
 	;
-		Uinstr0 = incr_hp(Lval, _, Rval),
+		Uinstr0 = incr_hp(Lval, _, Rval, _),
 		opt_util__lval_refers_stackvars(Lval, no),
 		opt_util__rval_refers_stackvars(Rval, no),
 		opt_util__no_stackvars_til_decr_sp(Instrs0, FrameSize,
@@ -820,7 +820,7 @@
 			Need = no
 		)
 	;
-		Uinstr0 = incr_hp(Lval, _, Rval),
+		Uinstr0 = incr_hp(Lval, _, Rval, _),
 		opt_util__lval_refers_stackvars(Lval, Use1),
 		opt_util__rval_refers_stackvars(Rval, Use2),
 		bool__or(Use1, Use2, Use),
@@ -979,7 +979,7 @@
 opt_util__can_instr_branch_away(computed_goto(_, _), yes).
 opt_util__can_instr_branch_away(c_code(_), no).
 opt_util__can_instr_branch_away(if_val(_, _), yes).
-opt_util__can_instr_branch_away(incr_hp(_, _, _), no).
+opt_util__can_instr_branch_away(incr_hp(_, _, _, _), no).
 opt_util__can_instr_branch_away(mark_hp(_), no).
 opt_util__can_instr_branch_away(restore_hp(_), no).
 opt_util__can_instr_branch_away(store_ticket(_), no).
@@ -1004,7 +1004,7 @@
 opt_util__can_instr_fall_through(computed_goto(_, _), no).
 opt_util__can_instr_fall_through(c_code(_), yes).
 opt_util__can_instr_fall_through(if_val(_, _), yes).
-opt_util__can_instr_fall_through(incr_hp(_, _, _), yes).
+opt_util__can_instr_fall_through(incr_hp(_, _, _, _), yes).
 opt_util__can_instr_fall_through(mark_hp(_), yes).
 opt_util__can_instr_fall_through(restore_hp(_), yes).
 opt_util__can_instr_fall_through(store_ticket(_), yes).
@@ -1045,7 +1045,7 @@
 opt_util__can_use_livevals(computed_goto(_, _), no).
 opt_util__can_use_livevals(c_code(_), no).
 opt_util__can_use_livevals(if_val(_, _), yes).
-opt_util__can_use_livevals(incr_hp(_, _, _), no).
+opt_util__can_use_livevals(incr_hp(_, _, _, _), no).
 opt_util__can_use_livevals(mark_hp(_), no).
 opt_util__can_use_livevals(restore_hp(_), no).
 opt_util__can_use_livevals(store_ticket(_), no).
@@ -1103,7 +1103,7 @@
 opt_util__instr_labels_2(computed_goto(_, Labels), Labels, []).
 opt_util__instr_labels_2(c_code(_), [], []).
 opt_util__instr_labels_2(if_val(_, Addr), [], [Addr]).
-opt_util__instr_labels_2(incr_hp(_, _, _), [], []).
+opt_util__instr_labels_2(incr_hp(_, _, _, _), [], []).
 opt_util__instr_labels_2(mark_hp(_), [], []).
 opt_util__instr_labels_2(restore_hp(_), [], []).
 opt_util__instr_labels_2(store_ticket(_), [], []).
@@ -1133,7 +1133,7 @@
 opt_util__instr_rvals_and_lvals(computed_goto(Rval, _), [Rval], []).
 opt_util__instr_rvals_and_lvals(c_code(_), [], []).
 opt_util__instr_rvals_and_lvals(if_val(Rval, _), [Rval], []).
-opt_util__instr_rvals_and_lvals(incr_hp(Lval, _, Rval), [Rval], [Lval]).
+opt_util__instr_rvals_and_lvals(incr_hp(Lval, _, Rval, _), [Rval], [Lval]).
 opt_util__instr_rvals_and_lvals(mark_hp(Lval), [], [Lval]).
 opt_util__instr_rvals_and_lvals(restore_hp(Rval), [Rval], []).
 opt_util__instr_rvals_and_lvals(store_ticket(Lval), [], [Lval]).
@@ -1222,7 +1222,7 @@
 opt_util__count_temps_instr(if_val(Rval, _), R0, R, F0, F) :-
 	opt_util__count_temps_rval(Rval, R0, R, F0, F).
 opt_util__count_temps_instr(c_code(_), R, R, F, F).
-opt_util__count_temps_instr(incr_hp(Lval, _, Rval), R0, R, F0, F) :-
+opt_util__count_temps_instr(incr_hp(Lval, _, Rval, _), R0, R, F0, F) :-
 	opt_util__count_temps_lval(Lval, R0, R1, F0, F1),
 	opt_util__count_temps_rval(Rval, R1, R, F1, F).
 opt_util__count_temps_instr(mark_hp(Lval), R0, R, F0, F) :-
@@ -1339,7 +1339,7 @@
 		opt_util__touches_nondet_ctrl_lval(Lval, TouchLval),
 		opt_util__touches_nondet_ctrl_rval(Rval, TouchRval),
 		bool__or(TouchLval, TouchRval, Touch)
-	; Uinstr = incr_hp(Lval, _, Rval) ->
+	; Uinstr = incr_hp(Lval, _, Rval, _) ->
 		opt_util__touches_nondet_ctrl_lval(Lval, TouchLval),
 		opt_util__touches_nondet_ctrl_rval(Rval, TouchRval),
 		bool__or(TouchLval, TouchRval, Touch)
@@ -1381,7 +1381,7 @@
 opt_util__touches_nondet_ctrl_rval(lval(Lval), Touch) :-
 	opt_util__touches_nondet_ctrl_lval(Lval, Touch).
 opt_util__touches_nondet_ctrl_rval(var(_), no).
-opt_util__touches_nondet_ctrl_rval(create(_, _, _, _), no).
+opt_util__touches_nondet_ctrl_rval(create(_, _, _, _, _), no).
 opt_util__touches_nondet_ctrl_rval(mkword(_, Rval), Touch) :-
 	opt_util__touches_nondet_ctrl_rval(Rval, Touch).
 opt_util__touches_nondet_ctrl_rval(const(_), no).
@@ -1435,7 +1435,7 @@
 	opt_util__rvals_free_of_lval(Rvals, Forbidden).
 opt_util__rval_free_of_lval(var(_), _) :-
 	error("found var in opt_util__rval_free_of_lval").
-opt_util__rval_free_of_lval(create(_, _, _, _), _).
+opt_util__rval_free_of_lval(create(_, _, _, _, _), _).
 opt_util__rval_free_of_lval(mkword(_, Rval), Forbidden) :-
 	opt_util__rval_free_of_lval(Rval, Forbidden).
 opt_util__rval_free_of_lval(const(_), _).
@@ -1476,7 +1476,7 @@
 	opt_util__lvals_in_lval(Lval, Lvals).
 opt_util__lvals_in_rval(var(_), _) :-
 	error("found var in opt_util__lvals_in_rval").
-opt_util__lvals_in_rval(create(_, _, _, _), []).
+opt_util__lvals_in_rval(create(_, _, _, _, _), []).
 opt_util__lvals_in_rval(mkword(_, Rval), Lvals) :-
 	opt_util__lvals_in_rval(Rval, Lvals).
 opt_util__lvals_in_rval(const(_), []).
@@ -1508,7 +1508,7 @@
 
 opt_util__count_incr_hp_2([], N, N).
 opt_util__count_incr_hp_2([Uinstr0 - _ | Instrs], N0, N) :-
-	( Uinstr0 = incr_hp(_, _, _) ->
+	( Uinstr0 = incr_hp(_, _, _, _) ->
 		N1 is N0 + 1
 	;
 		N1 = N0
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.211
diff -u -u -r1.211 options.m
--- options.m	1997/11/13 06:27:17	1.211
+++ options.m	1997/11/29 13:56:36
@@ -110,8 +110,11 @@
 		;	asm_labels
 		;	gc
 		;	profiling
+		;	time_profiling
+		;	memory_profiling
 		;	profile_calls
 		;	profile_time
+		;	profile_memory
 		;	use_trail
 		;	pic_reg
 		;	debug
@@ -354,8 +357,11 @@
 	asm_labels		-	bool(yes),
 	gc			-	string("conservative"),
 	profiling		-	bool_special,
+	time_profiling		-	special,
+	memory_profiling	-	special,
 	profile_calls		-	bool(no),
 	profile_time		-	bool(no),
+	profile_memory		-	bool(no),
 	use_trail		-	bool(no),
 	pic_reg			-	bool(no),
 	debug			-	bool(no),
@@ -648,8 +654,11 @@
 long_option("gc",			gc).
 long_option("garbage-collection",	gc).
 long_option("profiling",		profiling).
+long_option("time-profiling",		time_profiling).
+long_option("memory-profiling",		memory_profiling).
 long_option("profile-calls",		profile_calls).
 long_option("profile-time",		profile_time).
+long_option("profile-memory",		profile_memory).
 long_option("use-trail",		use_trail).
 long_option("pic-reg",			pic_reg).
 long_option("debug",			debug).
@@ -831,12 +840,21 @@
 	( convert_grade_option(Grade, OptionTable0, OptionTable) ->
 		Result = ok(OptionTable)
 	;
-		string__append_list(["invalid Grade `", Grade, "'"], Msg),
+		string__append_list(["invalid grade `", Grade, "'"], Msg),
 		Result = error(Msg)
 	).
 special_handler(profiling, bool(Value), OptionTable0, ok(OptionTable)) :-
 	map__set(OptionTable0, profile_time, bool(Value), OptionTable1),
-	map__set(OptionTable1, profile_calls, bool(Value), OptionTable).
+	map__set(OptionTable1, profile_calls, bool(Value), OptionTable2),
+        map__set(OptionTable2, profile_memory, bool(no), OptionTable).
+special_handler(time_profiling, none, OptionTable0, ok(OptionTable)) :-
+	map__set(OptionTable0, profile_time, bool(yes), OptionTable1),
+	map__set(OptionTable1, profile_calls, bool(yes), OptionTable2),
+        map__set(OptionTable2, profile_memory, bool(no), OptionTable).
+special_handler(memory_profiling, none, OptionTable0, ok(OptionTable)) :-
+	map__set(OptionTable0, profile_time, bool(no), OptionTable1),
+	map__set(OptionTable1, profile_calls, bool(yes), OptionTable2),
+        map__set(OptionTable2, profile_memory, bool(yes), OptionTable).
 special_handler(inlining, bool(Value), OptionTable0, ok(OptionTable)) :-
 	map__set(OptionTable0, inline_simple, bool(Value), OptionTable1),
 	map__set(OptionTable1, inline_single_use, bool(Value), OptionTable2),
@@ -1312,22 +1330,40 @@
 	io__write_string("\t\tEnable use of a trail.\n"),
 	io__write_string("\t\tThis is necessary for interfacing with constraint solvers,\n"),
 	io__write_string("\t\tor for backtrackable destructive update.\n"),
-	io__write_string("\t--profiling\t\t"),
+	io__write_string("\t-p, --profiling, --time-profiling\t\t"),
 	io__write_string("\t(grade modifier: `.prof')\n"),
-	io__write_string("\t\tEnable profiling.  Insert profiling hooks in the\n"),
+	io__write_string("\t\tEnable time and call profiling.  Insert profiling hooks in the\n"),
 	io__write_string("\t\tgenerated code, and also output some profiling\n"),
 	io__write_string("\t\tinformation (the static call graph) to the file\n"),
 	io__write_string("\t\t`<module>.prof'.\n"),
+	io__write_string("\t--memory-profiling\t\t"),
+	io__write_string("\t(grade modifier: `.memprof')\n"),
+	io__write_string("\t\tEnable memory and call profiling.\n"),
+/*****************
+XXX The following options are not documented,
+because they are currently not useful.
+The idea was for you to be able to use --profile-calls
+and --profile-time seperately, but that doesn't work
+because compiling with --profile-time instead of
+--profile-calls results in different code addresses, 
+so you can't combine the data from versions of
+your program compiled with different options.
+
 	io__write_string("\t--profile-calls\t\t"),
 	io__write_string("\t(grade modifier: `.profcalls')\n"),
-	io__write_string("\t\tSimilar to --profiling, except that only gathers\n"),
+	io__write_string("\t\tSimilar to `--profiling', except that only gathers\n"),
 	io__write_string("\t\tcall counts, not timing information.\n"),
-	io__write_string("\t\tUseful on systems where time profiling is not supported\n"),
-	io__write_string("\t\t(e.g. MS Windows).\n"),
+	io__write_string("\t\tUseful on systems where time profiling is not supported,\n"),
+	io__write_string("\t\tbut not as useful as `--memory-profiling'.\n"),
 	io__write_string("\t--profile-time\t\t"),
 	io__write_string("\t(grade modifier: `.proftime')\n"),
-	io__write_string("\t\tSimilar to --profiling, except that only gathers\n"),
+	io__write_string("\t\tSimilar to `--profiling', except that it only gathers\n"),
 	io__write_string("\t\ttiming information, not call counts.\n"),
+	io__write_string("\t--profile-memory\t\t"),
+	io__write_string("\t(grade modifier: `.profmem')\n"),
+	io__write_string("\t\tSimilar to `--memory-profiling', except that it only gathers\n"),
+	io__write_string("\t\tmemory usage information, not call counts.\n"),
+********************/
 	io__write_string("\t--debug\t\t\t"),
 	io__write_string("\t(grade modifier: `.debug')\n"),
 	io__write_string("\t\tEnable debugging.\n"),
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.1
diff -u -u -r1.1 stack_layout.m
--- stack_layout.m	1997/11/08 13:11:46	1.1
+++ stack_layout.m	1997/11/24 07:55:03
@@ -11,7 +11,7 @@
 % The tables generated have a number of `create' rvals within them,
 % these are removed by llds_common.m to create static structures.
 %
-% Author: trd
+% Author: trd.
 %
 %---------------------------------------------------------------------------%
 %
@@ -219,7 +219,7 @@
 		RvalsList),
 	{ list__condense(RvalsList, Rvals) },
 	stack_layout__get_next_cell_number(CNum),
-	{ Rval = create(0, Rvals, no, CNum) }.
+	{ Rval = create(0, Rvals, no, CNum, "stack_layout_pair") }.
 
 	% Construct a pair of (lval, live_value_type) representations.
 
@@ -231,18 +231,14 @@
 	{ stack_layout__represent_lval(Lval, Rval0) },
 	stack_layout__represent_live_value_type(LiveValueType, Rval1),
 	{ Rvals = [yes(Rval0), yes(Rval1)] }.
-	
 
 %---------------------------------------------------------------------------%
 
-
 	% The constants here should be kept in sync with constants in
 	% the runtime system:
 	% 	mercury_accurate_gc.h - contains macros to access these
 	%			 	constants.
 
-
-
 	% Construct a representation of a live_value_type.
 	%
 	% Low integers for special values, a pointer for other values.
@@ -273,7 +269,8 @@
 		% XXX hack - don't yet write out insts
 	{ Rval1 = const(int_const(-1)) },
 	stack_layout__get_next_cell_number(CNum2),
-	{ Rval = create(0, [yes(Rval0), yes(Rval1)], no, CNum2) }.
+	{ Rval = create(0, [yes(Rval0), yes(Rval1)], no, CNum2,
+		"stack_layout_pair") }.
 
 	% Construct a representation of an lval.
 
@@ -301,7 +298,6 @@
 stack_layout__represent_lval(sp, Rval) :-
 	stack_layout__make_tagged_rval(8, 0, Rval).
 
-
 stack_layout__represent_lval(temp(_, _), _) :-
 	error("stack_layout: continuation live value stored in temp register").
 
@@ -321,7 +317,6 @@
 stack_layout__represent_lval(lvar(_), _) :-
 	error("stack_layout: continuation live value stored in lvar").
 
-
 	% Some things in this module are encoded using a low tag.
 	% This is not done using the normal compiler mkword, but by
 	% doing the bit shifting here.
@@ -341,7 +336,6 @@
 	stack_layout__tag_bits(Bits),
 	TaggedValue = (Value << Bits) + Tag.
 
-
 	% Construct a represntation of  the code model.
 
 :- pred stack_layout__represent_code_model(code_model, rval, stack_layout_info, 
@@ -363,7 +357,6 @@
 stack_layout__code_model(model_det, 0).
 stack_layout__code_model(model_semi, 0).
 stack_layout__code_model(model_non, 1).
-
 
 :- pred stack_layout__tag_bits(int::out) is det.
 stack_layout__tag_bits(8).
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.24
diff -u -u -r1.24 string_switch.m
--- string_switch.m	1997/10/13 08:09:52	1.24
+++ string_switch.m	1997/11/24 07:55:03
@@ -85,8 +85,10 @@
 
 		% Generate code which does the hash table lookup
 	{
-		NextSlotsTable = create(0, NextSlots, no, NextSlotsTableNo),
-		StringTable = create(0, Strings, no, StringTableNo),
+		NextSlotsTable = create(0, NextSlots, no, NextSlotsTableNo,
+			"string_switch_next_slots_table"),
+		StringTable = create(0, Strings, no, StringTableNo,
+			"string_switch_string_table"),
 		HashLookupCode = node([
 			comment("hashed string switch") -
 			  "",
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.83
diff -u -u -r1.83 unify_gen.m
--- unify_gen.m	1997/09/01 14:05:29	1.83
+++ unify_gen.m	1997/11/24 07:55:03
@@ -63,7 +63,7 @@
 :- implementation.
 
 :- import_module hlds_module, hlds_pred, prog_data, code_util.
-:- import_module mode_util, code_aux, hlds_out, tree.
+:- import_module mode_util, type_util, code_aux, hlds_out, tree.
 :- import_module bool, string, int, map, term, require, std_util.
 
 :- type uni_val		--->	ref(var)
@@ -264,9 +264,12 @@
 	{ unify_gen__generate_cons_args(Args, ArgTypes, Modes, ModuleInfo,
 		RVals) },
 	{ Code = empty },
+	code_info__variable_type(Var, VarType),
+	{ unify_gen__var_type_msg(VarType, VarTypeMsg) },
 	% XXX Later we will need to worry about
 	% whether the cell must be unique or not.
-	code_info__cache_expression(Var, create(SimpleTag, RVals, no, CellNo)).
+	{ Expr = create(SimpleTag, RVals, no, CellNo, VarTypeMsg) },
+	code_info__cache_expression(Var, Expr).
 unify_gen__generate_construction_2(complicated_tag(Bits0, Num0),
 		Var, Args, Modes, Code) -->
 	code_info__get_module_info(ModuleInfo),
@@ -277,9 +280,12 @@
 		% the first field holds the secondary tag
 	{ RVals = [yes(const(int_const(Num0))) | RVals0] },
 	{ Code = empty },
+	code_info__variable_type(Var, VarType),
+	{ unify_gen__var_type_msg(VarType, VarTypeMsg) },
 	% XXX Later we will need to worry about
 	% whether the cell must be unique or not.
-	code_info__cache_expression(Var, create(Bits0, RVals, no, CellNo)).
+	{ Expr = create(Bits0, RVals, no, CellNo, VarTypeMsg) },
+	code_info__cache_expression(Var, Expr).
 unify_gen__generate_construction_2(complicated_constant_tag(Bits1, Num1),
 		Var, _Args, _Modes, Code) -->
 	{ Code = empty },
@@ -373,7 +379,7 @@
 				- "get number of arguments",
 			incr_hp(NewClosure, no,
 				binop(+, lval(NumOldArgs),
-				NumNewArgsPlusTwo_Rval))
+				NumNewArgsPlusTwo_Rval), "closure")
 				- "allocate new closure",
 			assign(field(0, lval(NewClosure), Zero),
 				binop(+, lval(NumOldArgs), NumNewArgs_Rval))
@@ -412,7 +418,7 @@
 		{ unify_gen__generate_pred_args(Args, ArgInfo, PredArgs) },
 		{ Vector = [yes(const(int_const(NumArgs))),
 			yes(const(code_addr_const(CodeAddress))) | PredArgs] },
-		{ Value = create(0, Vector, no, CellNo) }
+		{ Value = create(0, Vector, no, CellNo, "closure") }
 	),
 	code_info__cache_expression(Var, Value).
 
@@ -725,6 +731,28 @@
 		code_info__cache_expression(Lvar, var(Rvar))
 	;
 		{ true }
+	).
+
+%---------------------------------------------------------------------------%
+
+:- pred unify_gen__var_type_msg(type, string).
+:- mode unify_gen__var_type_msg(in, out) is det.
+
+unify_gen__var_type_msg(Type, Msg) :-
+	( type_util__type_to_type_id(Type, TypeId, _) ->
+		TypeId = TypeSym - TypeArity,
+		(
+			TypeSym = qualified(ModuleName, TypeName),
+			string__append_list([ModuleName, ":", TypeName],
+				TypeSymStr)
+		;
+			TypeSym = unqualified(TypeName),
+			TypeSymStr = TypeName
+		),
+		string__int_to_string(TypeArity, TypeArityStr),
+		string__append_list([TypeSymStr, "/", TypeArityStr], Msg)
+	;
+		error("type is still a type variable in var_type_msg")
 	).
 
 %---------------------------------------------------------------------------%
Index: compiler/value_number.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/value_number.m,v
retrieving revision 1.86
diff -u -u -r1.86 value_number.m
--- value_number.m	1997/08/27 07:35:15	1.86
+++ value_number.m	1997/11/24 07:55:03
@@ -141,7 +141,7 @@
 			LabelInstr = label(FalseLabel) - "vn false label",
 			list__append(IfInstrs, [LabelInstr | Instrs1], Instrs)
 		)
-	; Uinstr0 = incr_hp(_, _, _) ->
+	; Uinstr0 = incr_hp(_, _, _, _) ->
 		( SeenAlloc = yes ->
 			N1 is N0 + 1,
 			NewLabel = local(ProcLabel, N0),
@@ -1082,7 +1082,7 @@
 value_number__boundary_instr(computed_goto(_, _), yes).
 value_number__boundary_instr(c_code(_), yes).
 value_number__boundary_instr(if_val(_, _), yes).
-value_number__boundary_instr(incr_hp(_, _, _), no).
+value_number__boundary_instr(incr_hp(_, _, _, _), no).
 value_number__boundary_instr(mark_hp(_), no).
 value_number__boundary_instr(restore_hp(_), no).
 value_number__boundary_instr(store_ticket(_), no).
Index: compiler/vn_block.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_block.m,v
retrieving revision 1.49
diff -u -u -r1.49 vn_block.m
--- vn_block.m	1997/08/27 07:35:20	1.49
+++ vn_block.m	1997/11/24 07:55:03
@@ -274,7 +274,7 @@
 	vn_block__new_ctrl_node(vn_if_val(Vn, Target), Livemap,
 		Params, VnTables1, VnTables,
 		Liveset0, Liveset, Tuple0, Tuple).
-vn_block__handle_instr(incr_hp(Lval, MaybeTag, Rval),
+vn_block__handle_instr(incr_hp(Lval, MaybeTag, Rval, _),
 		Livemap, Params, VnTables0, VnTables, Liveset0, Liveset,
 		_SeenIncr, SeenIncr, Tuple0, Tuple) :-
 	(
@@ -881,7 +881,7 @@
 vn_block__is_ctrl_instr(computed_goto(_, _), yes).
 vn_block__is_ctrl_instr(c_code(_), no).
 vn_block__is_ctrl_instr(if_val(_, _), yes).
-vn_block__is_ctrl_instr(incr_hp(_, _, _), no).
+vn_block__is_ctrl_instr(incr_hp(_, _, _, _), no).
 vn_block__is_ctrl_instr(mark_hp(_), yes).
 vn_block__is_ctrl_instr(restore_hp(_), yes).
 vn_block__is_ctrl_instr(store_ticket(_), yes).
Index: compiler/vn_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_cost.m,v
retrieving revision 1.28
diff -u -u -r1.28 vn_cost.m
--- vn_cost.m	1997/08/25 17:48:42	1.28
+++ vn_cost.m	1997/11/24 07:55:03
@@ -134,7 +134,7 @@
 		vn_cost__rval_cost(Rval, Params, RvalCost),
 		Cost = RvalCost
 	;
-		Uinstr = incr_hp(Lval, MaybeTag, Rval),
+		Uinstr = incr_hp(Lval, MaybeTag, Rval, _),
 		vn_type__costof_assign(Params, AssignCost),
 		vn_cost__lval_cost(Lval, Params, LvalCost),
 		vn_cost__rval_cost(Rval, Params, RvalCost),
@@ -292,7 +292,7 @@
 		Rval = var(_),
 		error("var found in rval_cost")
 	;
-		Rval = create(_, _, _, _),
+		Rval = create(_, _, _, _, _),
 		Cost = 0
 	;
 		Rval = mkword(_, Rval1),
Index: compiler/vn_filter.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_filter.m,v
retrieving revision 1.12
diff -u -u -r1.12 vn_filter.m
--- vn_filter.m	1997/08/27 07:35:21	1.12
+++ vn_filter.m	1997/11/24 07:55:03
@@ -144,7 +144,7 @@
 vn_filter__user_instr(if_val(Rval, _), yes(Rval)).
 vn_filter__user_instr(c_code(_), _):-
 	error("inappropriate instruction in vn__filter").
-vn_filter__user_instr(incr_hp(_, _, Rval), yes(Rval)).
+vn_filter__user_instr(incr_hp(_, _, Rval, _), yes(Rval)).
 vn_filter__user_instr(mark_hp(_), no).
 vn_filter__user_instr(restore_hp(Rval), yes(Rval)).
 vn_filter__user_instr(store_ticket(_), no).
@@ -192,8 +192,8 @@
 	vn_filter__replace_in_rval(Rval0, Temp, Defn, Rval).
 vn_filter__replace_in_user_instr(c_code(_), _, _, _):-
 	error("inappropriate instruction in vn__filter").
-vn_filter__replace_in_user_instr(incr_hp(Lval, Tag, Rval0), Temp, Defn,
-		incr_hp(Lval, Tag, Rval)) :-
+vn_filter__replace_in_user_instr(incr_hp(Lval, Tag, Rval0, Msg), Temp, Defn,
+		incr_hp(Lval, Tag, Rval, Msg)) :-
 	vn_filter__replace_in_rval(Rval0, Temp, Defn, Rval).
 vn_filter__replace_in_user_instr(mark_hp(_), _, _, _) :-
 	error("non-user instruction in vn_filter__replace_in_user_instr").
@@ -238,7 +238,7 @@
 vn_filter__defining_instr(if_val(_, _), no).
 vn_filter__defining_instr(c_code(_), _):-
 	error("inappropriate instruction in vn__filter").
-vn_filter__defining_instr(incr_hp(Lval, _, _), yes(Lval)).
+vn_filter__defining_instr(incr_hp(Lval, _, _, _), yes(Lval)).
 vn_filter__defining_instr(mark_hp(Lval), yes(Lval)).
 vn_filter__defining_instr(restore_hp(_), no).
 vn_filter__defining_instr(store_ticket(Lval), yes(Lval)).
@@ -284,8 +284,8 @@
 	error("non-def instruction in vn_filter__replace_in_defining_instr").
 vn_filter__replace_in_defining_instr(c_code(_), _, _, _):-
 	error("inappropriate instruction in vn__filter").
-vn_filter__replace_in_defining_instr(incr_hp(Lval0, Tag, Rval), Temp, Defn,
-		incr_hp(Lval, Tag, Rval)) :-
+vn_filter__replace_in_defining_instr(incr_hp(Lval0, Tag, Rval, Msg), Temp, Defn,
+		incr_hp(Lval, Tag, Rval, Msg)) :-
 	vn_filter__replace_in_lval(Lval0, Temp, Defn, Lval).
 vn_filter__replace_in_defining_instr(mark_hp(Lval0), Temp, Defn,
 		mark_hp(Lval)) :-
@@ -360,8 +360,8 @@
 	).
 vn_filter__replace_in_rval(var(_), _, _, _) :-
 	error("found var in vn_filter__replace_in_rval").
-vn_filter__replace_in_rval(create(Tag, Args, Unique, Label), _, _,
-		create(Tag, Args, Unique, Label)).
+vn_filter__replace_in_rval(create(Tag, Args, Unique, Label, Msg), _, _,
+		create(Tag, Args, Unique, Label, Msg)).
 vn_filter__replace_in_rval(mkword(Tag, Rval0), Temp, Defn, mkword(Tag, Rval)) :-
 	vn_filter__replace_in_rval(Rval0, Temp, Defn, Rval).
 vn_filter__replace_in_rval(const(Const), _, _, const(Const)).
Index: compiler/vn_flush.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_flush.m,v
retrieving revision 1.43
diff -u -u -r1.43 vn_flush.m
--- vn_flush.m	1997/08/25 17:48:47	1.43
+++ vn_flush.m	1997/11/24 07:55:04
@@ -527,7 +527,7 @@
 vn_flush__get_incr_hp([], _, _) :-
 	error("could not find incr_hp").
 vn_flush__get_incr_hp([Instr0 | Instrs0], IncrHp, Instrs) :-
-	( Instr0 = incr_hp(_, _, _) - _ ->
+	( Instr0 = incr_hp(_, _, _, _) - _ ->
 		IncrHp = Instr0,
 		Instrs = Instrs0
 	;
@@ -689,8 +689,8 @@
 		Templocs = Templocs0,
 		Instrs = []
 	;
-		Vnrval = vn_create(Tag, MaybeRvals, Unique, Label),
-		Rval = create(Tag, MaybeRvals, Unique, Label),
+		Vnrval = vn_create(Tag, MaybeRvals, Unique, Label, Msg),
+		Rval = create(Tag, MaybeRvals, Unique, Label, Msg),
 		VnTables = VnTables0,
 		Templocs = Templocs0,
 		Instrs = []
@@ -847,7 +847,8 @@
 	),
 
 	vn_table__set_current_value(Vnlval, AssignedVn, VnTables4, VnTables),
-	Instr = incr_hp(Lval, MaybeTag, Rval) - "",
+	Instr = incr_hp(Lval, MaybeTag, Rval, "origin_lost_in_value_number")
+		- "",
 	list__condense([IncrInstrs, SaveInstrs, [Instr]], Instrs).
 
 %-----------------------------------------------------------------------------%
@@ -892,7 +893,7 @@
 			Templocs = Templocs0,
 			Instrs = []
 		;
-			Vnrval = vn_create(_, _, _, _),
+			Vnrval = vn_create(_, _, _, _, _),
 			error("create in calculation of new hp")
 		;
 			Vnrval = vn_unop(_, _),
Index: compiler/vn_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_order.m,v
retrieving revision 1.42
diff -u -u -r1.42 vn_order.m
--- vn_order.m	1997/08/25 17:48:50	1.42
+++ vn_order.m	1997/11/24 07:55:04
@@ -635,7 +635,7 @@
 			Predmap = Predmap0,
 			VnTables = VnTables0
 		;
-			Vnrval = vn_create(_Tag2, _Args, _Unique, _Label),
+			Vnrval = vn_create(_, _, _, _, _),
 			Succmap = Succmap0,
 			Predmap = Predmap0,
 			VnTables = VnTables0
Index: compiler/vn_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_type.m,v
retrieving revision 1.34
diff -u -u -r1.34 vn_type.m
--- vn_type.m	1997/08/25 17:48:52	1.34
+++ vn_type.m	1997/11/24 07:55:04
@@ -40,7 +40,8 @@
 :- type vnrval		--->	vn_origlval(vnlval)
 			;	vn_mkword(tag, vn)
 			;	vn_const(rval_const)
-			;	vn_create(tag, list(maybe(rval)), bool, int)
+			;	vn_create(tag, list(maybe(rval)),
+					bool, int, string)
 			;	vn_unop(unary_op, vn)
 			;	vn_binop(binary_op, vn, vn)
 			;	vn_stackvar_addr(int)
@@ -175,7 +176,7 @@
 
 vn_type__vnrval_type(vn_origlval(Lval), Type) :-
 	vn_type__vnlval_type(Lval, Type).
-vn_type__vnrval_type(vn_create(_, _, _, _), data_ptr).
+vn_type__vnrval_type(vn_create(_, _, _, _, _), data_ptr).
 vn_type__vnrval_type(vn_mkword(_, _), data_ptr). % see comment in llds.m
 vn_type__vnrval_type(vn_const(Const), Type) :-
 	llds__const_type(Const, Type).
Index: compiler/vn_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_util.m,v
retrieving revision 1.57
diff -u -u -r1.57 vn_util.m
--- vn_util.m	1997/08/25 17:48:54	1.57
+++ vn_util.m	1997/11/24 07:55:04
@@ -147,9 +147,9 @@
 		Rval = var(_),
 		error("value_number should never get rval: var")
 	;
-		Rval = create(Tag, Args, Unique, Label),
-		vn_util__vnrval_to_vn(vn_create(Tag, Args, Unique, Label), Vn,
-			VnTables0, VnTables)
+		Rval = create(Tag, Args, Unique, Label, Msg),
+		vn_util__vnrval_to_vn(vn_create(Tag, Args, Unique, Label, Msg),
+			Vn, VnTables0, VnTables)
 	;
 		Rval = mkword(Tag, Rval1),
 		vn_util__rval_to_vn(Rval1, SubVn, VnTables0, VnTables1),
@@ -1015,7 +1015,7 @@
 	vn_util__vnlval_access_vns(Vnlval, SubVns).
 vn_util__find_sub_vns(vn_mkword(_, SubVn), [SubVn]).
 vn_util__find_sub_vns(vn_const(_), []).
-vn_util__find_sub_vns(vn_create(_, _, _, _), []).
+vn_util__find_sub_vns(vn_create(_, _, _, _, _), []).
 vn_util__find_sub_vns(vn_unop(_, SubVn), [SubVn]).
 vn_util__find_sub_vns(vn_binop(_, SubVn1, SubVn2), [SubVn1, SubVn2]).
 vn_util__find_sub_vns(vn_stackvar_addr(_), []).
@@ -1034,7 +1034,7 @@
 		Vnrval = vn_const(_),
 		IsConst = yes
 	;
-		Vnrval = vn_create(_, _, _, _),
+		Vnrval = vn_create(_, _, _, _, _),
 		IsConst = yes
 	;
 		Vnrval = vn_unop(_, Vn1),
@@ -1065,7 +1065,7 @@
 		Rval = var(_),
 		error("var found in vn_util__find_lvals_in_rval")
 	;
-		Rval = create(_, _, _, _),
+		Rval = create(_, _, _, _, _),
 		Lvals = []
 	;
 		Rval = mkword(_, Rval1),
@@ -1331,7 +1331,7 @@
 			Vnrval = vn_const(_),
 			VnTables = VnTables1
 		;
-			Vnrval = vn_create(_, _, _, _),
+			Vnrval = vn_create(_, _, _, _, _),
 			VnTables = VnTables1
 		;
 			Vnrval = vn_unop(_, SubVn),
Index: compiler/vn_verify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_verify.m,v
retrieving revision 1.13
diff -u -u -r1.13 vn_verify.m
--- vn_verify.m	1997/08/25 17:48:57	1.13
+++ vn_verify.m	1997/11/24 07:55:04
@@ -227,7 +227,7 @@
 	vn_verify__lval(Vnlval, VnTables, Lval).
 vn_verify__subst_sub_vns(vn_mkword(Tag, _), [R], _, mkword(Tag, R)).
 vn_verify__subst_sub_vns(vn_const(Const), [], _, const(Const)).
-vn_verify__subst_sub_vns(vn_create(T, A, U, L), [], _, create(T, A, U, L)).
+vn_verify__subst_sub_vns(vn_create(T,A,U,L,M), [], _, create(T,A,U,L,M)).
 vn_verify__subst_sub_vns(vn_unop(Op, _), [R], _, unop(Op, R)).
 vn_verify__subst_sub_vns(vn_binop(Op, _, _), [R1, R2], _, binop(Op, R1, R2)).
 
@@ -325,7 +325,7 @@
 		vn_verify__tags_cond(Rval, NoDeref0, NoDeref,
 			Tested0, Tested)
 	;
-		Instr = incr_hp(Lval, _, Rval),
+		Instr = incr_hp(Lval, _, Rval, _),
 		vn_verify__tags_lval(Lval, NoDeref0),
 		vn_verify__tags_rval(Rval, NoDeref0),
 		NoDeref = NoDeref0,
@@ -411,7 +411,7 @@
 	vn_verify__tags_lval(Lval, NoDeref).
 vn_verify__tags_rval(var(_), _) :-
 	error("found var in vn_verify__tags_rval").
-vn_verify__tags_rval(create(_, _, _, _), _).
+vn_verify__tags_rval(create(_, _, _, _, _), _).
 vn_verify__tags_rval(mkword(_, Rval), NoDeref) :-
 	vn_verify__tags_rval(Rval, NoDeref).
 vn_verify__tags_rval(const(_), _).
cvs diff: Diffing compiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.107
diff -u -u -r1.107 user_guide.texi
--- user_guide.texi	1997/11/21 08:08:28	1.107
+++ user_guide.texi	1997/11/29 14:05:52
@@ -1052,6 +1052,7 @@
 * Creating the profile::            How to create profile data.
 * Displaying the profile::          How to display the profile data.
 * Analysis of results::             How to interpret the output.
+* Memory profiling::                Profiling memory usage rather than time.
 @end menu
 
 @node Profiling introduction
@@ -1124,11 +1125,11 @@
 
 The next step is to run your program.  The profiling version of your
 program will collect profiling information during execution, and
-save this information in the files @samp{Prof.Counts}, @samp{Prof.Decls},
-and @samp{Prof.CallPair}.
-(@samp{Prof.Decl} contains the names of the procedures and their
-associated addresses, @samp{Prof.CallPair} records the number of times
-each procedure was called by each different caller, and @samp{Prof.Counts}
+save this information in the files @file{Prof.Counts}, @file{Prof.Decls},
+and @file{Prof.CallPair}.
+(@file{Prof.Decl} contains the names of the procedures and their
+associated addresses, @file{Prof.CallPair} records the number of times
+each procedure was called by each different caller, and @file{Prof.Counts}
 records the number of times that execution was in each procedure
 when a profiling interrupt occurred.)
 
@@ -1321,7 +1322,39 @@
 time represent the proportion of the current procedure's self and descendent 
 time due to that parent.  These times are obtained using the assumption that
 each call contributes equally to the total time of the current procedure.
- at c XXX is that really true? Do we really make that assumption?
+
+ at node Memory profiling
+ at section Memory profiling
+
+It is also possible to profile memory allocation.  To enable memory
+profiling, your program must be built with memory profiling enabled,
+using the @samp{--memory-profiling} option.  Then, as with time
+profiling, you run your program to create the profiling data.
+This will be stored in the files @file{Prof.MemoryWords}
+ at file{Prof.MemoryCells}, @file{Prof.Decls}, and @file{Prof.CallPair}.
+
+To create the profile, you need to invoke @samp{mprof} with the
+ at samp{-m} (@samp{--profile memory-words}) option.  This will profile
+the amount of memory allocated, measured in units of words. 
+(A word is 4 bytes on a 32-bit architecture, or 8 bytes on a 64-bit
+architecture.)
+
+Alternatively, you can use @samp{mprof}'s @samp{-M}
+(@samp{--profile memory-cells}) option.  This will profile memory in
+units of ``cells''.  A cell is a group of words allocated together in a
+single allocation, to hold a single object.  Selecting this option this
+will therefore profile the number of memory allocations, while ignoring
+the size of each memory allocation.
+
+With memory profiling, just as with time profiling,
+you can use the @samp{-c} (@samp{--call-graph}) option to display
+call graph profiles in addition to flat profiles.
+
+Note that Mercury's memory profiler will only tell you about
+allocation, not about deallocation (garbage collection).
+It can tell you how much memory was allocated by each procedure,
+but it won't tell you how long the memory was live for,
+or how much of that memory was garbage-collected.
 
 @node Invocation
 @chapter Invocation
@@ -1792,12 +1825,24 @@
 @item @samp{.prof}
 @code{--profiling}.
 
- at item @samp{.proftime}
- at code{--profile-time}.
-
- at item @samp{.profcalls}
- at code{--profile-calls}.
+ at item @samp{.memprof}
+ at code{--memory-profiling}.
 
+ at c The following are undocumented because
+ at c they are basically useless... documenting
+ at c them would just confuse people.
+ at c
+ at c @item @samp{.profall}
+ at c @code{--profile-calls --profile-time --profile-memory}.
+ at c (not recommended because --profile-memory interferes with
+ at c --profile-time)
+ at c 
+ at c @item @samp{.proftime}
+ at c @code{--profile-time}.
+ at c 
+ at c @item @samp{.profcalls}
+ at c @code{--profile-calls}.
+ at c 
 @item @samp{.tr}
 @code{--use-trail}.
 
@@ -1845,17 +1890,27 @@
 is determined by the auto-configuration script.
 
 @sp 1
- at item @code{--profiling} (grades: any grade containing @samp{.prof})
-Enable profiling.  Insert profiling hooks in the
+ at item @code{--profiling}, @code{--time-profiling} (grades: any grade containing @samp{.prof})
+Enable time profiling.  Insert profiling hooks in the
 generated code, and also output some profiling
 information (the static call graph) to the file
 @samp{@var{module}.prof}.  @xref{Profiling}.
 
 @sp 1
+ at item @code{--memory-profiling} (grades: any grade containing @samp{.memprof})
+Enable memory profiling.  Insert memory profiling hooks in the
+generated code, and also output some profiling
+information (the static call graph) to the file
+ at samp{@var{module}.prof}.  @xref{Memory profiling}.
+
+ at ignore
+	The following are basically useless, hence undocumented.
+
+ at sp 1
 @item @code{--profile-calls} (grades: any grade containing @samp{.profcalls})
 Similar to @samp{--profiling}, except that this option only gathers
 call counts, not timing information.  Useful on systems where time
-profiling is not supported (e.g. MS Windows).
+profiling is not supported -- but not as useful as @samp{--memory-profiling}.
 
 @sp 1
 @item @code{--profile-time} (grades: any grade containing @samp{.proftime})
@@ -1863,12 +1918,15 @@
 timing information, not call counts.  For the results to be useful,
 call counts for an identical run of your program need to be gathered
 using @samp{--profiling} or @samp{--profile-calls}. 
+XXX this doesn't work, because the code addresses change.
 The only advantage of using @samp{--profile-time} and @samp{--profile-calls}
 to gather timing information and call counts in seperate runs,
 rather than just using @samp{--profiling} to gather them both at once,
 is that the former method can give slightly more accurate timing results.
 because with the latter method the code inserted to record call counts
 has a small effect on the execution speed.
+
+ at end ignore
 
 @sp 1
 @item @code{--debug} (grades: any grade containing @samp{.debug})
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/Togl-1.2
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing library
Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.3
diff -u -u -r1.3 benchmarking.m
--- benchmarking.m	1997/11/21 06:49:21	1.3
+++ benchmarking.m	1997/11/24 13:39:02
@@ -20,10 +20,18 @@
 
 % Declaratively, `report_stats' is the same as `true'.
 % 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 stdout.
+% (Technically, every Mercury implementation must offer a mode of invocation
+% which disables this side-effect.)
+
+:- pred report_stats is det.
+
+% Declaratively, `report_full_memory_stats' is the same as `true'.
+% It has the side-effect of reporting a full memory profile
 % to stdout. (Technically, every Mercury implementation must offer
 % a mode of invocation which disables this side-effect.)
 
-:- pred report_stats is det.
+:- pred report_full_memory_stats 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,
@@ -51,13 +59,95 @@
 
 :- pragma c_header_code("
 
-#include <stdio.h>
 #include ""mercury_timing.h""
 
+extern void ML_report_stats(void);
+
+extern void ML_report_full_memory_stats(void);
+
+"). % end pragma c_header_code
+
+:- pragma c_code(report_stats, will_not_call_mercury,
+"
+	ML_report_stats();
+").
+
+:- pragma c_code(report_full_memory_stats, will_not_call_mercury,
+"
+#ifdef	MEMORY_PROFILING
+	ML_report_full_memory_stats();
+#endif
 ").
 
-:- pragma c_code(report_stats, will_not_call_mercury, "
-	int	time_at_prev_stat;
+%-----------------------------------------------------------------------------%
+
+:- pragma c_code("
+
+#include <stdio.h>
+#include ""mercury_prof_mem.h""
+#include ""mercury_heap_profile.h""
+
+#ifdef MEMORY_PROFILING
+
+  #define MEMORY_PROFILE_SIZE	10	/* Display this many top entries */
+
+  #define MAX_REPORT_LINES	10	/* ?? */
+
+  /* local types */
+
+  typedef struct ML_memprof_float_counter
+  {
+	double		cells_at_period_end;
+	double		words_at_period_end;
+	double		cells_since_period_start;
+	double		words_since_period_start;
+  } ML_memprof_float_counter;
+
+  typedef struct	ML_memprof_report_entry
+  {
+	const char			*name;
+	ML_memprof_float_counter	counter;
+  } ML_memprof_report_entry;
+
+  /* static variables */
+
+  static ML_memprof_float_counter	ML_overall_counter;
+
+  /* local function declarations */
+
+  static void ML_update_counter(MR_memprof_counter *counter,
+				ML_memprof_float_counter *float_counter);
+
+  static int  ML_insert_into_table(const ML_memprof_report_entry *new_entry,
+				ML_memprof_report_entry *table,
+				int table_size, int next_slot)
+
+  static int  ML_memory_profile_top_table(MR_memprof_record *node,
+				ML_memprof_report_entry *table,
+				int size, int next_slot);
+
+  static int  ML_memory_profile_fill_table(MR_memprof_table *node,
+				ML_memprof_report_entry *table, int next_slot);
+
+  static void ML_memory_profile_report(const ML_memprof_report_entry *,
+				int num_entries, bool complete);
+
+  static int  ML_memory_profile_compare_final(const void *, const void *);
+
+#endif
+
+void
+ML_report_stats(void)
+{
+	int			time_at_prev_stat;
+#ifdef MEMORY_PROFILING
+	int			num_table_entries;
+	ML_memprof_report_entry	table[MEMORY_PROFILE_SIZE];
+#endif
+  
+	/*
+	** Print timing and stack usage information
+	*/
 
 	time_at_prev_stat = time_at_last_stat;
 	time_at_last_stat = MR_get_user_cpu_miliseconds();
@@ -70,22 +160,317 @@
 		((char *) maxfr - (char *) nondetstack_zone->min) / 1024.0
 	);
 
+	/*
+	** Print heap usage information.
+	*/
+
 #ifdef CONSERVATIVE_GC
 	fprintf(stderr, 
 		""#GCs: %lu,\\n""
-		""Heap used since last GC: %.3fk, Total used: %.3fk]\\n"",
+		""Heap used since last GC: %.3fk, Total used: %.3fk"",
 		(unsigned long) GC_gc_no,
 		GC_get_bytes_since_gc() / 1024.0,
 		GC_get_heap_size() / 1024.0
 	);
 #else
 	fprintf(stderr, 
-		""Heap: %.3fk]\\n"",
+		""Heap: %.3fk"",
 		((char *) hp - (char *) heap_zone->min) / 1024.0
 	);
 #endif
+
+#ifdef	MEMORY_PROFILING
+
+	/*
+	** Update the overall counter (this needs to be done first,
+	** so that the percentages come out right).
+	*/
+	ML_update_counter(&MR_memprof_overall, &ML_overall_counter);
+
+	/*
+	** Print out 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, FALSE);
+
+	/*
+	** Print out 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, FALSE);
+
+	/*
+	** Print out the overall memory usage.
+	*/
+	fprintf(stderr, 
+		""Overall memory usage:""
+		""+%8.8g %8.8g cells, +%8.8g %8.8g words\\n"",
+		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
+	);
+
+#endif
+
+	fprintf(stderr, ""]\\n"");
+}
+
+#ifdef MEMORY_PROFILING
+
+void
+ML_report_full_memory_stats(void)
+{
+	int			num_table_entries;
+	int			table_size;
+	ML_memprof_report_entry	*table;
+
+	/*
+	** Update the overall counter (this needs to be done first,
+	** so that the percentages come out right).
+	*/
+	ML_update_counter(&MR_memprof_overall, &ML_overall_counter);
+
+	/*
+	** Allocate space for the table
+	*/
+	if (MR_memprof_proc.num_entries > MR_memprof_type.num_entries) {
+		table_size = MR_memprof_proc.num_entries;
+	} else {
+		table_size = MR_memprof_type.num_entries;
+	}
+	table = (ML_memprof_report_entry *) prof_malloc(table_size
+		* sizeof(ML_memprof_report_entry));
+
+	/*
+	** Print the by-procedure memory profile
+	*/
+	num_table_entries = ML_memory_profile_fill_table(MR_memprof_procs.root,
+		table, 0);
+	qsort(table, MR_memprof_proc.num_entries,
+		sizeof(ML_memprof_report_entry),
+		ML_memory_profile_compare_final);
+	fprintf(stderr, ""\\nMemory profile by procedure\\n"");
+	fprintf(stderr, ""%-50s       %-14s %s\\n"",
+		""procedure label"", ""Cells"", ""Words"");
+	ML_memory_profile_report(table, num_table_entries, TRUE);
+
+	/*
+	** Print the by-type memory profile
+	*/
+	num_table_entries = ML_memory_profile_fill_table(MR_memprof_types.root,
+		table, 0);
+	qsort(table, MR_memprof_type.num_entries,
+		sizeof(ML_memprof_report_entry),
+		ML_memory_profile_compare_final);
+	fprintf(stderr, ""\\nMemory profile by type\\n"");
+	fprintf(stderr, ""%-50s       %-14s %s\\n"",
+		""procedure label"", ""Cells"", ""Words"");
+	ML_memory_profile_report(table, num_table_entries, TRUE);
+
+	/*
+	** Deallocate space for the table
+	*/
+	/* unfortunately prof_malloc doesn't let us free the table! */
+
+	/*
+	** Print the overall memory usage
+	*/
+	fprintf(stderr, 
+		""\\nOverall memory usage: %8.8g cells, %8.8g words\\n"",
+		ML_overall_counter.cells_at_period_end,
+		ML_overall_counter.words_at_period_end
+	);
+
+static void
+ML_update_counter(MR_memprof_counter *counter,
+	ML_memprof_float_counter *float_counter)
+{
+	MR_add_two_dwords(counter.cells_at_period_start, 
+		counter.cells_since_period_start);
+	MR_add_two_dwords(counter.words_at_period_start, 
+		counter.words_since_period_start);
+
+	MR_convert_dword_to_double(counter.cells_since_period_start,
+		flout_counter.cells_since_period_start);
+	MR_convert_dword_to_double(counter.words_since_period_start,
+		float_counter.words_since_period_start);
+
+	/* since the 'at start' numbers have already been incremented, */
+	/* they now refer to the start of the *next* period */
+	MR_convert_dword_to_double(counter.cells_at_period_start,
+		float_counter.cells_at_period_end);
+	MR_convert_dword_to_double(counter.words_at_period_start,
+		float_counter.words_at_period_end);
+
+	MR_zero_dword(counter.cells_since_period_start);
+	MR_zero_dword(counter.words_since_period_start);
+}
+
+/*
+** Insert an entry into the table of the top `table_size' entries.
+** Entries are ranked according to their cells_at_period_end.
+** (XXX Why? Why not according to words_at_period_end?).
+** Entries that are not in the top `table_size' are discarded.
+*/
+static int
+ML_insert_into_table(const ML_memprof_report_entry *new_entry,
+	ML_memprof_report_entry *table, int table_size, int next_slot)
+{
+	if (new_entry->counter.cells_since_period_start <= 0.0) {
+		/* ignore such entries */
+	} else if (next_slot < table_size) {
+		/*
+		** XXX shouldn't we insert it in sorted order here,
+		** rather than just shoving it at the end of the table??
+		*/
+		table[next_slot] = *new_entry;
+		next_slot++;
+	} else {
+		bool	handled = FALSE;
+		int	i, j;
+
+		for (i = table_size-1; i >= 0; i--) {
+			if (table[i].counter.cells_at_period_end >
+				new_entry->counter.cells_at_period_end)
+			{
+				if (i < table_size-1) {
+					/*
+					** New entry is smaller than
+					** all the entries in the table,
+					** so nothing needs to be done
+					*/
+				} else {
+					/* shift all later entries down  */
+					for (j = table_size-1; j > i; j--)
+						table[j] = table[j-1];
+
+					table[i+1] = *new_entry;
+				}
+
+				handled = TRUE;
+			}
+		}
+		if (!handled) {
+			/* new entry must be bigger than all previous ones */
+			for (j = table_size-1; j > 0; j--)
+				table[j] = table[j-1];
+
+			table[0] = *new_entry;
+		}
+	}
+	return next_slot;
+}
+
+static int
+ML_memory_profile_top_table(MR_memprof_record *node,
+	ML_memprof_report_entry *table, int table_size, int next_slot)
+{
+	ML_memprof_report_entry new_entry;
+
+	if (node != NULL) {
+		next_slot = ML_memory_profile_top_table(node->left,
+					table, table_size, next_slot);
+
+		new_entry.name = node->name;
+		ML_update_counter(&node->counter, &new_entry.counter);
+		next_slot = ML_insert_into_table(&new_entry,
+					table, table_size, next_slot)
+
+		next_slot = ML_memory_profile_top_table(node->right,
+					table, table_size, next_slot);
+	}
+	return next_slot;
+}
+
+static int
+ML_memory_profile_fill_table(MR_memprof_record *node,
+	ML_memprof_report_entry *table, int next_slot)
+{
+	if (node != NULL) {
+		next_slot = ML_memory_profile_fill_table(node->left,
+					table, next_slot);
+
+		table[next_slot].name = node->name;
+		ML_update_counter(&node->counter, &table[next_slot].counter);
+		next_slot++;
+
+		next_slot = ML_memory_profile_fill_table(node->right,
+					table, next_slot);
+	}
+	return next_slot;
+}
+
+static void
+ML_memory_profile_report(const ML_memprof_table *table, int num_entries,
+	bool complete)
+{
+	int		i;
+	const char	*name;
+
+	if (num_entries > MAX_REPORT_LINES && !complete) {
+		num_entries = MAX_REPORT_LINES;
+	}
+
+	for (i = 0; i < num_entries; i++) {
+		if (complete) {
+			fprintf(stderr, ""%-50s ""
+				""%8.8g/%4.1f%% ""
+				""%8.8g/%4.1f%%\\n"",
+				table[i].name,
+				table[i].cells_at_period_end,
+				100 * table[i].cells_at_period_end /
+					ML_overall_counter.cells_at_period_end,
+				table[i].words_at_period_end,
+				100 * table[i].words_at_period_end /
+					ML_overall_counter.words_at_period_end
+			);
+		} else {
+			fprintf(stderr, ""%-50s ""
+				""%8.8g/%4.1f%% ""
+				""%8.8g/%4.1f%%\\n"",
+				table[i].name,
+				table[i].cells_since_period_start,
+				100 * table[i].cells_since_period_start /
+				   ML_overall_counter.cells_since_period_start,
+				table[i].words_since_period_start,
+				100 * table[i].words_since_period_start /
+				   ML_overall_counter.words_since_period_start
+			);
+		}
+	}
+}
+
+/*
+** Comparison routine used for qsort().
+** Compares two ML_memprof_report_entry structures.
+*/
+static int 
+ML_memory_profile_compare_final(const void *i1, const void *i2)
+{
+	const ML_memprof_report_entry *e1 = 
+		(const ML_memprof_report_entry *) i1;
+	const ML_memprof_report_entry *e2 =
+		(const ML_memprof_report_entry *) i2;
+
+	if (e1->words_at_period_end < e2->words_at_period_end) {
+		return 1;
+	} else if (e1->words_at_period_end > e2->words_at_period_end) {
+		return -1;
+	} else {
+		return strcmp(e1->name, e2->name);
+	}
+}
+
+#endif /* MEMORY_PROFILING */
 ").
 
+%-----------------------------------------------------------------------------%
+
 :- external(benchmark_det/5).
 :- external(benchmark_nondet/5).
 
@@ -116,21 +501,24 @@
 */
 
 #ifdef	COMPACT_ARGS
-#define	rep_count	r5
-#define	count_output	r1
-#define	soln_output	r1
-#define	time_output	r2
+  #define	rep_count	r5
+  #define	count_output	r1
+  #define	soln_output	r1
+  #define	time_output	r2
 #else
-#define	rep_count	r6
-#define	count_output	r5
-#define	soln_output	r5
-#define	time_output	r7
+  #define	rep_count	r6
+  #define	count_output	r5
+  #define	soln_output	r5
+  #define	time_output	r7
 #endif
 
 Define_extern_entry(mercury__benchmarking__benchmark_nondet_5_0);
 Declare_label(mercury__benchmarking__benchmark_nondet_5_0_i1);
 Declare_label(mercury__benchmarking__benchmark_nondet_5_0_i2);
 
+Declare_entry(do_call_nondet_closure);
+Declare_entry(do_call_det_closure);
+
 BEGIN_MODULE(benchmark_nondet_module)
 	init_entry(mercury__benchmarking__benchmark_nondet_5_0);
 	init_label(mercury__benchmarking__benchmark_nondet_5_0_i1);
@@ -159,10 +547,11 @@
 	framevar(0) = r3;
 	framevar(1) = r4;
 
-	if (rep_count <= 0)
+	if (rep_count <= 0) {
 		framevar(2) = 1;
-	else
+	} else {
 		framevar(2) = rep_count;
+	}
 
 	framevar(3) = 0;
 	mark_hp(framevar(5));
@@ -173,12 +562,9 @@
 	r2 = (Word) 1;	/* the higher-order call has 1 extra input argument  */
 	r3 = (Word) 1;	/* the higher-order call has 1 extra output argument */
 	/* r4 already has the extra input argument */
-	{ 
-		Declare_entry(do_call_nondet_closure);
-		call(ENTRY(do_call_nondet_closure),
-			LABEL(mercury__benchmarking__benchmark_nondet_5_0_i1),
-			LABEL(mercury__benchmarking__benchmark_nondet_5_0));
-	}
+	call(ENTRY(do_call_nondet_closure),
+		LABEL(mercury__benchmarking__benchmark_nondet_5_0_i1),
+		LABEL(mercury__benchmarking__benchmark_nondet_5_0));
 
 Define_label(mercury__benchmarking__benchmark_nondet_5_0_i1);
 	/* we found a solution */
@@ -188,11 +574,12 @@
 Define_label(mercury__benchmarking__benchmark_nondet_5_0_i2);
 	/* no more solutions for this iteration, so mark it completed */
 	framevar(2) = framevar(2) - 1;
+
 	/* we can now reclaim memory by resetting the heap pointer */
 	restore_hp(framevar(5));
+
 	/* are there any other iterations? */
-	if (framevar(2) > 0)
-	{
+	if (framevar(2) > 0) {
 		/* yes, so reset the solution counter */
 		/* and then set up the call just like last time */
 		framevar(3) = 0;
@@ -200,12 +587,9 @@
 		r2 = (Word) 1;
 		r3 = (Word) 1;
 		r4 = framevar(1);
-		{
-			Declare_entry(do_call_nondet_closure);
-			call(ENTRY(do_call_nondet_closure),
-				LABEL(mercury__benchmarking__benchmark_nondet_5_0_i1),
-				LABEL(mercury__benchmarking__benchmark_nondet_5_0));
-		}
+		call(ENTRY(do_call_nondet_closure),
+			LABEL(mercury__benchmarking__benchmark_nondet_5_0_i1),
+			LABEL(mercury__benchmarking__benchmark_nondet_5_0));
 	}
 
 	/* no more iterations */
@@ -245,10 +629,11 @@
 	detstackvar(1) = r3;
 	detstackvar(2) = r4;
 
-	if (rep_count <= 0)
+	if (rep_count <= 0) {
 		detstackvar(3) = 1;
-	else
+	} else {
 		detstackvar(3) = rep_count;
+	}
 
 	detstackvar(4) = MR_get_user_cpu_miliseconds();
 
@@ -257,31 +642,26 @@
 	r2 = (Word) 1;	/* the higher-order call has 1 extra input argument  */
 	r3 = (Word) 1;	/* the higher-order call has 1 extra output argument */
 	/* r4 already has the extra input argument */
-	{ 
-		Declare_entry(do_call_det_closure);
-		call(ENTRY(do_call_det_closure),
-			LABEL(mercury__benchmarking__benchmark_det_5_0_i1),
-			LABEL(mercury__benchmarking__benchmark_det_5_0));
-	}
+	call(ENTRY(do_call_det_closure),
+		LABEL(mercury__benchmarking__benchmark_det_5_0_i1),
+		LABEL(mercury__benchmarking__benchmark_det_5_0));
 
 Define_label(mercury__benchmarking__benchmark_det_5_0_i1);
+
 	/* mark current iteration completed */
 	detstackvar(3) = detstackvar(3) - 1;
+
 	/* are there any other iterations? */
-	if (detstackvar(3) > 0)
-	{
+	if (detstackvar(3) > 0) {
 		/* yes, so set up the call just like last time */
 		restore_hp(detstackvar(5));
 		r1 = detstackvar(1);
 		r2 = (Word) 1;
 		r3 = (Word) 1;
 		r4 = detstackvar(2);
-		{ 
-			Declare_entry(do_call_det_closure);
-			call(ENTRY(do_call_det_closure),
-				LABEL(mercury__benchmarking__benchmark_det_5_0_i1),
-				LABEL(mercury__benchmarking__benchmark_det_5_0));
-		}
+		call(ENTRY(do_call_det_closure),
+			LABEL(mercury__benchmarking__benchmark_det_5_0_i1),
+			LABEL(mercury__benchmarking__benchmark_det_5_0));
 	}
 
 	/* no more iterations */
@@ -299,3 +679,5 @@
 }
 
 ").
+
+%-----------------------------------------------------------------------------%
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.144
diff -u -u -r1.144 io.m
--- io.m	1997/11/21 06:49:24	1.144
+++ io.m	1997/11/24 15:43:10
@@ -848,11 +848,17 @@
 
 % Memory management predicates.
 
-	% Write some memory/time usage statistics to stdout.
+	% Write memory/time usage statistics to stdout.
 
 :- pred io__report_stats(io__state, io__state).
 :- mode io__report_stats(di, uo) is det.
 
+	% Write complete memory usage statistics to stdout,
+	% including information about all procedures and types.
+
+:- pred io__report_full_memory_stats(io__state, io__state).
+:- mode io__report_full_memory_stats(di, uo) is det.
+
 	% Preallocate heap space (to avoid NU-Prolog panic).
 
 :- pred io__preallocate_heap_space(int, io__state, io__state).
@@ -1902,6 +1908,9 @@
 
 io__report_stats -->
 	{ report_stats }.
+
+io__report_full_memory_stats -->
+	{ report_full_memory_stats }.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
Index: profiler/generate_output.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/generate_output.m,v
retrieving revision 1.17
diff -u -u -r1.17 generate_output.m
--- generate_output.m	1997/11/17 12:58:23	1.17
+++ generate_output.m	1997/11/25 17:58:20
@@ -126,7 +126,7 @@
 :- mode generate_output__cycle(in, in, in, out) is det.
 
 generate_output__cycle(ProfNode, Prof, OutputProf0, OutputProf) :-
-	prof_get_entire(Prof, Hertz, ClockTicks, IntTotalCounts, _, _,
+	prof_get_entire(Prof, Scale, _Units, IntTotalCounts, _, _,
 								_CycleMap),
 	int__to_float(IntTotalCounts, TotalCounts),
 
@@ -150,17 +150,8 @@
 	% Calculate the self time spent in the current predicate.
 	% Calculate the descendant time, which is the time spent in the 
 	% current predicate and its descendants
-	int__to_float(Hertz, HertzFloat),
-	int__to_float(ClockTicks, ClockTicksFloat),
-	(
-		HertzFloat = 0.0
-	->
-		SelfTime = 0.0,
-		DescTime = 0.0
-	;
-		SelfTime is InitialFloat / HertzFloat * ClockTicksFloat,
-		DescTime is (InitialFloat+Prop) / HertzFloat * ClockTicksFloat
-	),
+	SelfTime is InitialFloat * Scale,
+	DescTime is (InitialFloat+Prop) * Scale,
 
 	OutputProfNode = output_cycle_prof(	Name, CycleNum, SelfTime, 
 						DescPercentage,
@@ -182,7 +173,7 @@
 :- mode generate_output__single_predicate(in, in, in, out) is det.
 
 generate_output__single_predicate(ProfNode, Prof, OutputProf0, OutputProf) :-
-	prof_get_entire(Prof, Hertz, ClockTicks, IntTotalCounts, _, _, 
+	prof_get_entire(Prof, Scale, _Units, IntTotalCounts, _, _, 
 								CycleMap),
 	int__to_float(IntTotalCounts, TotalCounts),
 
@@ -222,18 +213,8 @@
 		% Calculate the self time spent in the current predicate.
 		% Calculate the descendant time, which is the time spent in the 
 		% current predicate and its descendants
-		int__to_float(Hertz, HertzFloat),
-		int__to_float(ClockTicks, ClockTicksFloat),
-		(
-			HertzFloat = 0.0
-		->
-			SelfTime = 0.0,
-			DescTime = 0.0
-		;
-			SelfTime is InitialFloat / HertzFloat * ClockTicksFloat,
-			DescTime is (InitialFloat+Prop) / HertzFloat 
-							* ClockTicksFloat
-		),
+		SelfTime is InitialFloat * Scale,
+		DescTime is (InitialFloat+Prop) * Scale,
 
 		process_prof_node_parents(ParentList, SelfTime, DescTime, 
 				TotalCalls, CycleNum, CycleMap, 
@@ -440,7 +421,7 @@
 process_prof_node_children_2([], _, Output, Output).
 process_prof_node_children_2([PN | PNs], Prof, Output0, Output) :-
 	pred_info_get_entire(PN, LabelName, Calls),
-	prof_get_entire(Prof, Hertz, ClockTicks, _, AddrMap, ProfNodeMap, 
+	prof_get_entire(Prof, Scale, _Units, _, AddrMap, ProfNodeMap, 
 								CycleMap),
 
 	(
@@ -464,13 +445,11 @@
         checked_float_divide(FloatCalls, FloatTotalCalls, Proportion),
 
 	% Calculate the self time spent in the current predicate.
-	int__to_float(Hertz, HertzFloat),
-	int__to_float(ClockTicks, ClockTicksFloat),
-	SelfTime is (InitialFloat / HertzFloat) * ClockTicksFloat,
+	SelfTime is InitialFloat * Scale,
 
 	% Calculate the descendant time, which is the time spent in the 
 	% current predicate and its descendants
-	DescTime is (CurrentCount / HertzFloat) * ClockTicksFloat,
+	DescTime is CurrentCount * Scale,
 
 	% Calculate the amount of the current predicate's self-time spent
         % due to the parent.
Index: profiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/globals.m,v
retrieving revision 1.4
diff -u -u -r1.4 globals.m
--- globals.m	1997/07/27 15:07:46	1.4
+++ globals.m	1997/11/25 18:58:57
@@ -22,10 +22,26 @@
 
 %-----------------------------------------------------------------------------%
 
+:- type what_to_profile
+	--->	memory_words
+	;	memory_cells
+	;	user_plus_system_time
+	;	user_time
+	;	real_time.
+
+:- pred what_to_profile(string, what_to_profile) is semidet.
+:- mode what_to_profile(in, out) is semidet.
+:- mode what_to_profile(out, in) is det.
+
 	% Access predicates for the `globals' structure.
 
 :- pred globals__init(option_table::in, globals::out) is det.
 
+:- pred globals__get_what_to_profile(globals::in, what_to_profile::out) is det.
+
+:- pred globals__set_what_to_profile(globals::in, what_to_profile::in,
+	globals::out) is det.
+
 :- pred globals__get_options(globals::in, option_table::out) is det.
 
 :- pred globals__set_options(globals::in, option_table::in, globals::out)
@@ -83,16 +99,28 @@
 
 %-----------------------------------------------------------------------------%
 
+what_to_profile("memory-words", memory_words).
+what_to_profile("memory-cells", memory_cells).
+what_to_profile("user-plus-system-time", user_plus_system_time).
+what_to_profile("user-time", user_time).
+what_to_profile("real-time", real_time).
+
 :- type globals
 	--->	globals(
+			what_to_profile,
 			option_table
 		).
 
-globals__init(Options, globals(Options)).
+globals__init(Options, globals(user_plus_system_time, Options)).
+
+globals__get_what_to_profile(globals(WhatToProfile, _), WhatToProfile).
+
+globals__set_what_to_profile(globals(_, A), WhatToProfile,
+				globals(WhatToProfile, A)).
 
-globals__get_options(globals(Options), Options).
+globals__get_options(globals(_, Options), Options).
 
-globals__set_options(globals(_), Options, globals(Options)).
+globals__set_options(globals(A, _), Options, globals(A, Options)).
 
 globals__lookup_option(Globals, Option, OptionData) :-
 	globals__get_options(Globals, OptionTable),

[continued in part 2]

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   WWW: <http://www.cs.mu.oz.au/~fjh>  
Note: due to some buggy software and a (probably accidental)
denial-of-service attack, any mail sent to me between
	Tue Nov 25 20:00:00 UTC (6am Wed, local time)
and	Wed Nov 26 06:00:00 UTC (4pm, local time)
may have gone into the bit-bucket.  Please re-send it.



More information about the developers mailing list