[m-rev.] for review: unboxed float ctor args in LLDS grades on 32-bit

Peter Wang novalazy at gmail.com
Thu Sep 1 11:59:09 AEST 2011


On 2011-08-30, Peter Wang <novalazy at gmail.com> wrote:
> Branches: main
> 
> Make it possible to store double-precision `float' constructor arguments in
> unboxed form, in low-level C grades on 32-bit platforms, i.e. `float' (and
> equivalent) arguments may occupy two machine words. However, until we implement
> float registers, this does more harm than good so it remains disabled.

Add these changes to the previous diff.

diff --git a/compiler/disj_gen.m b/compiler/disj_gen.m
index 6b35a53..18244f9 100644
--- a/compiler/disj_gen.m
+++ b/compiler/disj_gen.m
@@ -219,7 +219,8 @@ generate_lookup_disj(ResumeVars, LookupDisjInfo, Code, !CI) :-
 
     BaseRegInitCode = cord.singleton(
         llds_instr(assign(BaseReg,
-            mem_addr(heap_ref(SolnVectorAddrRval, 0, const(llconst_int(0))))),
+            mem_addr(heap_ref(SolnVectorAddrRval, yes(0),
+                const(llconst_int(0))))),
             "Compute base address for this case")
     ),
     SaveSlotCode = cord.singleton(
@@ -281,7 +282,8 @@ generate_lookup_disj(ResumeVars, LookupDisjInfo, Code, !CI) :-
         llds_instr(label(AfterUndoLabel),
             "Return later answer code"),
         llds_instr(assign(LaterBaseReg,
-            mem_addr(heap_ref(SolnVectorAddrRval, 0, lval(LaterBaseReg)))),
+            mem_addr(heap_ref(SolnVectorAddrRval, yes(0),
+                lval(LaterBaseReg)))),
             "Compute base address in later array for this solution")
     ]),
 
diff --git a/compiler/exprn_aux.m b/compiler/exprn_aux.m
index 8871e57..95a4b4e 100644
--- a/compiler/exprn_aux.m
+++ b/compiler/exprn_aux.m
@@ -530,10 +530,10 @@ transform_lval_in_mem_ref(Transform, MemRef0, MemRef, !Acc) :-
         transform_lval_in_rval(Transform, Rval0, Rval, !Acc),
         MemRef = framevar_ref(Rval)
     ;
-        MemRef0 = heap_ref(BaseRval0, Tag, FieldRval0),
+        MemRef0 = heap_ref(BaseRval0, MaybeTag, FieldRval0),
         transform_lval_in_rval(Transform, BaseRval0, BaseRval, !Acc),
         transform_lval_in_rval(Transform, FieldRval0, FieldRval, !Acc),
-        MemRef = heap_ref(BaseRval, Tag, FieldRval)
+        MemRef = heap_ref(BaseRval, MaybeTag, FieldRval)
     ).
 
 %-----------------------------------------------------------------------------%
@@ -658,9 +658,9 @@ substitute_rval_in_mem_ref(OldRval, NewRval, MemRef0, MemRef) :-
         MemRef0 = framevar_ref(N),
         MemRef = framevar_ref(N)
     ;
-        MemRef0 = heap_ref(Rval0, Tag, N),
+        MemRef0 = heap_ref(Rval0, MaybeTag, N),
         substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval),
-        MemRef = heap_ref(Rval, Tag, N)
+        MemRef = heap_ref(Rval, MaybeTag, N)
     ).
 
 :- pred substitute_rval_in_lval(rval::in, rval::in,
@@ -883,7 +883,7 @@ lval_list_addrs([Lval | Lvals], CodeAddrs, DataIds) :-
 
 mem_ref_addrs(stackvar_ref(_SlotNum), [], []).
 mem_ref_addrs(framevar_ref(_SlotNum), [], []).
-mem_ref_addrs(heap_ref(Rval, _Tag, _FieldNum), CodeAddrs, DataIds) :-
+mem_ref_addrs(heap_ref(Rval, _MaybeTag, _FieldNum), CodeAddrs, DataIds) :-
     rval_addrs(Rval, CodeAddrs, DataIds).
 
     % Give a list of maybe(rval), return a list of the code and data
diff --git a/compiler/global_data.m b/compiler/global_data.m
index 6629e3a..7f35030 100644
--- a/compiler/global_data.m
+++ b/compiler/global_data.m
@@ -1317,9 +1317,9 @@ remap_mem_ref(Remap, MemRef0, MemRef) :-
         ),
         MemRef = MemRef0
     ;
