[m-dev.] for review: IL backend bugfixes

Tyson Dowd trd at cs.mu.OZ.AU
Sun Oct 22 12:04:30 AEDT 2000


Hi,

With these fixes, we can now compile and run programs such as eliza.

===================================================================


Estimated hours taken: 4

Fix problems that stopped the IL backend from working.
Also fix misleading error messages given by sorry/1 and unexpected/1
which I noticed when I was fixing these bugs.

compiler/error_util.m:
compiler/ml_code_util.m:
compiler/mlds_to_il.m:
compiler/mlds_to_ilasm.m:
	Add sorry/2 and unexpected/2, which give sorry and unexpected
	messages but also take the module name as a parameter.
	Implement sorry/1 and unexpected/1 using the more general versions.  
	Use sorry/2 and unexpected/2.

compiler/handle_options.m:
	Only do	low-level backend option implications if we are generating
	low-level code.  This fixes a bug where static ground terms were
	being re-activated in the IL backend because -no-lazy-code implies
	static ground terms.  (The IL backend doesn't support static
	ground terms).

compiler/ilasm.m:
	Fix some quoting bugs.  We were replacing " with \" and then
	replacing \" with \\".

compiler/ml_elim_nested.m:
	Fix some bugs where we were using the wrong type for
	environment "pointers".  In IL the env_ptr is actually just an
	object reference, not a pointer at all.
	We now store the env_ptr type in the elim_info.

compiler/mlds.m:
	Add an extra comment about cast.



Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.12
diff -u -r1.12 error_util.m
--- compiler/error_util.m	1999/12/08 13:24:43	1.12
+++ compiler/error_util.m	2000/10/21 08:49:02
@@ -96,10 +96,27 @@
 		io__state, io__state).
 :- mode report_error_num_args(in, in, in, di, uo) is det.
 
+
+	% sorry(ModuleName, Message)
+	% Call error/1 with a "Sorry, not implemented" message.
+	%
+	% Use this for features that should be implemented (or at
+	% least could be implemented).
+	%
+:- pred sorry(string::in, string::in) is erroneous.
+
+	% unexpected(ModuleName, Message)
+	% Call error/1 with an "Unexpected" message.
+	%
+	% Use this to handle cases which are not expected to arise (i.e.
+	% bugs).
+	%
+:- pred unexpected(string::in, string::in) is erroneous.
+
 :- implementation.
 
 :- import_module prog_out, globals, options.
-:- import_module bool, io, list, term, char, string, int.
+:- import_module bool, io, list, term, char, string, int, require.
 
 error_util__list_to_pieces([], []).
 error_util__list_to_pieces([Elem], [words(Elem)]).
@@ -435,4 +452,19 @@
 		io__write_string(", ")
 	),
 	report_error_right_num_args(Arities).
+
+
+
+	% Call error/1 with a "Sorry, not implemented" message.
+	%
+sorry(Module, What) :-
+	string__format("%s: Sorry, not implemented: %s",
+		[s(Module), s(What)], ErrorMessage),
+	error(ErrorMessage).
+
+unexpected(Module, What) :-
+	string__format("%s: Unexpected: %s", 
+		[s(Module), s(What)], ErrorMessage),
+	error(ErrorMessage).
+
 
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.94
diff -u -r1.94 handle_options.m
--- compiler/handle_options.m	2000/10/13 04:04:28	1.94
+++ compiler/handle_options.m	2000/10/21 08:49:02
@@ -558,18 +558,35 @@
 	% we are expecting some to be missing.
 	option_implies(use_opt_files, warn_missing_opt_files, bool(no)),
 
