[m-dev.] diff: fix mlc.gc.memprof intermodule opt bug

[Fergus Henderson]

Estimated hours taken: 1

Fix a bug that broke the `hlc.gc.memprof' grade when intermodule
optimization was enabled.  Also eliminate an XXX in ml_elim_nested.m.

compiler/ml_code_gen.m:
	Use the pred_id and proc_id of the current procedure,
	rather than the one from the `pragma foreign_code',
	for generating the name/1 used for MR_PROC_LABEL.
	Also, generate the fully qualified name rather than
	discarding the module name.

compiler/mlds.m:
	Make the argument of the name/1 target_code_component
	a fully qualified entity name, rather than an unqualified one.

compiler/mlds_to_c.m:
	Output the fully qualified name, rather than assuming that the
	name comes from the current module.

compiler/ml_elim_nested.m:
	Modify target_code_component_contains_var to handle the
	new type of name/1.  This allowed eliminating an XXX
	which was due to the name being unqualified.

Workspace: /home/pgrad/fjh/ws/hg3
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.66
diff -u -d -r1.66 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/11/17 17:47:54	1.66
+++ compiler/ml_code_gen.m	2000/11/20 01:37:33
@@ -1890,7 +1890,7 @@
 	% #undef it afterwards.
 	%		
 ml_gen_nondet_pragma_c_code(CodeModel, Attributes,
-		PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, Context,
+		PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes, Context,
 		LocalVarsDecls, LocalVarsContext, FirstCode, FirstContext,
 		LaterCode, LaterContext, SharedCode, SharedContext,
 		MLDS_Decls, MLDS_Statements) -->
@@ -1943,7 +1943,7 @@
 	%
 	% Generate the MR_PROC_LABEL #define
 	%
-	ml_gen_hash_define_mr_proc_label(PredId, ProcId, HashDefine),
+	ml_gen_hash_define_mr_proc_label(HashDefine),
 
 	%
 	% Put it all together
@@ -2093,7 +2093,7 @@
 	% Java.
 	%
 ml_gen_ordinary_pragma_c_code(CodeModel, Attributes,
-		PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+		PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
 		C_Code, Context, MLDS_Decls, MLDS_Statements) -->
 	%
 	% Combine all the information about the each arg
@@ -2127,7 +2127,7 @@
 	%
 	% Generate the MR_PROC_LABEL #define
 	%
-	ml_gen_hash_define_mr_proc_label(PredId, ProcId, HashDefine),
+	ml_gen_hash_define_mr_proc_label(HashDefine),
 
 	%
 	% Put it all together
@@ -2218,16 +2218,22 @@
 		ReleaseLock = ""
 	}.
 