-        MemRef0 = heap_ref(Ptr0, Tag, FieldNum),
+        MemRef0 = heap_ref(Ptr0, MaybeTag, FieldNum),
         remap_rval(Remap, Ptr0, Ptr),
-        MemRef = heap_ref(Ptr, Tag, FieldNum)
+        MemRef = heap_ref(Ptr, MaybeTag, FieldNum)
     ).
 
 %-----------------------------------------------------------------------------%
diff --git a/compiler/llds.m b/compiler/llds.m
index f7a4933..ecdccfb 100644
--- a/compiler/llds.m
+++ b/compiler/llds.m
@@ -1125,10 +1125,15 @@
             % stack.
 
 :- type mem_ref
-    --->    stackvar_ref(rval)          % Stack slot number.
-    ;       framevar_ref(rval)          % Stack slot number.
-    ;       heap_ref(rval, int, rval).  % The cell pointer, the tag to
-                                        % subtract, and the field number.
+    --->    stackvar_ref(rval)
+            % Stack slot number.
+
+    ;       framevar_ref(rval)
+            % Stack slot number.
+
+    ;       heap_ref(rval, maybe(int), rval).
+            % The cell pointer, the tag to subtract (if unknown, all the tag
+            % bits must be masked off), and the field number.
 
 :- type c_global_var_ref
     --->    env_var_ref(string).
diff --git a/compiler/llds_out_data.m b/compiler/llds_out_data.m
index c18b5a7..d5a8671 100644
--- a/compiler/llds_out_data.m
+++ b/compiler/llds_out_data.m
@@ -1019,10 +1019,16 @@ output_rval(Info, Rval, !IO) :-
             ),
             io.write_string(")", !IO)
         ;
-            MemRef = heap_ref(BaseRval, Tag, FieldNumRval),
-            io.write_string("&MR_tfield(", !IO),
-            io.write_int(Tag, !IO),
-            io.write_string(", ", !IO),
+            MemRef = heap_ref(BaseRval, MaybeTag, FieldNumRval),
+            (
+                MaybeTag = yes(Tag),
+                io.write_string("&MR_tfield(", !IO),
+                io.write_int(Tag, !IO),
+                io.write_string(", ", !IO)
+            ;
+                MaybeTag = no,
+                io.write_string("&MR_mask_field(", !IO)
+            ),
             output_rval(Info, BaseRval, !IO),
             io.write_string(", ", !IO),
             % Don't clutter the output with unnecessary casts.
@@ -1041,13 +1047,7 @@ consecutive_field_offsets(lval(LvalA), lval(LvalB), MemRef) :-
     (
         LvalA = field(MaybeTag, Address, const(llconst_int(N))),
         LvalB = field(MaybeTag, Address, const(llconst_int(N + 1))),
-        (
-            MaybeTag = yes(Tag)
-        ;
-            MaybeTag = no,
-            Tag = 0
-        ),
-        MemRef = heap_ref(Address, Tag, const(llconst_int(N)))
+        MemRef = heap_ref(Address, MaybeTag, const(llconst_int(N)))
     ;
         LvalA = stackvar(N),
         LvalB = stackvar(N + 1),
diff --git a/compiler/llds_out_instr.m b/compiler/llds_out_instr.m
index 43688cd..220bf53 100644
--- a/compiler/llds_out_instr.m
+++ b/compiler/llds_out_instr.m
@@ -54,6 +54,7 @@
 
 :- implementation.
 
+:- import_module backend_libs.builtin_ops.
 :- import_module backend_libs.c_util.
 :- import_module backend_libs.export.
 :- import_module backend_libs.name_mangle.
@@ -269,6 +270,15 @@ output_instruction_list(Info, [Instr | Instrs], ProfInfo, WhileSet,
                 AfterLayoutLabel, !IO)
         )
     ;