-	% --no-lazy-code assumes that const(_) rvals are really constant,
-	% and that create(_) rvals with constant arguments can be materialized
-	% in an assignable rval without further code. For float_consts,
-	% the former is true only if either static_ground_terms or
-	% unboxed_floats is true, and the latter cannot be true without
-	% static_ground_terms.
+	globals__io_lookup_bool_option(highlevel_code, HighLevel),
+	( { HighLevel = no } ->
+		postprocess_options_lowlevel
+	;
+		[]
+	).
+
+	% These option implications only affect the low-level (LLDS) code
+	% generator.  They may in fact be harmful if set for the high-level
+	% code generator, because sometimes the same option has different
+	% meanings and implications in the two backends.
+	%
+:- pred postprocess_options_lowlevel(io__state::di, io__state::uo) is det.
+
+postprocess_options_lowlevel -->
+		% --no-lazy-code assumes that const(_) rvals are really
+		% constant, and that create(_) rvals with constant arguments
+		% can be materialized in an assignable rval without further
+		% code. For float_consts, the former is true only if either
+		% static_ground_terms or unboxed_floats is true, and the latter
+		% cannot be true without static_ground_terms.
 	option_neg_implies(lazy_code, static_ground_terms, bool(yes)),
 
-	% --no-lazy-code requires --follow-vars for acceptable performance.
+		% --no-lazy-code requires --follow-vars for acceptable
+		% performance.
 	option_neg_implies(lazy_code, follow_vars, bool(yes)),
 
-	% --optimize-frames requires --optimize-labels and --optimize-jumps
+		% --optimize-frames requires --optimize-labels and
+		% --optimize-jumps
 	option_implies(optimize_frames, optimize_labels, bool(yes)),
 	option_implies(optimize_frames, optimize_jumps, bool(yes)).
 
