[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