+        Instrs = [Instr1 | Instrs1],
+        Instr1 = llds_instr(Uinstr1, _),
+        is_float_dword_assignment(Uinstr, Uinstr1, Lval, Rval)
+    ->
+        output_float_dword_assignment(Info, Lval, Rval, !IO),
+        AfterLayoutLabel = not_after_layout_label,
+        output_instruction_list(Info, Instrs1, ProfInfo, WhileSet,
+            AfterLayoutLabel, !IO)
+    ;
         output_instruction_and_comment(Info, Uinstr, Comment,
             ProfInfo, !IO),
         ( Uinstr = comment(_) ->
@@ -364,6 +374,39 @@ output_instruction_list_while_block(Info, [Instr | Instrs], Label, ProfInfo,
             ProfInfo, !IO)
     ).
 
+:- pred is_float_dword_assignment(instr::in, instr::in, lval::out, rval::out)
+    is semidet.
+
+is_float_dword_assignment(InstrA, InstrB, LvalA, Rval) :-
+    InstrA = assign(LvalA, RvalA),
+    InstrB = assign(LvalB, RvalB),
+    RvalA = binop(float_word_bits, Rval, const(llconst_int(0))),
+    RvalB = binop(float_word_bits, Rval, const(llconst_int(1))),
+    LvalA = field(MaybeTag, Address, const(llconst_int(Offset))),
+    LvalB = field(MaybeTag, Address, const(llconst_int(Offset + 1))).
+
+:- pred output_float_dword_assignment(llds_out_info::in, lval::in, rval::in,
+    io::di, io::uo) is det.
+
+output_float_dword_assignment(Info, Lval, Rval, !IO) :-
+    % This looks neater than two statements to assign a double precision float,
+    % but makes no real difference to the code generated by gcc. It might
+    % improve the code generated by other C compilers.
+
+    io.write_string("\t* (MR_Float *) &(", !IO),
+    output_lval_for_assign(Info, Lval, Type, !IO),
+    expect(unify(Type, lt_word), $module, $pred, "expected word"),
+    io.write_string(") = ", !IO),
+    output_rval_as_type(Info, Rval, lt_float, !IO),
+    io.write_string(";\n", !IO),
+    AutoComments = Info ^ lout_auto_comments,
+    (
+        AutoComments = yes,
+        io.write_string("\t\t/* assigning float dword */\n", !IO)
+    ;
+        AutoComments = no
+    ).
+
 %----------------------------------------------------------------------------%
 %
 % Output an instruction for debugging.
diff --git a/compiler/llds_to_x86_64.m b/compiler/llds_to_x86_64.m
index 319edc1..dacdcc9 100644
--- a/compiler/llds_to_x86_64.m
+++ b/compiler/llds_to_x86_64.m
@@ -692,7 +692,7 @@ transform_rval(!RegMap, mem_addr(stackvar_ref(Rval)), Op, no) :-
     transform_rval(!RegMap, Rval, Op, _).
 transform_rval(!RegMap, mem_addr(framevar_ref(Rval)), Op, no) :-
     transform_rval(!RegMap, Rval, Op, _).
