[m-rev.] diff: fix MLDS static ground terms with no tags (bug #37)
Julien Fischer
juliensf at csse.unimelb.edu.au
Wed Jan 16 19:12:41 AEDT 2008
Estimated hours taken: 6
Branches: main
Fix a problem with the MLDS backend that caused it to generate invalid C
for static ground terms with no tag types with float arguments.
This is bug #37 in Mantis.
The problem was caused by the code in ml_unify_gen.m that generates
initializers for static terms calling a predicate that instead generates
code for constructing terms on the heap. This "works" in most cases
except for with floats where we need to call MR_box_float() if we are
constructing them on the heap. This fix is to call a predicate
that generates C that is valid in a static initializer.
compiler/ml_unify_gen.m:
Fix an incorrect predicate call that lead to invalid
initializers for static data being generated.
Pass some extra arguments that are required by
the correct predicate around.
compiler/ml_code_util.m:
Fix the wording of a comment.
tests/hard_coded/Mmakefile:
tests/hard_coded/static_no_tag.{m,exp}:
Regression test for the above bug.
Also, exercise the construction of static ground terms
containing no tag types a bit more.
Julien.
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.130
diff -u -r1.130 ml_code_util.m
--- compiler/ml_code_util.m 31 Dec 2007 08:13:30 -0000 1.130
+++ compiler/ml_code_util.m 16 Jan 2008 08:09:33 -0000
@@ -336,10 +336,10 @@
%
:- func ml_gen_field_name(maybe(ctor_field_name), int) = mlds_field_name.
- % Succeed iff the specified type must be boxed when used as a field.
+ % Succeeds iff the specified type must be boxed when used as a field.
% For the MLDS->C and MLDS->asm back-ends, we need to box types that
- % are not word-sized, because the code % for `arg' etc. in std_util.m
- % rely on all arguments being word-sized.
+ % are not word-sized, because the code for `arg' etc. in std_util.m
+ % relies on all arguments being word-sized.
%
:- pred ml_must_box_field_type(mer_type::in, module_info::in) is semidet.
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.120
diff -u -r1.120 ml_unify_gen.m
--- compiler/ml_unify_gen.m 15 Jan 2008 05:10:20 -0000 1.120
+++ compiler/ml_unify_gen.m 16 Jan 2008 08:09:33 -0000
@@ -328,20 +328,23 @@
% Note that any changes here may require similar changes to
% ml_gen_construct.
%
-:- pred ml_gen_static_const_arg(prog_var::in, static_cons::in, mlds_rval::out,
+:- pred ml_gen_static_const_arg(prog_var::in, static_cons::in, prog_context::in,
+ mlds_defns::out, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_static_const_arg(Var, StaticCons, Rval, !Info) :-
+ml_gen_static_const_arg(Var, StaticCons, Context, Defns, Rval, !Info) :-
% Figure out how this argument is represented.
StaticCons = static_cons(ConsId, _ArgVars, _StaticArgs),
ml_variable_type(!.Info, Var, VarType),
ml_cons_id_to_tag(!.Info, ConsId, VarType, Tag),
- ml_gen_static_const_arg_2(Tag, VarType, Var, StaticCons, Rval, !Info).
+ ml_gen_static_const_arg_2(Tag, VarType, Var, StaticCons, Context, Defns,
+ Rval, !Info).
:- pred ml_gen_static_const_arg_2(cons_tag::in, mer_type::in, prog_var::in,
- static_cons::in, mlds_rval::out, ml_gen_info::in, ml_gen_info::out) is det.
+ static_cons::in, prog_context::in, mlds_defns::out, mlds_rval::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_static_const_arg_2(Tag, VarType, Var, StaticCons, Rval, !Info) :-
+ml_gen_static_const_arg_2(Tag, VarType, Var, StaticCons, Context, Defns, Rval, !Info) :-
StaticCons = static_cons(ConsId, ArgVars, StaticArgs),
(
% Types for which some other constructor has a reserved_address
@@ -350,7 +353,7 @@
% this constructor.
Tag = shared_with_reserved_addresses_tag(_, ThisTag),
ml_gen_static_const_arg_2(ThisTag, VarType, Var, StaticCons,
- Rval, !Info)
+ Context, Defns, Rval, !Info)
;
Tag = no_tag,
(
@@ -359,10 +362,14 @@
->
% Construct (statically) the argument, and then convert it
% to the appropriate type.
- ml_gen_static_const_arg(Arg, StaticArg, ArgRval, !Info),
+ ml_gen_static_const_arg(Arg, StaticArg, Context, ArgDefns, ArgRval,
+ !Info),
ml_variable_type(!.Info, Arg, ArgType),
- ml_gen_box_or_unbox_rval(ArgType, VarType, native_if_possible,
- ArgRval, Rval, !Info)
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
+ MLDS_ArgType = mercury_type_to_mlds_type(ModuleInfo, ArgType),
+ ml_gen_box_const_rval(MLDS_ArgType, ArgRval, Context, BoxDefns,
+ Rval, !Info),
+ Defns = ArgDefns ++ BoxDefns
;
unexpected(this_file, "ml_code_gen: no_tag: arity != 1")
)
@@ -389,7 +396,8 @@
;
TaggedRval = mkword(TagVal, ConstAddrRval)
),
- Rval = unop(cast(MLDS_VarType), TaggedRval)
+ Rval = unop(cast(MLDS_VarType), TaggedRval),
+ Defns = []
;
( Tag = string_tag(_)
; Tag = int_tag(_)
@@ -407,7 +415,8 @@
% If this argument is just a constant, then generate the rval
% for the constant.
StaticArgs = [],
- ml_gen_constant(Tag, VarType, Rval, !Info)
+ ml_gen_constant(Tag, VarType, Rval, !Info),
+ Defns = []
;
StaticArgs = [_ | _],
unexpected(this_file,
@@ -639,7 +648,6 @@
(
HowToConstruct = construct_dynamically,
-
% Find out the types of the constructor arguments and generate rvals
% for them (boxing/unboxing if needed).
ml_gen_var_list(!.Info, ArgVars, ArgLvals),
@@ -694,7 +702,8 @@
% Generate rvals for the arguments.
list.map(ml_gen_type(!.Info), ArgTypes, MLDS_ArgTypes0),
- ml_gen_static_const_arg_list(ArgVars, StaticArgs, ArgRvals0, !Info),
+ ml_gen_static_const_arg_list(ArgVars, StaticArgs, Context,
+ StaticArgDefns, ArgRvals0, !Info),
% Box or unbox the arguments, if needed, and insert the extra rvals
% at the start.
@@ -752,7 +761,7 @@
),
Rval = unop(cast(MLDS_Type), TaggedRval),
AssignStatement = ml_gen_assign(VarLval, Rval, Context),
- Decls = BoxConstDefns ++ [ConstDefn],
+ Decls = StaticArgDefns ++ BoxConstDefns ++ [ConstDefn],
Statements = [AssignStatement]
;
HowToConstruct = reuse_cell(CellToReuse),
@@ -1153,16 +1162,20 @@
).
:- pred ml_gen_static_const_arg_list(list(prog_var)::in, list(static_cons)::in,
- list(mlds_rval)::out, ml_gen_info::in, ml_gen_info::out) is det.
+ prog_context::in, mlds_defns::out, list(mlds_rval)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_static_const_arg_list([], [], [], !Info).
+ml_gen_static_const_arg_list([], [], _, [], [], !Info).
ml_gen_static_const_arg_list([Var | Vars], [StaticCons | StaticConses],
- [Rval | Rvals], !Info) :-
- ml_gen_static_const_arg(Var, StaticCons, Rval, !Info),
- ml_gen_static_const_arg_list(Vars, StaticConses, Rvals, !Info).
-ml_gen_static_const_arg_list([_|_], [], _, !Info) :-
+ Context, Defns, [Rval | Rvals], !Info) :-
+ ml_gen_static_const_arg(Var, StaticCons, Context, VarDefns,
+ Rval, !Info),
+ ml_gen_static_const_arg_list(Vars, StaticConses, Context, VarsDefns,
+ Rvals, !Info),
+ Defns = VarDefns ++ VarsDefns.
+ml_gen_static_const_arg_list([_ | _], [], _, _, _, !Info) :-
unexpected(this_file, "ml_gen_static_const_arg_list: length mismatch").
-ml_gen_static_const_arg_list([], [_|_], _, !Info) :-
+ml_gen_static_const_arg_list([], [_ | _], _, _, _, !Info) :-
unexpected(this_file, "ml_gen_static_const_arg_list: length mismatch").
% Generate the name of the local static constant for a given variable.
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.338
diff -u -r1.338 Mmakefile
--- tests/hard_coded/Mmakefile 30 Dec 2007 04:09:25 -0000 1.338
+++ tests/hard_coded/Mmakefile 16 Jan 2008 08:09:33 -0000
@@ -197,6 +197,7 @@
solve_quadratic \
space \
stable_sort \
+ static_no_tag \
stream_format \
stream_ignore_ws \
stream_test \
Index: tests/hard_coded/static_no_tag.exp
===================================================================
RCS file: tests/hard_coded/static_no_tag.exp
diff -N tests/hard_coded/static_no_tag.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/static_no_tag.exp 16 Jan 2008 08:09:33 -0000
@@ -0,0 +1,7 @@
+get_no_tag_floats = [no_tag_float(3.0), no_tag_float(4.0)]
+get_no_tag_ints = [no_tag_int(777), no_tag_int(888)]
+get_no_tag_strings = [no_tag_string("foo"), no_tag_string("bar"), no_tag_string("baz")]
+get_no_tag_chars = [no_tag_char('a'), no_tag_char('b'), no_tag_char('c')]
+get_no_tag_poly_float = [no_tag_poly(5.5), no_tag_poly(6.6), no_tag_poly(7.7)]
+get_float_list = [1.1, 2.2, 3.3, 4.4]
+get_list_float_pair = [float_pair(6.6, 6.6), float_pair(7.7, 7.7)]
Index: tests/hard_coded/static_no_tag.m
===================================================================
RCS file: tests/hard_coded/static_no_tag.m
diff -N tests/hard_coded/static_no_tag.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/static_no_tag.m 16 Jan 2008 08:09:33 -0000
@@ -0,0 +1,87 @@
+% vim: ts=4 et ft=mercury
+%
+% This is a regression test for a problem in rotd-2008-01-15 and before.
+% In those versions of Mercury the MLDS->C code generator was generating
+% invalid C for static ground terms when the terms contained
+% no_tag types whose arguments were floats. The problem was that the code
+% generator was trying to insert calls to MR_box_float() into static
+% initializers rather than emitting a separate global containing the
+% float constant and taking the address of that global. (This problem was
+% independent of whether --high-level-data was enabled or not.)
+% The problem did not occur with the LLDS backend because it handles
+% static ground terms differently.
+%
+% This module also exercises creating static ground terms with other sorts
+% of no_tag type as well.
+%
+:- module static_no_tag.
+:- interface.
+
+:- import_module char.
+:- import_module io.
+:- import_module list.
+
+:- pred main(io::di, io::uo) is det.
+
+:- type no_tag_float ---> no_tag_float(float).
+:- type no_tag_int ---> no_tag_int(int).
+:- type no_tag_string ---> no_tag_string(string).
+:- type no_tag_char ---> no_tag_char(char).
+:- type no_tag_poly(T) ---> no_tag_poly(T).
+
+:- type float_pair ---> float_pair(float, float).
+
+:- func get_no_tag_floats = list(no_tag_float).
+:- func get_no_tag_ints = list(no_tag_int).
+:- func get_no_tag_strings = list(no_tag_string).
+:- func get_no_tag_poly_float = list(no_tag_poly(float)).
+:- func get_float_list = list(float).
+:- func get_list_float_pair = list(float_pair).
+
+:- implementation.
+
+main(!IO) :-
+ io.write_string("get_no_tag_floats = ", !IO),
+ io.write(get_no_tag_floats, !IO),
+ io.nl(!IO),
+ io.write_string("get_no_tag_ints = ", !IO),
+ io.write(get_no_tag_ints, !IO),
+ io.nl(!IO),
+ io.write_string("get_no_tag_strings = ", !IO),
+ io.write(get_no_tag_strings, !IO),
+ io.nl(!IO),
+ io.write_string("get_no_tag_chars = ", !IO),
+ io.write(get_no_tag_chars, !IO),
+ io.nl(!IO),
+ io.write_string("get_no_tag_poly_float = ", !IO),
+ io.write(get_no_tag_poly_float, !IO),
+ io.nl(!IO),
+ io.write_string("get_float_list = ", !IO),
+ io.write(get_float_list, !IO),
+ io.nl(!IO),
+ io.write_string("get_list_float_pair = ", !IO),
+ io.write(get_list_float_pair, !IO),
+ io.nl(!IO).
+
+:- pragma no_inline(get_no_tag_floats/0).
+get_no_tag_floats = [no_tag_float(3.0), no_tag_float(4.0)].
+
+:- pragma no_inline(get_no_tag_ints/0).
+get_no_tag_ints = [no_tag_int(777), no_tag_int(888)].
+
+:- pragma no_inline(get_no_tag_strings/0).
+get_no_tag_strings = [no_tag_string("foo"), no_tag_string("bar"),
+ no_tag_string("baz")].
+
+:- pragma no_inline(get_no_tag_chars/0).
+:- func get_no_tag_chars = list(no_tag_char).
+get_no_tag_chars = [no_tag_char('a'), no_tag_char('b'), no_tag_char('c')].
+
+:- pragma no_inline(get_no_tag_poly_float/0).
+get_no_tag_poly_float = [no_tag_poly(5.5), no_tag_poly(6.6), no_tag_poly(7.7)].
+
+:- pragma no_inline(get_float_list/0).
+get_float_list = [1.1, 2.2, 3.3, 4.4].
+
+:- pragma no_inline(get_list_float_pair/0).
+get_list_float_pair = [float_pair(6.6, 6.6), float_pair(7.7, 7.7)].
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list