Index: compiler/ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ilasm.m,v
retrieving revision 1.1
diff -u -r1.1 ilasm.m
--- compiler/ilasm.m	2000/10/14 04:00:11	1.1
+++ compiler/ilasm.m	2000/10/21 08:49:02
@@ -618,7 +618,7 @@
 			% We have to quote loadstrings.
 		( { Instr = ldstr(LoadString) } ->
 			io__write_string("ldstr \\"""),
-			output_escaped_string(LoadString, """"),
+			output_escaped_string(LoadString, '\"'),
 			io__write_string("\\""")
 				% XXX there could be issues with
 				% comments containing embedded newlines
@@ -1164,7 +1164,7 @@
 	is det.
 output_string_constant(String) -->
 	io__write_string(""""),
-	output_escaped_string(String, """"),  
+	output_escaped_string(String, '\"'),
 	io__write_string("""").
 
 :- pred output_class_member_name(class_member_name::in,
@@ -1341,13 +1341,13 @@
 	% there is no list available).
 :- pred quote_id(ilds__id::in, string::out) is det.
 quote_id(Id, QuotedId) :-
-	escape_string(Id, "'", EscapedId),
+	escape_string(Id, '\'', EscapedId),
 	string__append_list(["'", EscapedId, "'"], QuotedId).
 
-:- pred output_escaped_string(string::in, string::in,
+:- pred output_escaped_string(string::in, char::in,
 		io__state::di, io__state::uo) is det.
-output_escaped_string(String, Escape) -->
-	{ escape_string(String, Escape, EscapedString) },
+output_escaped_string(String, EscapeChar) -->
+	{ escape_string(String, EscapeChar, EscapedString) },
 	io__write_string(EscapedString).
 
 	% Replace all Rep0 with backslash quoted Rep0 in Str0,
@@ -1355,15 +1355,15 @@
 	% We also escape embedded newlines and other characters.
 	% We already do some name mangling during code generation that
 	% means we avoid most weird characters here.
-:- pred escape_string(string::in, string::in, string::out) is det.
-escape_string(Str0, Replace, Str) :-
-	string__append("\\", Replace, ReplaceWith),
-	string__replace_all(Str0, Replace, ReplaceWith, Str1),
-	string__to_char_list(Str1, CharList0),
+:- pred escape_string(string::in, char::in, string::out) is det.
+escape_string(Str0, ReplaceChar, Str) :-
+	string__to_char_list(Str0, CharList0),
 	list__foldl(
 		(pred(Char::in, E0::in, E::out) is det :-
 			( escape_special_char(Char, QuoteChar) ->
 				E = [QuoteChar, '\\' | E0]
+			; Char = ReplaceChar ->
+				E = [ReplaceChar, '\\' | E0]
 			;
 				E = [Char | E0]
 			)
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.23
diff -u -r1.23 ml_code_util.m
--- compiler/ml_code_util.m	2000/10/14 04:00:16	1.23
+++ compiler/ml_code_util.m	2000/10/21 08:49:02
@@ -594,7 +594,7 @@
 :- implementation.
 
 :- import_module ml_call_gen.
-:- import_module prog_util, type_util, mode_util, special_pred.
+:- import_module prog_util, type_util, mode_util, special_pred, error_util.
 :- import_module code_util. % XXX for `code_util__compiler_generated'.
 :- import_module globals, options.
 
@@ -789,14 +789,10 @@
 	% Call error/1 with a "Sorry, not implemented" message.
 	%
 sorry(What) :-
-	string__format("ml_code_gen.m: Sorry, not implemented: %s",
-		[s(What)], ErrorMessage),
-	error(ErrorMessage).
+	error_util__sorry("ml_code_gen", What).	
 
 unexpected(What) :-
-	string__format("ml_code_gen.m: Unexpected: %s", 
-		[s(What)], ErrorMessage),
-	error(ErrorMessage).
+	error_util__unexpected("ml_code_gen", What).	
 
 %-----------------------------------------------------------------------------%
 %
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.13
diff -u -r1.13 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2000/10/14 04:00:16	1.13
+++ compiler/ml_elim_nested.m	2000/10/21 08:49:02
@@ -160,6 +160,13 @@
 			% EnvTypeName from just EnvName
 		ml_create_env(EnvName, [], Context, ModuleName, Globals,
 			_EnvTypeDefn, EnvTypeName, _EnvDecls, _InitEnv),
+		
+		globals__get_target(Globals, Target),
+		( Target = il ->
+			EnvPtrTypeName = EnvTypeName
+		;
+			EnvPtrTypeName = mlds__ptr_type(EnvTypeName)
+		),
 
 		%
 		% traverse the function body, finding (and removing)
@@ -167,7 +174,8 @@
 		% to the arguments or to local variables which
 		% occur in nested functions
 		%
-		ElimInfo0 = elim_info_init(ModuleName, OuterVars, EnvTypeName),
+		ElimInfo0 = elim_info_init(ModuleName, OuterVars, EnvTypeName,
+			EnvPtrTypeName),
 		Params = mlds__func_params(Arguments, _RetValues),
 		ml_maybe_add_args(Arguments, FuncBody0, ModuleName,
 			Context, ElimInfo0, ElimInfo1),
@@ -219,8 +227,8 @@
 				% structure.
 				%
 				ml_maybe_copy_args(Arguments, FuncBody0,
-					ModuleName, EnvTypeName, Context,
-					_ArgsToCopy, CodeToCopyArgs),
+					ModuleName, EnvTypeName, EnvPtrTypeName,
+					Context, _ArgsToCopy, CodeToCopyArgs),
 
 				%
 				% insert the definition and
@@ -280,15 +288,15 @@
 	% to the environment struct.
 	%
 :- pred ml_maybe_copy_args(mlds__arguments, mlds__statement,
-		mlds_module_name, mlds__type, mlds__context, 
+		mlds_module_name, mlds__type, mlds__type, mlds__context, 
 		mlds__defns, mlds__statements).
-:- mode ml_maybe_copy_args(in, in, in, in, in, out, out) is det.
+:- mode ml_maybe_copy_args(in, in, in, in, in, in, out, out) is det.
 
-ml_maybe_copy_args([], _, _, _, _, [], []).
-ml_maybe_copy_args([Arg|Args], FuncBody, ModuleName, ClassType, Context,
-		ArgsToCopy, CodeToCopyArgs) :-
-	ml_maybe_copy_args(Args, FuncBody, ModuleName, ClassType, Context,
-			ArgsToCopy0, CodeToCopyArgs0),
+ml_maybe_copy_args([], _, _, _, _, _, [], []).
+ml_maybe_copy_args([Arg|Args], FuncBody, ModuleName, ClassType, EnvPtrTypeName,
+		Context, ArgsToCopy, CodeToCopyArgs) :-
+	ml_maybe_copy_args(Args, FuncBody, ModuleName, ClassType,
+		EnvPtrTypeName,	Context, ArgsToCopy0, CodeToCopyArgs0),
 	(
 		Arg = data(var(VarName)) - FieldType,
 		ml_should_add_local_var(ModuleName, VarName, [], [FuncBody])
@@ -303,11 +311,11 @@
 		QualVarName = qual(ModuleName, VarName),
 		EnvModuleName = ml_env_module_name(ClassType),
 		FieldName = named_field(qual(EnvModuleName, VarName),
-			mlds__ptr_type(ClassType)),
+			EnvPtrTypeName),
 		Tag = yes(0),
 		EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
 		EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType, 
-			mlds__ptr_type(ClassType)),
+			EnvPtrTypeName),
 		ArgRval = lval(var(QualVarName)),
 		AssignToEnv = assign(EnvArgLval, ArgRval),
 		CodeToCopyArg = mlds__statement(atomic(AssignToEnv), Context),
@@ -925,6 +933,7 @@
 	ModuleName = elim_info_get_module_name(ElimInfo),
 	LocalVars = elim_info_get_local_vars(ElimInfo),
 	ClassType = elim_info_get_env_type_name(ElimInfo),
+	EnvPtrVarType = elim_info_get_env_ptr_type_name(ElimInfo),
 	(
 		%
 		% Check for references to local variables
@@ -942,7 +951,7 @@
 		EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
 		EnvModuleName = ml_env_module_name(ClassType),
 		FieldName = named_field(qual(EnvModuleName, ThisVarName),
-			mlds__ptr_type(ClassType)),
+			EnvPtrVarType),
 		Tag = yes(0),
 		Lval = field(Tag, EnvPtr, FieldName, FieldType, ClassType)
 	;
@@ -1384,7 +1393,10 @@
 			local_vars :: list(mlds__defn),
 				
 				% Type of the introduced environment struct
-			env_type_name :: mlds__type
+			env_type_name :: mlds__type,
+
+				% Type of the introduced environment struct
+			env_ptr_type_name :: mlds__type
 	).
 
 	% The lists of local variables for
@@ -1392,9 +1404,10 @@
 	% innermost first
 :- type outervars == list(list(mlds__defn)).
 
-:- func elim_info_init(mlds_module_name, outervars, mlds__type) = elim_info.
-elim_info_init(ModuleName, OuterVars, EnvTypeName) =
-	elim_info(ModuleName, OuterVars, [], [], EnvTypeName).
+:- func elim_info_init(mlds_module_name, outervars, mlds__type, mlds__type)
+	= elim_info.
+elim_info_init(ModuleName, OuterVars, EnvTypeName, EnvPtrTypeName) =
+	elim_info(ModuleName, OuterVars, [], [], EnvTypeName, EnvPtrTypeName).
 
 :- func elim_info_get_module_name(elim_info) = mlds_module_name.
 elim_info_get_module_name(ElimInfo) = ElimInfo ^ module_name.
@@ -1407,6 +1420,9 @@
 
 :- func elim_info_get_env_type_name(elim_info) = mlds__type.
 elim_info_get_env_type_name(ElimInfo) = ElimInfo ^ env_type_name.
+
+:- func elim_info_get_env_ptr_type_name(elim_info) = mlds__type.
+elim_info_get_env_ptr_type_name(ElimInfo) = ElimInfo ^ env_ptr_type_name.
 
 :- pred elim_info_add_nested_func(mlds__defn, elim_info, elim_info).
 :- mode elim_info_add_nested_func(in, in, out) is det.
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.35
diff -u -r1.35 mlds.m
--- compiler/mlds.m	2000/10/06 10:18:26	1.35
+++ compiler/mlds.m	2000/10/21 08:49:02
@@ -1078,8 +1078,11 @@
 :- type mlds__unary_op
 	--->	box(mlds__type)
 	;	unbox(mlds__type)
-	;	cast(mlds__type) % XXX it might be worthwhile adding the 
-				 % type that we cast from.
+			% cast(MLDSType):
+			% Coerce the type of the rval to be MLDSType.
+			% XXX it might be worthwhile adding the 
+			% type that we cast from.
+	;	cast(mlds__type)
 	;	std_unop(builtin_ops__unary_op).
 
 :- type mlds__rval_const
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.2
diff -u -r1.2 mlds_to_il.m
--- compiler/mlds_to_il.m	2000/10/20 10:10:52	1.2
+++ compiler/mlds_to_il.m	2000/10/21 08:51:36
@@ -127,7 +127,7 @@
 :- import_module rtti, type_util.
 
 :- import_module ilasm, il_peephole.
-:- import_module ml_util, ml_code_util.
+:- import_module ml_util, ml_code_util, error_util.
 :- import_module mlds_to_c. /* to output C code for .cpp files */
 :- use_module llds. /* for user_c_code */
 
@@ -542,7 +542,7 @@
 				]) }
 		)
 	;
-		{ unexpected("defn not data(...) in block") }
+		{ unexpected(this_file, "defn not data(...) in block") }
 	).
 
 	% initialize this value, leave it on the stack.
@@ -795,7 +795,7 @@
 			instr_node(ret)]) }
 	;
 		% MS IL doesn't support multiple return values
-		{ sorry("multiple return values") }
+		{ sorry(this_file, "multiple return values") }
 	).
 
 statement_to_il(statement(label(Label), _Context), Instrs) -->
@@ -853,7 +853,7 @@
 	{ RefType = ilds__type(_, class(ClassName0)) ->
 			ClassName = ClassName0
 		;
-			unexpected("non-class for commit ref")
+			unexpected(this_file, "non-class for commit ref")
 	},	
 	{ Instrs = tree__list([
 		comment_node("try_commit/3"),
@@ -986,7 +986,7 @@
 		->
 			ClassName = ClassName0
 		;
-			unexpected("non-class for new_object")
+			unexpected(this_file, "non-class for new_object")
 		},	
 		list__map_foldl(load, Args, ArgsLoadInstrsTrees),
 		{ ArgsLoadInstrs = tree__list(ArgsLoadInstrsTrees) },
@@ -1259,7 +1259,7 @@
 		% you always need load the reference first, then
 		% the value, then stind it.  There's no swap
 		% instruction.  Annoying, eh?
-	unexpected("store into mem_ref").
+	unexpected(this_file, "store into mem_ref").
 
 store(var(Var), Instrs, Info, Info) :- 
 	mangle_mlds_var(Var, MangledVarStr),
@@ -1409,7 +1409,7 @@
 	] }.
 
 binaryop_to_il(body, _) -->
-	{ error("unexpected binop: body") }.
+	{ unexpected(this_file, "binop: body") }.
 
 
 	% XXX we need to know what kind of thing is being indexed
@@ -1547,19 +1547,19 @@
 					id(ProcLabelStr))
 			)
 		;
-			unexpected(
+			unexpected(this_file,
 				"rval_to_function: const is not a code address")
 		)
 	; Rval = mkword(_, _),
-		unexpected("mkword_function_name")
+		unexpected(this_file, "mkword_function_name")
 	; Rval = lval(_),
-		unexpected("lval_function_name")
+		unexpected(this_file, "lval_function_name")
 	; Rval = unop(_, _),
-		unexpected("unop_function_name")
+		unexpected(this_file, "unop_function_name")
 	; Rval = binop(_, _, _),
-		unexpected("binop_function_name")
+		unexpected(this_file, "binop_function_name")
 	; Rval = mem_addr(_),
-		unexpected("mem_addr_function_name")
+		unexpected(this_file, "mem_addr_function_name")
 	).
 
 %-----------------------------------------------------------------------------
@@ -1685,7 +1685,7 @@
 		Param = simple_type(SimpleType)
 	;
 		% IL doesn't support multiple return values
-		sorry("multiple return values")
+		sorry(this_file, "multiple return values")
 	).
 
 params_to_il_signature(ModuleName, mlds__func_params(Inputs, Outputs),
@@ -1699,7 +1699,7 @@
 		Param = simple_type(SimpleType)
 	;
 		% IL doesn't support multiple return values
-		sorry("multiple return values")
+		sorry(this_file, "multiple return values")
 	),
 	ILSignature = signature(call_conv(no, default), Param, ILInputTypes).
 
@@ -2134,14 +2134,16 @@
 		->
 			ClassName = ClassTypeName0
 		;
-			unexpected("not a class for field access")
+			ClassName = ["invalid_field_access_class"]
+			% unexpected(this_file, "not a class for field access")
 		),
 		( 
 			FieldNum = offset(OffsetRval),
 			( OffsetRval = const(int_const(Num)) ->
 				string__format("f%d", [i(Num)], FieldId)
 			;
-				sorry("offsets for non-int_const rvals")
+				sorry(this_file, 
+					"offsets for non-int_const rvals")
 			)
 		; 
 			FieldNum = named_field(qual(_ModuleName, FieldId),
@@ -2639,6 +2641,9 @@
 	P(T, V, U0, U).
 
 %-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "mlds_to_il.m".
 
 :- end_module mlds_to_il.
 
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.1
diff -u -r1.1 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m	2000/10/14 07:54:11	1.1
+++ compiler/mlds_to_ilasm.m	2000/10/21 08:49:02
@@ -32,7 +32,7 @@
 :- import_module builtin_ops, c_util, modules, tree.
 :- import_module hlds_pred. % for `pred_proc_id'.
 :- import_module prog_data, prog_out, llds_out.
-:- import_module rtti, type_util.
+:- import_module rtti, type_util, error_util.
 
 :- import_module ilds, ilasm, il_peephole.
 :- import_module ml_util, ml_code_util.
@@ -358,7 +358,7 @@
 			write_managed_cpp_lval(Lval),
 			io__write_string(" = ")
 		;
-			{ sorry("multiple return values") }
+			{ sorry(this_file, "multiple return values") }
 		),
 		write_managed_cpp_rval(Function),
 		io__write_string("("),
@@ -372,7 +372,7 @@
 			write_managed_cpp_rval(Rval),
 			io__write_string(";\n")
 		;
-			{ sorry("multiple return values") }
+			{ sorry(this_file, "multiple return values") }
 		)
 	;
 		{ Statement = statement(atomic(assign(Lval, Rval)), _) }
@@ -644,7 +644,7 @@
 		io__write_string(Id)
 	;
 		% XXX should make up a name!
-		{ unexpected("unnamed argument in method parameters") }
+		{ sorry(this_file, "unnamed arguments in method parameters") }
 	).
 
 
@@ -654,4 +654,7 @@
 drop_assemblies_from_class_name([]) = [].
 drop_assemblies_from_class_name([A | Rest]) = 
 	( ( A = "mscorlib" ; A = "mercury" ) -> Rest ; [A | Rest] ).
+
+:- func this_file = string.
+this_file = "mlds_to_ilasm.m".
 


-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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