-transform_rval(!RegMap, mem_addr(heap_ref(Rval1, Tag, Rval2)), no, Instrs) :-
+transform_rval(!RegMap, mem_addr(heap_ref(Rval1, MaybeTag, Rval2)), no, Instrs) :-
     transform_rval(!RegMap, Rval1, Res0, Res1),
     transform_rval(!RegMap, Rval2, Res2, Res3),
     (
@@ -742,7 +742,13 @@ transform_rval(!RegMap, mem_addr(heap_ref(Rval1, Tag, Rval2)), no, Instrs) :-
     MemRef = operand_mem_ref(mem_abs(base_expr(Rval1Str))),
     LoadAddr = x86_64_instr(lea(MemRef, TempReg)),
     Instr0 = x86_64_instr(sub(Rval2Op, TempReg)),
-    Instr1 = x86_64_instr(add(operand_imm(imm32(int32(Tag))), TempReg)),
+    (
+        MaybeTag = yes(Tag),
+        Instr1 = x86_64_instr(add(operand_imm(imm32(int32(Tag))), TempReg))
+    ;
+        MaybeTag = no,
+        sorry($module, $pred, "unknown tag")
+    ),
     Instrs = yes(Instrs0 ++ [LoadAddr] ++ [Instr0] ++ [Instr1]).
 
     % Given an llds-lval, returns either an operand or instructions. (Actually,
diff --git a/compiler/lookup_switch.m b/compiler/lookup_switch.m
index 7d4504c..0a590a7 100644
--- a/compiler/lookup_switch.m
+++ b/compiler/lookup_switch.m
@@ -424,7 +424,7 @@ generate_simple_int_lookup_switch(IndexRval, StoreMap, StartVal, EndVal,
         BaseRegInitCode = singleton(
             llds_instr(
                 assign(BaseReg,
-                    mem_addr(heap_ref(VectorAddrRval, 0, BaseRval))),
+                    mem_addr(heap_ref(VectorAddrRval, yes(0), BaseRval))),
                 "Compute base address for this case")
         ),
         generate_offset_assigns(OutVars, 0, BaseReg, !CI)
@@ -530,7 +530,7 @@ generate_several_soln_int_lookup_switch(IndexRval, EndLabel, StoreMap,
     BaseRegInitCode = singleton(
         llds_instr(
             assign(BaseReg,
-                mem_addr(heap_ref(MainVectorAddrRval, 0,
+                mem_addr(heap_ref(MainVectorAddrRval, yes(0),
                     binop(int_mul,
                         IndexRval,
                         const(llconst_int(MainNumColumns)))))),
@@ -689,7 +689,7 @@ generate_code_for_each_kind([Kind | Kinds], NumPrevColumns,
             llds_instr(label(AfterUndoLabel),
                 "Return later answer code"),
             llds_instr(assign(LaterBaseReg,
-                mem_addr(heap_ref(LaterVectorAddrRval, 0,
+                mem_addr(heap_ref(LaterVectorAddrRval, yes(0),
                     lval(LaterBaseReg)))),
                 "Compute base address in later array for this solution")
         ]),
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index ca89640..8adcd9a 100644
--- a/compiler/make_hlds_passes.m
+++ b/compiler/make_hlds_passes.m
@@ -298,8 +298,10 @@ use_double_word_floats(Globals, DoubleWordFloats) :-
             % Until we implement float registers for low-level C grades,
             % storing double-word floats in structures does more harm than
             % good.
-            globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
-            DoubleWordFloats = HighLevelCode
+            % globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+            % DoubleWordFloats = HighLevelCode
+            % XXX pw -- for testing
+            DoubleWordFloats = yes
         ;
             DoubleWordFloats = no
         )
diff --git a/compiler/opt_debug.m b/compiler/opt_debug.m
index 7e66522..4b6cab0 100644
--- a/compiler/opt_debug.m
+++ b/compiler/opt_debug.m
@@ -355,9 +355,16 @@ dump_mem_ref(MaybeProcLabel, stackvar_ref(N)) =
     "stackvar_ref(" ++ dump_rval(MaybeProcLabel, N) ++ ")".
 dump_mem_ref(MaybeProcLabel, framevar_ref(N)) =
     "framevar_ref(" ++ dump_rval(MaybeProcLabel, N) ++ ")".
-dump_mem_ref(MaybeProcLabel, heap_ref(R, T, N)) =
-    "heap_ref(" ++ dump_rval(MaybeProcLabel, R) ++ ", " ++ int_to_string(T) ++ ", "
-        ++ dump_rval(MaybeProcLabel, N) ++ ")".
+dump_mem_ref(MaybeProcLabel, heap_ref(R, MaybeTag, N)) = String :-
+    (
+        MaybeTag = yes(Tag),
+        TagString = int_to_string(Tag)
+    ;
+        MaybeTag = no,
+        TagString = "unknown_tag"
+    ),
+    String = "heap_ref(" ++ dump_rval(MaybeProcLabel, R) ++ ", " ++ TagString
+        ++ ", " ++ dump_rval(MaybeProcLabel, N) ++ ")".
 
 dump_const(_, llconst_true) = "true".
 dump_const(_, llconst_false) = "false".
diff --git a/compiler/opt_util.m b/compiler/opt_util.m
index c70bb49..b203833 100644
--- a/compiler/opt_util.m
+++ b/compiler/opt_util.m
@@ -1865,7 +1865,7 @@ count_temps_mem_ref(MemRef, !R, !F) :-
         ),
         count_temps_rval(Rval, !R, !F)
     ;
-        MemRef = heap_ref(CellRval, _Tag, FieldNumRval),
+        MemRef = heap_ref(CellRval, _MaybeTag, FieldNumRval),
         count_temps_rval(CellRval, !R, !F),
         count_temps_rval(FieldNumRval, !R, !F)
     ).
@@ -2704,10 +2704,10 @@ replace_labels_mem_ref(MemRef0, MemRef, ReplMap) :-
         ),
         MemRef = MemRef0
     ;
-        MemRef0 = heap_ref(CellRval0, Tag, FieldNumRval0),
+        MemRef0 = heap_ref(CellRval0, MaybeTag, FieldNumRval0),
         replace_labels_rval(CellRval0, CellRval, ReplMap),
         replace_labels_rval(FieldNumRval0, FieldNumRval, ReplMap),
-        MemRef = heap_ref(CellRval, Tag, FieldNumRval)
+        MemRef = heap_ref(CellRval, MaybeTag, FieldNumRval)
     ).
 
 :- pred replace_labels_rval_const(rval_const::in, rval_const::out,
diff --git a/compiler/string_switch.m b/compiler/string_switch.m
index eecb623..869bf2c 100644
--- a/compiler/string_switch.m
+++ b/compiler/string_switch.m
@@ -308,7 +308,7 @@ generate_string_hash_simple_lookup_switch(VarRval, CaseValues,
         RowStartReg = HashSwitchInfo ^ shsi_row_start_reg,
         SetBaseRegCode = singleton(
             llds_instr(assign(BaseReg,
-                mem_addr(heap_ref(VectorAddrRval, 0, lval(RowStartReg)))),
+                mem_addr(heap_ref(VectorAddrRval, yes(0), lval(RowStartReg)))),
                 "set up base reg")
         ),
         generate_offset_assigns(OutVars, NumPrevColumns, BaseReg, !CI)
@@ -464,7 +464,7 @@ generate_string_hash_several_soln_lookup_switch(VarRval, CaseSolns,
     RowStartReg = HashSwitchInfo ^ shsi_row_start_reg,
     SetBaseRegCode = singleton(
         llds_instr(assign(BaseReg,
-            mem_addr(heap_ref(MainVectorAddrRval, 0, lval(RowStartReg)))),
+            mem_addr(heap_ref(MainVectorAddrRval, yes(0), lval(RowStartReg)))),
             "set up base reg")
     ),
     generate_code_for_all_kinds(DescendingSortedKinds, NumPrevColumns,
@@ -837,7 +837,7 @@ generate_string_binary_simple_lookup_switch(VarRval, CaseValues,
             llds_instr(
                 assign(BaseReg,
                     mem_addr(
-                        heap_ref(VectorAddrRval, 0,
+                        heap_ref(VectorAddrRval, yes(0),
                             binop(int_mul,
                                 lval(MidReg),
                                 const(llconst_int(NumColumns)))))),
@@ -961,7 +961,7 @@ generate_string_binary_several_soln_lookup_switch(VarRval, CaseSolns,
         llds_instr(
             assign(BaseReg,
                 mem_addr(
-                    heap_ref(MainVectorAddrRval, 0,
+                    heap_ref(MainVectorAddrRval, yes(0),
                         binop(int_mul,
                             lval(MidReg),
                             const(llconst_int(MainNumColumns)))))),
diff --git a/compiler/unify_gen.m b/compiler/unify_gen.m
index cbf371a..820b342 100644
--- a/compiler/unify_gen.m
+++ b/compiler/unify_gen.m
@@ -1151,7 +1151,7 @@ generate_field_take_address_assigns([FieldAddr | FieldAddrs],
         CellVar, CellPtag, ThisCode ++ RestCode, !CI) :-
     FieldAddr = field_addr(FieldNum, Var),
     FieldNumRval = const(llconst_int(FieldNum)),
-    Addr = mem_addr(heap_ref(var(CellVar), CellPtag, FieldNumRval)),
+    Addr = mem_addr(heap_ref(var(CellVar), yes(CellPtag), FieldNumRval)),
     assign_expr_to_var(Var, Addr, ThisCode, !CI),
     generate_field_take_address_assigns(FieldAddrs, CellVar, CellPtag,
         RestCode, !CI).
diff --git a/compiler/var_locn.m b/compiler/var_locn.m
index 9fab8cb..ef60c49 100644
--- a/compiler/var_locn.m
+++ b/compiler/var_locn.m
@@ -2366,13 +2366,13 @@ var_locn_materialize_vars_in_mem_ref_avoid(ModuleInfo, MemRef0, MemRef, Avoid,
         MemRef = MemRef0,
         Code = empty
     ;
-        MemRef0 = heap_ref(PtrRval0, Ptag, FieldNumRval0),
+        MemRef0 = heap_ref(PtrRval0, MaybeTag, FieldNumRval0),
         var_locn_materialize_vars_in_rval_avoid(ModuleInfo, PtrRval0, no,
             Avoid, PtrRval, PtrCode, !VLI),
         var_locn_materialize_vars_in_rval_avoid(ModuleInfo, FieldNumRval0, no,
             Avoid, FieldNumRval, FieldNumCode, !VLI),
         Code = PtrCode ++ FieldNumCode,
-        MemRef = heap_ref(PtrRval, Ptag, FieldNumRval)
+        MemRef = heap_ref(PtrRval, MaybeTag, FieldNumRval)
     ).
 
 :- type var_avail
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 9d878eb..05af31d 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -127,6 +127,7 @@ ORDINARY_PROGS=	\
 	hash_bug \
 	hash_init_bug \
 	hash_table_delete \
+	heap_ref_mask_tag \
 	higher_order_func_test \
 	higher_order_syntax \
 	higher_order_syntax2 \
diff --git a/tests/hard_coded/heap_ref_mask_tag.exp b/tests/hard_coded/heap_ref_mask_tag.exp
new file mode 100644
index 0000000..d3827e7
--- /dev/null
+++ b/tests/hard_coded/heap_ref_mask_tag.exp
@@ -0,0 +1 @@
+1.0
diff --git a/tests/hard_coded/heap_ref_mask_tag.m b/tests/hard_coded/heap_ref_mask_tag.m
new file mode 100644
index 0000000..17afdbd
--- /dev/null
+++ b/tests/hard_coded/heap_ref_mask_tag.m
@@ -0,0 +1,44 @@
+%-----------------------------------------------------------------------------%
+
+:- module heap_ref_mask_tag.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+
+:- type length
+    --->    points(float)
+    ;       font_em(float)
+    ;       font_ex(float)
+    ;       pixels(float).
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    X = pixels(1.0),
+    F = magnitude(X),
+    write_float(F, !IO),
+    io.nl(!IO).
+
+:- func magnitude(length) = float.
+:- pragma no_inline(magnitude/1).
+
+% dupelim.m will combine the following cases, which differ only in the tag to
+% remove, into a single code sequence. We must be careful to mask off the tag
+% bits in the combined code sequence.
+
+magnitude(points(M)) = M.
+magnitude(font_em(M)) = M.
+magnitude(font_ex(M)) = M.
+magnitude(pixels(M)) = M.
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
--------------------------------------------------------------------------
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