[m-dev.] for review: bootstrap hlc.gc.memprof grade

Peter Ross peter.ross at miscrit.be
Wed Aug 2 02:28:12 AEST 2000


Here is the relative diff.
On Tue, Aug 01, 2000 at 10:55:53PM +1000, Fergus Henderson wrote:
> 
> Apart from the issues mentioned above, this change looks good.  I'd
> like to see another diff when you've addressed those review comments.
> 
Here is the relative diff. Sorry I can't send more as I have to run for
my bus.

diff -u compiler.old/ml_code_gen.m compiler/ml_code_gen.m
--- compiler.old/ml_code_gen.m	Tue Aug  1 16:06:33 2000
+++ compiler/ml_code_gen.m	Tue Aug  1 17:03:11 2000
@@ -1581,6 +1581,7 @@
 	% For model_non pragma c_code,
 	% we generate code of the following form:
 	%
+	%	#define MR_PROC_LABEL <procedure name>
 	% 	<declaration of locals needed for boxing/unboxing>
 	%	{
 	% 		<declaration of one local variable for each arg>
@@ -1617,6 +1618,16 @@
 	%		#undef SUCCEED_LAST
 	%		#undef LOCALS
 	%	}
+	%	#undef MR_PROC_LABEL
+	%
+	% We insert a #define for MR_PROC_LABEL, so that the C code in
+	% the Mercury standard library that allocates memory manually
+	% can use MR_PROC_LABEL as the procname argument to
+	% incr_hp_msg(), for memory profiling.  Hard-coding the procname
+	% argument in the C code would be wrong, since it wouldn't
+	% handle the case where the original pragma c_code procedure
+	% gets inlined and optimized away.  Of course we also need to
+	% #undef it afterwards.
 	%		
 ml_gen_nondet_pragma_c_code(CodeModel, Attributes,
 		PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, Context,
@@ -1748,6 +1759,7 @@
 	%
 	% model_det pragma_c_code:
 	%
+	%	#define MR_PROC_LABEL <procedure name>
 	% 	<declaration of locals needed for boxing/unboxing>
 	%	{
 	% 		<declaration of one local variable for each arg>
@@ -1759,9 +1771,11 @@
 	%		<release global lock>
 	%		<assign output args>
 	%	}
+	%	#undef MR_PROC_LABEL
 	%		
 	% model_semi pragma_c_code:
 	%
+	%	#define MR_PROC_LABEL <procedure name>
 	% 	<declaration of locals needed for boxing/unboxing>
 	%	{
 	% 		<declaration of one local variable for each arg>
@@ -1778,6 +1792,16 @@
 	%		
 	%		<succeeded> = SUCCESS_INDICATOR;
 	%	}
+	%	#undef MR_PROC_LABEL
+	%
+	% We insert a #define for MR_PROC_LABEL, so that the C code in
+	% the Mercury standard library that allocates memory manually
+	% can use MR_PROC_LABEL as the procname argument to
+	% incr_hp_msg(), for memory profiling.  Hard-coding the procname
+	% argument in the C code would be wrong, since it wouldn't
+	% handle the case where the original pragma c_code procedure
+	% gets inlined and optimized away.  Of course we also need to
+	% #undef it afterwards.
 	%		
 	% Note that we generate this code directly as
 	% `target_code(lang_C, <string>)' instructions in the MLDS.
diff -u compiler.old/mlds_to_c.m compiler/mlds_to_c.m
--- compiler.old/mlds_to_c.m	Tue Aug  1 16:09:14 2000
+++ compiler/mlds_to_c.m	Tue Aug  1 18:17:53 2000
@@ -146,6 +146,7 @@
 	{ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName) },
 	mlds_output_defns(Indent, MLDS_ModuleName, PublicTypeDefns), io__nl,
 	mlds_output_decls(Indent, MLDS_ModuleName, PublicNonTypeDefns), io__nl,
+	mlds_maybe_output_init_fn_decl(MLDS_ModuleName), io__nl,
 	mlds_output_hdr_end(Indent, ModuleName).
 
 :- pred defn_is_public(mlds__defn).
@@ -240,7 +241,7 @@
 
 	mlds_output_c_defns(MLDS_ModuleName, Indent, ForeignCode), io__nl,
 	mlds_output_defns(Indent, MLDS_ModuleName, NonTypeDefns), io__nl,
-	mlds_output_init_fn(MLDS_ModuleName, NonTypeDefns), io__nl,
+	mlds_maybe_output_init_fn_defn(MLDS_ModuleName, NonTypeDefns), io__nl,
 	mlds_output_src_end(Indent, ModuleName).
 
 :- pred mlds_output_hdr_start(indent, mercury_module_name,
@@ -281,8 +282,6 @@
 	io__write_string(". */\n"),
 	mlds_indent(Indent),
 	io__write_string("/* :- implementation. */\n"),
-	io__write_string("#include ""mercury_imp.h""\n"),
-	io__nl,
 	mlds_output_src_import(Indent,
 		mercury_module_name_to_mlds(ModuleName)),
 	io__nl.
@@ -315,16 +314,61 @@
 %-----------------------------------------------------------------------------%
 
 	%
-	% Output the function `mercury__<modulename>_init()'.
+	% Maybe output the function `mercury__<modulename>_init()'.
 	% The body of the function consists of calls
 	% init_entry(<function>) for each function defined in the
 	% module.
 	%
-:- pred mlds_output_init_fn(mlds_module_name::in, mlds__defns::in,
+:- pred mlds_maybe_output_init_fn_decl(mlds_module_name::in,
+		io__state::di, io__state::uo) is det.
+
+mlds_maybe_output_init_fn_decl(ModuleName) -->
+	io_get_globals(Globals),
+	(
+		{ output_init_fn(Globals) }
+	->
+		output_init_fn_name(ModuleName),
+		io__write_string(";\n")
+	;
+		[]
+	).
+
+:- pred mlds_maybe_output_init_fn_defn(mlds_module_name::in, mlds__defns::in,
 		io__state::di, io__state::uo) is det.
 
-mlds_output_init_fn(ModuleName, Defns) -->
-		% Here we ensure that we only get on "mercury__" at the
+mlds_maybe_output_init_fn_defn(ModuleName, Defns) -->
+	io_get_globals(Globals),
+	(
+		{ output_init_fn(Globals) }
+	->
+		output_init_fn_name(ModuleName),
+		io__write_string("\n{\n"),
+		io__write_strings(["\tstatic int initialised = 0;\n",
+				"\tif (initialised) return;\n",
+				"\tinitialised = 1;\n\n"]),
+		mlds_output_init_fn_2(ModuleName, Defns),
+		io__write_string("\n}\n")
+	;
+		[]
+	).
+
+	%
+	% Do we need an init function?
+	%
+:- pred output_init_fn(globals::in) is semidet.
+
+output_init_fn(Globals) :-
+	( Option = profile_calls
+	; Option = profile_time
+	; Option = profile_memory
+	),
+	globals__lookup_bool_option(Globals, Option, yes).
+	
+:- pred output_init_fn_name(mlds_module_name::in,
+		io__state::di, io__state::uo) is det.
+
+output_init_fn_name(ModuleName) -->
+		% Here we ensure that we only get one "mercury__" at the
 		% start of the function name.
 	{ prog_out__sym_name_to_string(
 			mlds_module_name_to_sym_name(ModuleName), "__", 
@@ -337,26 +381,9 @@
 		string__append("mercury__", ModuleNameString0,
 				ModuleNameString)
 	},
-
-		% Function prototype.
-	output_init_fn_name(ModuleNameString),
-	io__write_string(";\n"),
-
-		% Function body.
-	output_init_fn_name(ModuleNameString),
-	io__write_string("\n{\n"),
-	io__write_strings(["\tstatic int initialised=0;\n",
-			"\tif (initialised) return;\n",
-			"\tinitialised=1;\n\n"]),
-	mlds_output_init_fn_2(ModuleName, Defns),
-	io__write_string("\n}\n").
-
-:- pred output_init_fn_name(string::in, io__state::di, io__state::uo) is det.
-
-output_init_fn_name(Name) -->
 	io__write_string("void "),
-	io__write_string(Name),
-	io__write_string("__mlds_output_init_fn(void)").
+	io__write_string(ModuleNameString),
+	io__write_string("_init(void)").
 
 :- pred mlds_output_init_fn_2(mlds_module_name::in, mlds__defns::in,
 		io__state::di, io__state::uo) is det.
@@ -368,7 +395,7 @@
 		{ EntityName = function(_, _, _, _) }
 	->
 		{ QualName = qual(ModuleName, EntityName) },
-		io__write_string("\tinit_entry("),
+		io__write_string("\tMR_init_entry("),
 		mlds_output_fully_qualified_name(QualName),
 		io__write_string(");\n")
 	;
@@ -1917,21 +1944,15 @@
 		% is e.g. inside an if-then-else.
 		%
 		mlds_indent(Indent),
-		( { IsTailCall = tail_call } ->
-			( { Results \= [] } ->
-				io__write_string("return ")
-			;
-				io__write_string("{\n"),
-				mlds_indent(Context, Indent + 1),
+		io__write_string("{\n"),
 
-				io__write_string("PROFILE("),
-				mlds_output_bracketed_rval(FuncRval),
-				io__write_string(", "),
-				mlds_output_fully_qualified_name(Name),
-				io__write_string(");\n"),
+		mlds_maybe_output_call_profile_instr(Context,
+				Indent+1, FuncRval, Name),
 
-				mlds_indent(Context, Indent + 1)
-			)
+		mlds_indent(Context, Indent + 1),
+
+		( { IsTailCall = tail_call, Results \= [] } ->
+			io__write_string("return ")
 		;
 			[]
 		),
@@ -1956,12 +1977,12 @@
 
 		( { IsTailCall = tail_call, Results = [] } ->
 			mlds_indent(Context, Indent + 1),
-			io__write_string("return;\n"),
-			mlds_indent(Context, Indent),
-			io__write_string("}\n")
+			io__write_string("return;\n")
 		;
 			[]
-		)
+		),
+		mlds_indent(Indent),
+		io__write_string("}\n")
 	).
 
 mlds_output_stmt(Indent, _FuncInfo, return(Results), _) -->
@@ -2069,6 +2090,63 @@
 		mlds_output_statement(Indent + 1, FuncInfo, Handler)
 	).
 
+	%
+	% If memory profiling is turned on output an instruction to
+	% record the heap allocation.
+	%
+:- pred mlds_maybe_output_heap_profile_instr(mlds__context::in,
+		indent::in, list(mlds__rval)::in,
+		mlds__qualified_entity_name::in, maybe(ctor_name)::in,
+		io__state::di, io__state::uo) is det.
+
+mlds_maybe_output_heap_profile_instr(Context, Indent, Args, FuncName,
+		MaybeCtorName) -->
+	globals__io_lookup_bool_option(profile_memory, ProfileMem),
+	(
+		{ ProfileMem = yes }
+	->
+		mlds_indent(Context, Indent),
+		io__write_string("MR_record_allocation("),
+		io__write_int(list__length(Args)),
+		io__write_string(", "),
+		mlds_output_fully_qualified_name(FuncName),
+		io__write_string(", "),
+		( { MaybeCtorName = yes(CtorName) } ->
+			io__write_char('"'),
+			c_util__output_quoted_string(CtorName),
+			io__write_char('"')
+		;
+			io__write_string("NULL")
+		),
+		io__write_string(");\n")
+	;
+		[]
+	).
+
+	%
+	% If call profiling is turned on output an instruction to record
+	% an arc in the call profile between the callee and caller.
+	%
+:- pred mlds_maybe_output_call_profile_instr(mlds__context::in,
+		indent::in, mlds__rval::in, mlds__qualified_entity_name::in,
+		io__state::di, io__state::uo) is det.
+
+mlds_maybe_output_call_profile_instr(Context, Indent,
+		CalleeFuncRval, CallerName) -->
+	globals__io_lookup_bool_option(profile_calls, ProfileCalls),
+	(
+		{ ProfileCalls = yes }
+	->
+		mlds_indent(Context, Indent),
+		io__write_string("MR_prof_call_profile("),
+		mlds_output_bracketed_rval(CalleeFuncRval),
+		io__write_string(", "),
+		mlds_output_fully_qualified_name(CallerName),
+		io__write_string(");\n")
+	;
+		[]
+	).
+
 	% return `true' if the statement is a tail call which
 	% can be optimized into a jump back to the start of the
 	% function
@@ -2225,22 +2303,10 @@
 		MaybeCtorName, Args, ArgTypes) },
 	mlds_indent(Indent),
 	io__write_string("{\n"),