-:- pred ml_gen_hash_define_mr_proc_label(pred_id::in, proc_id::in,
-		list(target_code_component)::out,
+:- pred ml_gen_hash_define_mr_proc_label(list(target_code_component)::out,
 		ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_gen_hash_define_mr_proc_label(PredId, ProcId, HashDefine) -->
+ml_gen_hash_define_mr_proc_label(HashDefine) -->
 	=(MLDSGenInfo),
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
-	{ ml_gen_proc_label(ModuleInfo, PredId, ProcId, MLDS_Name, _Module) },
+	% Note that we use the pred_id and proc_id of the current procedure,
+	% not the one that the pragma foreign_code originally came from.
+	% There may not be any function address for the latter, e.g. if it
+	% has been inlined and the original definition optimized away.
+	{ ml_gen_info_get_pred_id(MLDSGenInfo, PredId) },
+	{ ml_gen_info_get_proc_id(MLDSGenInfo, ProcId) },
+	{ ml_gen_proc_label(ModuleInfo, PredId, ProcId, MLDS_Name,
+			MLDS_Module) },
 	{ HashDefine = [raw_target_code("#define MR_PROC_LABEL "),
-			name(MLDS_Name),
+			name(qual(MLDS_Module, MLDS_Name)),
 			raw_target_code("\n")] }.
 
 
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.41
diff -u -d -r1.41 mlds.m
--- compiler/mlds.m	2000/11/17 17:47:57	1.41
+++ compiler/mlds.m	2000/11/20 01:12:25
@@ -1024,7 +1024,7 @@
 			% output #line directives.
 	;	target_code_input(mlds__rval)
 	;	target_code_output(mlds__lval)
-	;	name(mlds__entity_name)
+	;	name(mlds__qualified_entity_name)
 	.
 
 	% XXX I'm not sure what representation we should use here
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.69
diff -u -d -r1.69 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/11/19 05:19:00	1.69
+++ compiler/mlds_to_c.m	2000/11/20 01:15:53
@@ -2466,19 +2466,18 @@
 mlds_output_atomic_stmt(_Indent, FuncInfo, target_code(TargetLang, Components),
 		Context) -->
 	( { TargetLang = lang_C } ->
-		{ FuncInfo = func_info(qual(ModuleName, _), _FuncParams) },
 		list__foldl(
-			mlds_output_target_code_component(ModuleName, Context),
+			mlds_output_target_code_component(Context),
 			Components)
 	;
 		{ error("mlds_to_c.m: sorry, target_code only works for lang_C") }
 	).
 
-:- pred mlds_output_target_code_component(mlds_module_name, mlds__context,
-		target_code_component, io__state, io__state).
-:- mode mlds_output_target_code_component(in, in, in, di, uo) is det.
+:- pred mlds_output_target_code_component(mlds__context, target_code_component,
+		io__state, io__state).
+:- mode mlds_output_target_code_component(in, in, di, uo) is det.
 
-mlds_output_target_code_component(_ModuleName, Context,
+mlds_output_target_code_component(Context,
 		user_target_code(CodeString, MaybeUserContext)) -->
 	( { MaybeUserContext = yes(UserContext) } ->
 		mlds_output_context(mlds__make_context(UserContext))
@@ -2487,27 +2486,24 @@
 	),
 	io__write_string(CodeString),
 	io__write_string("\n").
-mlds_output_target_code_component(_ModuleName, Context,
-		raw_target_code(CodeString)) -->
+mlds_output_target_code_component(Context, raw_target_code(CodeString)) -->
 	mlds_output_context(Context),
 	io__write_string(CodeString).
-mlds_output_target_code_component(_ModuleName, Context,
-		target_code_input(Rval)) -->
+mlds_output_target_code_component(Context, target_code_input(Rval)) -->
 	mlds_output_context(Context),
 	mlds_output_rval(Rval),
 	io__write_string("\n").
-mlds_output_target_code_component(_ModuleName, Context,
-		target_code_output(Lval)) -->
+mlds_output_target_code_component(Context, target_code_output(Lval)) -->
 	mlds_output_context(Context),
 	mlds_output_lval(Lval),
 	io__write_string("\n").
-mlds_output_target_code_component(ModuleName, _Context, name(Name)) -->
+mlds_output_target_code_component(_Context, name(Name)) -->
 	% Note: `name(Name)' target_code_components are used to
 	% generate the #define for `MR_PROC_LABEL'.
 	% The fact that they're used in a #define means that we can't do
 	% an mlds_output_context(Context) here, since #line directives
 	% aren't allowed inside #defines.
-	mlds_output_fully_qualified_name(qual(ModuleName, Name)),
+	mlds_output_fully_qualified_name(Name),
 	io__write_string("\n").
 
 :- pred mlds_output_init_args(list(mlds__rval), list(mlds__type), mlds__context,
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.17
diff -u -d -r1.17 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2000/11/18 20:04:44	1.17
+++ compiler/ml_elim_nested.m	2000/11/20 01:18:06
@@ -1441,15 +1441,8 @@
 	rval_contains_var(Rval, Name).
 target_code_component_contains_var(target_code_output(Lval), Name) :-
 	lval_contains_var(Lval, Name).
-target_code_component_contains_var(name(EntityName), _VarName) :-
-	EntityName = data(var(_UnqualVarName)),
-	% XXX They might match.  But the EntityName here is unqualified,
-	%     so we can't tell for sure if there is a match.  Hence we
-	%     just abort.  Currently name/1 is only used for procedure
-	%     names, not var names, so this case won't occur.  (If it
-	%     does, the right fix is probably to make the EntityName
-	%     a fully qualified name rather than an unqualified name.)
-	error("target_code_component_contains_var: name/1 used for var").
+target_code_component_contains_var(name(EntityName), VarName) :-
+	EntityName = data(var(VarName)).
 
 :- pred rvals_contains_var(list(mlds__rval), mlds__var).
 :- mode rvals_contains_var(in, in) is semidet.

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------