-	mlds_indent(Context, Indent + 1),
 
-	{ FuncInfo = func_info(FuncName, _FuncParams) },
-	io__write_string("MR_maybe_record_allocation("),
-	io__write_int(list__length(Args)),
-	io__write_string(", "),
-	mlds_output_fully_qualified_name(FuncName),
-	io__write_string(", "),
-	( { MaybeCtorName = yes(CtorNameA) } ->
-		io__write_char('"'),
-		c_util__output_quoted_string(CtorNameA),
-		io__write_char('"')
-	;
-		io__write_string("NULL")
-	),
-	io__write_string(");\n"),
+	{ FuncInfo = func_info(FuncName, _) },
+	mlds_maybe_output_heap_profile_instr(Context, Indent+1, Args, FuncName,
+			MaybeCtorName),
 
 	mlds_indent(Context, Indent + 1),
 	mlds_output_lval(Target),
Common subdirectories: runtime.old/CVS and runtime/CVS
Common subdirectories: runtime.old/GETOPT and runtime/GETOPT
Common subdirectories: runtime.old/machdeps and runtime/machdeps
diff -u runtime.old/mercury.h runtime/mercury.h
--- runtime.old/mercury.h	Tue Aug  1 11:59:21 2000
+++ runtime/mercury.h	Tue Aug  1 17:34:42 2000
@@ -35,6 +35,18 @@
   #endif
 #endif
 
+#ifdef PROFILE_CALLS
+  #include "mercury_prof.h"		/* for MR_prof_call_profile */
+#endif
+
+#ifdef PROFILE_MEMORY
+  #include "mercury_heap_profile.h"	/* for MR_record_allocation */
+#endif
+
+#if defined(PROFILE_CALLS) || defined(PROFILE_MEMORY)
+  #include "mercury_goto.h"		/* for MR_init_entry */
+#endif
+
 #include <setjmp.h>	/* for jmp_buf etc., which are used for commits */
 #include <string.h>	/* for strcmp(), which is used for =/2 on strings */
 
diff -u runtime.old/mercury_goto.h runtime/mercury_goto.h
--- runtime.old/mercury_goto.h	Sat Oct 23 08:42:13 1999
+++ runtime/mercury_goto.h	Tue Aug  1 17:33:04 2000
@@ -25,6 +25,8 @@
 #define MR_INTERNAL_LAYOUT(label)	(const MR_Stack_Layout_Label *) (Word) \
 				&(paste(mercury_data__layout__,label))
 
+#define MR_init_entry(label)	init_entry(label)
+
 /*
 ** Passing the name of a label to MR_insert_{internal,entry}_label
 ** causes that name to be included in the executable as static readonly data.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list