[m-rev.] for review: unboxed float ctor args in LLDS grades on 32-bit
Peter Wang
novalazy at gmail.com
Tue Aug 30 16:00:29 AEST 2011
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.
compiler/llds.m:
Add a type `cell_arg' to hold information about an argument of a cell
being constructed.
compiler/unify_gen.m:
Use the `cell_arg' type to simplify code related to generating
constructions.
Handle double word arguments in constructions and deconstructions.
Update enumeration packing code to account for the presence of double
width arguments and the `cell_arg' type.
Take double width arguments into account when generating ground terms.
compiler/code_info.m:
Extend `assign_field_lval_expr_to_var' to work for expressions
involving multiple field lvals of the same variable.
Make `assign_cell_to_var' conform to changes.
compiler/code_util.m:
Add a predicate to calculate the size of a cell given its cell_args.
compiler/var_locn.m:
Conform to the use of the `cell_arg' type and the presense of double
width arguments.
Calculate cell size correctly in places.
Move sanity checking from `var_locn_assign_field_lval_expr_to_var'
to `code_info.assign_field_lval_expr_to_var'.
compiler/global_data.m:
Make `rval_type_as_arg' take into account the width of the argument.
Conform to changes.
compiler/c_util.m:
Add a new binop category. Unlike the existing macro_binop category,
the arguments of macros in this category cannot all be assumed to be
of integral types.
compiler/llds_out_data.m:
Output calls to the macros `MR_float_word_bits', `MR_float_from_dword'
and `MR_float_from_dword_ptr' which were introduced previously.
compiler/lco.m:
Disable the optimisation when float arguments are present, on the basis
of whether Mercury floats are wider than a machine word. The comments
about when floats are stored in boxed form are out of date.
compiler/arg_pack.m:
Rename a predicate.
compiler/make_hlds_passes.m:
Update a comment.
compiler/mlds_to_c.m:
compiler/stack_layout.m:
Conform to changes.
runtime/mercury_float.h:
Add a cast to `MR_float_word_bits' to avoid a gcc error.
tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/reuse_double.exp:
tests/hard_coded/reuse_double.m:
Add test case.
tests/hard_coded/lookup_disj.exp:
tests/hard_coded/lookup_disj.m:
Extend existing test case.
diff --git a/compiler/arg_pack.m b/compiler/arg_pack.m
index a84449c..2deb341 100644
--- a/compiler/arg_pack.m
+++ b/compiler/arg_pack.m
@@ -42,10 +42,11 @@
%
:- func count_distinct_words(list(arg_width)) = int.
- % Chunk a list of elements into sub-lists according to the word boundaries
- % implied by the list of argument widths.
+ % Group elements into sub-lists according to the word boundaries implied by
+ % the list of argument widths. That is, elements which make up part of the
+ % same word (or double word) are grouped together in a sub-list.
%
-:- pred chunk_list_by_words(list(arg_width)::in, list(T)::in,
+:- pred group_same_word_elements(list(arg_width)::in, list(T)::in,
list(list(T))::out) is det.
%-----------------------------------------------------------------------------%
@@ -131,28 +132,26 @@ count_distinct_words([H | T]) = Words :-
%-----------------------------------------------------------------------------%
-chunk_list_by_words([], [], []).
-chunk_list_by_words([W | Ws], [X | Xs], Xss) :-
+group_same_word_elements([], [], []).
+group_same_word_elements([W | Ws], [X | Xs], Xss) :-
(
- W = full_word,
- chunk_list_by_words(Ws, Xs, Xss0),
+ ( W = full_word
+ ; W = double_word
+ ),
+ group_same_word_elements(Ws, Xs, Xss0),
Xss = [[X] | Xss0]
;
- W = double_word,
- % Not yet supported in LLDS grades.
- sorry($module, $pred, "double_word")
- ;
W = partial_word_first(_),
split_at_next_word(Ws, WsTail, Xs, XsHead, XsTail),
- chunk_list_by_words(WsTail, XsTail, Xss0),
+ group_same_word_elements(WsTail, XsTail, Xss0),
Xss = [[X | XsHead] | Xss0]
;
W = partial_word_shifted(_, _),
unexpected($module, $pred, "partial_word_shifted")
).
-chunk_list_by_words([], [_ | _], _) :-
+group_same_word_elements([], [_ | _], _) :-
unexpected($module, $pred, "mismatched lists").
-chunk_list_by_words([_ | _], [], []) :-
+group_same_word_elements([_ | _], [], []) :-
unexpected($module, $pred, "mismatched lists").
:- pred split_at_next_word(list(arg_width)::in, list(arg_width)::out,
diff --git a/compiler/c_util.m b/compiler/c_util.m
index fa6b739..a8d2bb8 100644
--- a/compiler/c_util.m
+++ b/compiler/c_util.m
@@ -148,7 +148,8 @@
; float_compare_binop
; float_arith_binop
; int_or_bool_binary_infix_binop
- ; macro_binop.
+ ; macro_binop
+ ; float_macro_binop.
:- pred binop_category_string(binary_op::in, binop_category::out, string::out)
is det.
@@ -588,8 +589,11 @@ binop_category_string(int_ge, int_or_bool_binary_infix_binop, ">=").
binop_category_string(str_cmp, macro_binop, "MR_strcmp").
binop_category_string(body, macro_binop, "MR_body").
-binop_category_string(float_word_bits, macro_binop, "MR_float_word_bits").
-binop_category_string(float_from_dword, macro_binop, "MR_float_from_dword").
+
+binop_category_string(float_word_bits, float_macro_binop,
+ "MR_float_word_bits").
+binop_category_string(float_from_dword, float_macro_binop,
+ "MR_float_from_dword").
%-----------------------------------------------------------------------------%
diff --git a/compiler/code_info.m b/compiler/code_info.m
index c68a72b..f1129e4 100644
--- a/compiler/code_info.m
+++ b/compiler/code_info.m
@@ -3713,7 +3713,7 @@ should_add_region_ops(CodeInfo, _GoalInfo) = AddRegionOps :-
:- pred assign_expr_to_var(prog_var::in, rval::in, llds_code::out,
code_info::in, code_info::out) is det.
-:- pred assign_field_lval_expr_to_var(prog_var::in, lval::in, rval::in,
+:- pred assign_field_lval_expr_to_var(prog_var::in, list(lval)::in, rval::in,
llds_code::out, code_info::in, code_info::out) is det.
% assign_cell_to_var(Var, ReserveWordAtStart, Ptag, MaybeRvals,
@@ -3721,9 +3721,8 @@ should_add_region_ops(CodeInfo, _GoalInfo) = AddRegionOps :-
% Code, !CI).
%
:- pred assign_cell_to_var(prog_var::in, bool::in, tag::in,
- list(maybe(rval))::in, bool::in, how_to_construct::in,
- maybe(term_size_value)::in,
- list(int)::in, maybe(alloc_site_id)::in, may_use_atomic_alloc::in,
+ list(cell_arg)::in, how_to_construct::in, maybe(term_size_value)::in,
+ maybe(alloc_site_id)::in, may_use_atomic_alloc::in,
llds_code::out, code_info::in, code_info::out) is det.
:- pred save_reused_cell_fields(prog_var::in, lval::in, llds_code::out,
@@ -3866,29 +3865,46 @@ assign_expr_to_var(Var, Rval, Code, !CI) :-
),
set_var_locn_info(VarLocnInfo, !CI).
-assign_field_lval_expr_to_var(Var, FieldLval, Rval, Code, !CI) :-
- get_var_locn_info(!.CI, VarLocnInfo0),
- Lvals = lvals_in_rval(Rval),
- ( Lvals = [FieldLval] ->
- var_locn_assign_field_lval_expr_to_var(Var, FieldLval, Rval, Code,
- VarLocnInfo0, VarLocnInfo)
+assign_field_lval_expr_to_var(Var, FieldLvals, Rval, Code, !CI) :-
+ (
+ FieldLvals = [field(MaybeTag, var(BaseVar), _) | RestFieldLvals],
+ list.all_true(is_var_field(MaybeTag, BaseVar), RestFieldLvals)
+ ->
+ (
+ Lvals = lvals_in_rval(Rval),
+ all [Lval] (
+ list.member(Lval, Lvals)
+ =>
+ list.member(Lval, FieldLvals)
+ )
+ ->
+ get_var_locn_info(!.CI, VarLocnInfo0),
+ var_locn_assign_field_lval_expr_to_var(Var, BaseVar, Rval, Code,
+ VarLocnInfo0, VarLocnInfo),
+ set_var_locn_info(VarLocnInfo, !CI)
+ ;
+ unexpected($module, $pred, "rval contains unexpected lval")
+ )
;
- unexpected($module, $pred, "rval contains unexpected lval")
- ),
- set_var_locn_info(VarLocnInfo, !CI).
+ unexpected($module, $pred,
+ "FieldLvals not all fields of the same base variable")
+ ).
-assign_cell_to_var(Var, ReserveWordAtStart, Ptag, MaybeRvals, AllFilled,
- HowToConstruct, MaybeSize, FieldAddrs, MaybeAllocId, MayUseAtomic,
- Code, !CI) :-
+:- pred is_var_field(maybe(tag)::in, prog_var::in, lval::in) is semidet.
+
+is_var_field(MaybeTag, Var, field(MaybeTag, var(Var), _)).
+
+assign_cell_to_var(Var, ReserveWordAtStart, Ptag, CellArgs, HowToConstruct,
+ MaybeSize, MaybeAllocId, MayUseAtomic, Code, !CI) :-
get_next_label(Label, !CI),
get_var_locn_info(!.CI, VarLocnInfo0),
get_static_cell_info(!.CI, StaticCellInfo0),
get_module_info(!.CI, ModuleInfo),
get_exprn_opts(!.CI, ExprnOpts),
var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var, ReserveWordAtStart,
- Ptag, MaybeRvals, AllFilled, HowToConstruct, MaybeSize, FieldAddrs,
- MaybeAllocId, MayUseAtomic, Label, Code,
- StaticCellInfo0, StaticCellInfo, VarLocnInfo0, VarLocnInfo),
+ Ptag, CellArgs, HowToConstruct, MaybeSize, MaybeAllocId, MayUseAtomic,
+ Label, Code, StaticCellInfo0, StaticCellInfo,
+ VarLocnInfo0, VarLocnInfo),
set_static_cell_info(StaticCellInfo, !CI),
set_var_locn_info(VarLocnInfo, !CI).
diff --git a/compiler/code_util.m b/compiler/code_util.m
index 47508cd..85bb4d7 100644
--- a/compiler/code_util.m
+++ b/compiler/code_util.m
@@ -87,6 +87,8 @@
:- pred build_input_arg_list(proc_info::in, assoc_list(prog_var, lval)::out)
is det.
+:- func size_of_cell_args(list(cell_arg)) = int.
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -413,5 +415,21 @@ build_input_arg_list_2([V - Arg | Rest0], VarArgs) :-
build_input_arg_list_2(Rest0, VarArgs0).
%-----------------------------------------------------------------------------%
+
+size_of_cell_args([]) = 0.
+size_of_cell_args([CellArg | CellArgs]) = Size + Sizes :-
+ (
+ ( CellArg = cell_arg_full_word(_, _)
+ ; CellArg = cell_arg_take_addr(_, _)
+ ; CellArg = cell_arg_skip
+ ),
+ Size = 1
+ ;
+ CellArg = cell_arg_double_word(_),
+ Size = 2
+ ),
+ Sizes = size_of_cell_args(CellArgs).
+
+%-----------------------------------------------------------------------------%
:- end_module ll_backend.code_util.
%-----------------------------------------------------------------------------%
diff --git a/compiler/global_data.m b/compiler/global_data.m
index 2b1ebbb..6629e3a 100644
--- a/compiler/global_data.m
+++ b/compiler/global_data.m
@@ -111,13 +111,13 @@
list(scalar_common_data_array)::out, list(vector_common_data_array)::out)
is det.
- % Given an rval, and the value of the --unboxed_float option, figure out
- % the type the rval would have as an argument. Normally that's the same
- % as its usual type; the exception is that for boxed floats, the type
- % is data_ptr (i.e. the type of the boxed value) rather than float
- % (the type of the unboxed value).
+ % Given an rval, the value of the --unboxed_float option and the width of
+ % the constructor argument, figure out the type the rval would have as an
+ % argument. Normally that's the same as its usual type; the exception is
+ % that for boxed floats, the type is data_ptr (i.e. the type of the boxed
+ % value) rather than float (the type of the unboxed value).
%
-:- func rval_type_as_arg(have_unboxed_floats, rval) = llds_type.
+:- func rval_type_as_arg(have_unboxed_floats, arg_width, rval) = llds_type.
%-----------------------------------------------------------------------------%
@@ -362,8 +362,9 @@ init_static_cell_info(BaseName, UnboxFloat, CommonData) = Info0 :-
%-----------------------------------------------------------------------------%
add_scalar_static_cell_natural_types(Args, DataId, !Info) :-
- list.map(associate_natural_type(!.Info ^ sci_sub_info ^ scsi_unbox_float),
- Args, ArgsTypes),
+ UnboxFloat = !.Info ^ sci_sub_info ^ scsi_unbox_float,
+ ArgWidth = full_word,
+ list.map(associate_natural_type(UnboxFloat, ArgWidth), Args, ArgsTypes),
add_scalar_static_cell(ArgsTypes, DataId, !Info).
add_scalar_static_cell(ArgsTypes0, DataId, !Info) :-
@@ -449,7 +450,8 @@ search_scalar_static_cell_offset(Info, DataId, Offset, Rval) :-
%-----------------------------------------------------------------------------%
find_general_llds_types(UnboxFloat, Types, [Vector | Vectors], LLDSTypes) :-
- list.map(natural_type(UnboxFloat), Vector, LLDSTypes0),
+ ArgWidth = full_word,
+ list.map(natural_type(UnboxFloat, ArgWidth), Vector, LLDSTypes0),
find_general_llds_types_2(UnboxFloat, Types, Vectors,
LLDSTypes0, LLDSTypes).
@@ -469,7 +471,8 @@ find_general_llds_types_2(UnboxFloat, Types, [Vector | Vectors], !LLDSTypes) :-
find_general_llds_types_in_cell(_UnboxFloat, [], [], [], []).
find_general_llds_types_in_cell(UnboxFloat, [_Type | Types], [Rval | Rvals],
[LLDSType0 | LLDSTypes0], [LLDSType | LLDSTypes]) :-
- natural_type(UnboxFloat, Rval, NaturalType),
+ ArgWidth = full_word,
+ natural_type(UnboxFloat, ArgWidth, Rval, NaturalType),
% For user-defined types, some function symbols may be constants
% (whose representations yield integer rvals) while others may be
% non-constants (whose representations yield data_ptr rvals).
@@ -662,27 +665,29 @@ make_arg_groups(Type, RevArgs, TypeGroup, TypeAndArgGroup) :-
%-----------------------------------------------------------------------------%
-rval_type_as_arg(UnboxedFloat, Rval) = Type :-
- natural_type(UnboxedFloat, Rval, Type).
+rval_type_as_arg(UnboxedFloat, ArgWidth, Rval) = Type :-
+ natural_type(UnboxedFloat, ArgWidth, Rval, Type).
-:- pred natural_type(have_unboxed_floats::in, rval::in, llds_type::out) is det.
+:- pred natural_type(have_unboxed_floats::in, arg_width::in, rval::in,
+ llds_type::out) is det.
-natural_type(UnboxFloat, Rval, Type) :-
+natural_type(UnboxFloat, ArgWidth, Rval, Type) :-
llds.rval_type(Rval, Type0),
(
Type0 = lt_float,
- UnboxFloat = do_not_have_unboxed_floats
+ UnboxFloat = do_not_have_unboxed_floats,
+ ArgWidth \= double_word
->
Type = lt_data_ptr
;
Type = Type0
).
-:- pred associate_natural_type(have_unboxed_floats::in, rval::in,
- pair(rval, llds_type)::out) is det.
+:- pred associate_natural_type(have_unboxed_floats::in, arg_width::in,
+ rval::in, pair(rval, llds_type)::out) is det.
-associate_natural_type(UnboxFloat, Rval, Rval - Type) :-
- natural_type(UnboxFloat, Rval, Type).
+associate_natural_type(UnboxFloat, ArgWidth, Rval, Rval - Type) :-
+ natural_type(UnboxFloat, ArgWidth, Rval, Type).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
diff --git a/compiler/lco.m b/compiler/lco.m
index 7e35f66..e10c9bf 100644
--- a/compiler/lco.m
+++ b/compiler/lco.m
@@ -410,28 +410,16 @@ lco_proc(LowerSCCVariants, SCC, CurProc, !ModuleInfo, !CurSCCVariants,
CurProc, PredInfo, ProcInfo0, OutputHeadVars, CurProcDetism,
HighLevelData),
module_info_get_globals(!.ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, highlevel_code,
- HighLevelCode),
+ globals.lookup_bool_option(Globals, unboxed_float, UnboxedFloat),
(
- HighLevelCode = yes,
- % At the moment, the hlc backend boxes floats when they appear
- % as arguments in structures (even on 64 bit platforms), but
- % NOT when it passes them as stand-alone arguments. When this
- % pass transforms the HLDS, if the to-be-filled-in-later slot
- % contains a Mercury float, the code generated by the hlc
- % backend (and probably the other MLDS backeds) will take
- % the address of a boxed float, and casts it to be a pointer
- % to an unboxed float. The callee then fills in the pointed-to
- % location with a float, the caller interprets this as a
- % boxed float i.e. a pointer to a float, and you get a
- % core dump.
+ UnboxedFloat = no,
+ % In both C backends, we can and do store doubles across two
+ % words of a cell when sizeof(double) > sizeof(void *).
+ % However we are not yet ready to take the address of
+ % double-word fields nor to assign to them.
AllowFloatAddr = do_not_allow_float_addr
;
- HighLevelCode = no,
- % The low level backend does not suffer from the problem:
- % if sizeof(double) == sizeof(void *), it uses unboxed
- % floats in both places (structures and arguments); if they are
- % of different sizes, it uses boxed floats in both places.
+ UnboxedFloat = yes,
AllowFloatAddr = allow_float_addr
),
Info0 = lco_info(!.ModuleInfo, !.CurSCCVariants,
diff --git a/compiler/llds.m b/compiler/llds.m
index 0c8afa6..f7a4933 100644
--- a/compiler/llds.m
+++ b/compiler/llds.m
@@ -1335,6 +1335,29 @@
% i.e., something whose size is a word but which may be either
% signed or unsigned (used for registers, stack slots, etc).
+:- type cell_arg
+ ---> cell_arg_full_word(rval, completeness)
+ % Fill a single word field of a cell with the given rval, which
+ % could hold a single constructor argument, or multiple constructor
+ % arguments if they are packed. If the second argument is
+ % `incomplete' it means that the rval covers multiple constructor
+ % arguments but some of the arguments are not instantiated.
+
+ ; cell_arg_double_word(rval)
+ % Fill two words of a cell with the given rval, which must be a
+ % double precision float.
+
+ ; cell_arg_skip
+ % Leave a single word of a cell unfilled.
+
+ ; cell_arg_take_addr(prog_var, maybe(rval)).
+ % Take the address of a field. If the second argument is
+ % `yes(Rval)' then the field is set to Rval beforehand.
+
+:- type completeness
+ ---> complete
+ ; incomplete.
+
:- func region_stack_id_to_string(region_stack_id) = string.
:- pred break_up_local_label(label::in, proc_label::out, int::out) is det.
diff --git a/compiler/llds_out_data.m b/compiler/llds_out_data.m
index cdfff5e..c18b5a7 100644
--- a/compiler/llds_out_data.m
+++ b/compiler/llds_out_data.m
@@ -916,6 +916,27 @@ output_rval(Info, Rval, !IO) :-
io.write_string(", ", !IO),
output_rval_as_type(Info, SubRvalB, lt_integer, !IO),
io.write_string(")", !IO)
+ ;
+ Category = float_macro_binop,
+ (
+ Op = float_word_bits
+ ->
+ io.write_string(OpStr, !IO),
+ io.write_string("(", !IO),
+ output_rval_as_type(Info, SubRvalA, lt_float, !IO),
+ io.write_string(", ", !IO),
+ output_rval_as_type(Info, SubRvalB, lt_integer, !IO),
+ io.write_string(")", !IO)
+ ;
+ Op = float_from_dword,
+ consecutive_field_offsets(SubRvalA, SubRvalB, MemRef)
+ ->
+ io.write_string("MR_float_from_dword_ptr(", !IO),
+ output_rval(Info, mem_addr(MemRef), !IO),
+ io.write_string(")", !IO)
+ ;
+ sorry($module, $pred, "unknown float_macro_binop")
+ )
)
;
Rval = mkword(Tag, SubRval),
@@ -1014,6 +1035,29 @@ output_rval(Info, Rval, !IO) :-
)
).
+:- pred consecutive_field_offsets(rval::in, rval::in, mem_ref::out) is semidet.
+
+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)))
+ ;
+ LvalA = stackvar(N),
+ LvalB = stackvar(N + 1),
+ MemRef = stackvar_ref(const(llconst_int(N)))
+ ;
+ LvalA = framevar(N),
+ LvalB = framevar(N + 1),
+ MemRef = framevar_ref(const(llconst_int(N)))
+ ).
+
:- pred output_rval_const(llds_out_info::in, rval_const::in,
io::di, io::uo) is det.
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index 8f03247..ca89640 100644
--- a/compiler/make_hlds_passes.m
+++ b/compiler/make_hlds_passes.m
@@ -295,7 +295,9 @@ use_double_word_floats(Globals, DoubleWordFloats) :-
TargetWordBits = 32,
SinglePrecFloat = no
->
- % Double-word floats are not yet supported in low-level C grades.
+ % 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
;
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index 01e31ba..f1f104e 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -4502,7 +4502,9 @@ mlds_output_binop(Opts, Op, X, Y, !IO) :-
mlds_output_rval_as_op_arg(Opts, Y, !IO),
io.write_string(")", !IO)
;
- Category = macro_binop,
+ ( Category = macro_binop
+ ; Category = float_macro_binop
+ ),
(
Op = float_from_dword,
consecutive_field_offsets(X, Y)
diff --git a/compiler/stack_layout.m b/compiler/stack_layout.m
index ffed04f..416a939 100644
--- a/compiler/stack_layout.m
+++ b/compiler/stack_layout.m
@@ -2129,7 +2129,8 @@ represent_locn_or_const_as_int_rval(Params, LvalOrConst, Rval, Type,
;
LvalOrConst = const(_Const),
UnboxedFloats = Params ^ slp_unboxed_floats,
- LLDSType = rval_type_as_arg(UnboxedFloats, LvalOrConst),
+ ArgWidth = full_word,
+ LLDSType = rval_type_as_arg(UnboxedFloats, ArgWidth, LvalOrConst),
add_scalar_static_cell([LvalOrConst - LLDSType], DataId,
!StaticCellInfo),
Rval = const(llconst_data_addr(DataId, no)),
diff --git a/compiler/unify_gen.m b/compiler/unify_gen.m
index 63088dc..cbf371a 100644
--- a/compiler/unify_gen.m
+++ b/compiler/unify_gen.m
@@ -64,6 +64,7 @@
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_code_util.
+:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_goal.
@@ -101,20 +102,15 @@
:- type uni_val
---> ref(prog_var)
; lval(lval, arg_width).
- % The argument may only occupy part of a word.
+ % The argument may occupy a word, two words, or only part of a
+ % word.
- % The phantom type prevents us from mixing field_addrs which are computed
- % with and without consideration for argument packing.
- %
-:- type field_addr(T)
+:- type field_addr
---> field_addr(
- fa_num :: int,
- fa_var :: prog_var
+ fa_offset :: int,
+ fa_var :: prog_var
).
-:- type unpacked ---> unpacked.
-:- type packed ---> packed.
-
%---------------------------------------------------------------------------%
generate_unification(CodeModel, Uni, GoalInfo, Code, !CI) :-
@@ -562,16 +558,13 @@ generate_construction_2(ConsTag, Var, Args, Modes, ArgWidths, HowToConstruct0,
ConsTag = unshared_tag(Ptag)
),
var_types(!.CI, Args, ArgTypes),
- FirstOffset = 0,
- generate_cons_args(Args, ArgTypes, Modes, FirstOffset, TakeAddr, !.CI,
- MaybeRvals0, FieldAddrs0, MayUseAtomic),
- pack_cell_rvals(ArgWidths, MaybeRvals0, MaybeRvals, AllFilled,
- PackCode, !CI),
- pack_field_addrs(ArgWidths, FieldAddrs0, FieldAddrs),
+ generate_cons_args(Args, ArgTypes, Modes, ArgWidths, TakeAddr, !.CI,
+ CellArgs0, MayUseAtomic),
+ pack_cell_rvals(ArgWidths, CellArgs0, CellArgs, PackCode, !CI),
pack_how_to_construct(ArgWidths, HowToConstruct0, HowToConstruct),
Context = goal_info_get_context(GoalInfo),
- construct_cell(Var, Ptag, MaybeRvals, AllFilled, HowToConstruct,
- MaybeSize, FieldAddrs, Context, MayUseAtomic, ConstructCode, !CI),
+ construct_cell(Var, Ptag, CellArgs, HowToConstruct, MaybeSize, Context,
+ MayUseAtomic, ConstructCode, !CI),
Code = PackCode ++ ConstructCode
;
ConsTag = direct_arg_tag(Ptag),
@@ -594,18 +587,15 @@ generate_construction_2(ConsTag, Var, Args, Modes, ArgWidths, HowToConstruct0,
;
ConsTag = shared_remote_tag(Ptag, Sectag),
var_types(!.CI, Args, ArgTypes),
- % The first field holds the secondary tag.
- FirstOffset = 1,
- generate_cons_args(Args, ArgTypes, Modes, FirstOffset, TakeAddr, !.CI,
- MaybeRvals0, FieldAddrs0, MayUseAtomic),
- pack_cell_rvals(ArgWidths, MaybeRvals0, MaybeRvals1, AllFilled,
- PackCode, !CI),
- pack_field_addrs(ArgWidths, FieldAddrs0, FieldAddrs),
+ generate_cons_args(Args, ArgTypes, Modes, ArgWidths, TakeAddr, !.CI,
+ CellArgs0, MayUseAtomic),
+ pack_cell_rvals(ArgWidths, CellArgs0, CellArgs1, PackCode, !CI),
pack_how_to_construct(ArgWidths, HowToConstruct0, HowToConstruct),
- MaybeRvals = [yes(const(llconst_int(Sectag))) | MaybeRvals1],
+ CellArgs = [cell_arg_full_word(const(llconst_int(Sectag)), complete)
+ | CellArgs1],
Context = goal_info_get_context(GoalInfo),
- construct_cell(Var, Ptag, MaybeRvals, AllFilled, HowToConstruct,
- MaybeSize, FieldAddrs, Context, MayUseAtomic, ConstructCode, !CI),
+ construct_cell(Var, Ptag, CellArgs, HowToConstruct, MaybeSize, Context,
+ MayUseAtomic, ConstructCode, !CI),
Code = PackCode ++ ConstructCode
;
ConsTag = shared_local_tag(Ptag, Sectag),
@@ -865,20 +855,19 @@ generate_closure(PredId, ProcId, EvalMethod, Var, Args, GoalInfo, Code, !CI) :-
generate_pred_args(!.CI, VarTypes, Args, ArgInfo, PredArgs,
MayUseAtomic0, MayUseAtomic),
Vector = [
- yes(ClosureLayoutRval),
- yes(CodeAddrRval),
- yes(const(llconst_int(NumArgs)))
+ cell_arg_full_word(ClosureLayoutRval, complete),
+ cell_arg_full_word(CodeAddrRval, complete),
+ cell_arg_full_word(const(llconst_int(NumArgs)), complete)
| PredArgs
],
- AllFilled = yes,
% XXX construct_dynamically is just a dummy value. We just want
% something which is not construct_in_region(_).
HowToConstruct = construct_dynamically,
MaybeSize = no,
maybe_add_alloc_site_info(Context, "closure", length(Vector),
MaybeAllocId, !CI),
- assign_cell_to_var(Var, no, 0, Vector, AllFilled, HowToConstruct,
- MaybeSize, [], MaybeAllocId, MayUseAtomic, Code, !CI)
+ assign_cell_to_var(Var, no, 0, Vector, HowToConstruct,
+ MaybeSize, MaybeAllocId, MayUseAtomic, Code, !CI)
).
:- pred generate_extra_closure_args(list(prog_var)::in, lval::in,
@@ -913,14 +902,14 @@ generate_extra_closure_args([Var | Vars], LoopCounter, NewClosure, Code,
Code = ProduceCode ++ AssignCode ++ IncrCode ++ VarsCode.
:- pred generate_pred_args(code_info::in, vartypes::in, list(prog_var)::in,
- list(arg_info)::in, list(maybe(rval))::out,
+ list(arg_info)::in, list(cell_arg)::out,
may_use_atomic_alloc::in, may_use_atomic_alloc::out) is det.
generate_pred_args(_, _, [], _, [], !MayUseAtomic).
generate_pred_args(_, _, [_ | _], [], _, !MayUseAtomic) :-
unexpected($module, $pred, "insufficient args").
generate_pred_args(CI, VarTypes, [Var | Vars], [ArgInfo | ArgInfos],
- [MaybeRval | MaybeRvals], !MayUseAtomic) :-
+ [CellArg | CellArgs], !MayUseAtomic) :-
ArgInfo = arg_info(_, ArgMode),
(
ArgMode = top_in,
@@ -932,32 +921,31 @@ generate_pred_args(CI, VarTypes, [Var | Vars], [ArgInfo | ArgInfos],
IsDummy = is_not_dummy_type,
Rval = var(Var)
),
- MaybeRval = yes(Rval)
+ CellArg = cell_arg_full_word(Rval, complete)
;
( ArgMode = top_out
; ArgMode = top_unused
),
- MaybeRval = no
+ CellArg = cell_arg_skip
),
map.lookup(VarTypes, Var, Type),
get_module_info(CI, ModuleInfo),
update_type_may_use_atomic_alloc(ModuleInfo, Type, !MayUseAtomic),
- generate_pred_args(CI, VarTypes, Vars, ArgInfos, MaybeRvals,
+ generate_pred_args(CI, VarTypes, Vars, ArgInfos, CellArgs,
!MayUseAtomic).
:- pred generate_cons_args(list(prog_var)::in, list(mer_type)::in,
- list(uni_mode)::in, int::in, list(int)::in, code_info::in,
- list(maybe(rval))::out, list(field_addr(unpacked))::out,
- may_use_atomic_alloc::out) is det.
+ list(uni_mode)::in, list(arg_width)::in, list(int)::in,
+ code_info::in, list(cell_arg)::out, may_use_atomic_alloc::out) is det.
-generate_cons_args(Vars, Types, Modes, FirstOffset, TakeAddr, CI,
- !:Args, !:FieldAddrs, !:MayUseAtomic) :-
+generate_cons_args(Vars, Types, Modes, Widths, TakeAddr, CI, !:Args,
+ !:MayUseAtomic) :-
get_module_info(CI, ModuleInfo),
!:MayUseAtomic = initial_may_use_atomic(ModuleInfo),
(
FirstArgNum = 1,
- generate_cons_args_2(Vars, Types, Modes, FirstOffset, FirstArgNum,
- TakeAddr, CI, !:Args, !:FieldAddrs, !MayUseAtomic)
+ generate_cons_args_2(Vars, Types, Modes, Widths, FirstArgNum, TakeAddr,
+ CI, !:Args, !MayUseAtomic)
->
true
;
@@ -970,48 +958,53 @@ generate_cons_args(Vars, Types, Modes, FirstOffset, TakeAddr, CI,
% we just produce `no', meaning don't generate an assignment to that field.
%
:- pred generate_cons_args_2(list(prog_var)::in, list(mer_type)::in,
- list(uni_mode)::in, int::in, int::in, list(int)::in, code_info::in,
- list(maybe(rval))::out, list(field_addr(unpacked))::out,
+ list(uni_mode)::in, list(arg_width)::in, int::in, list(int)::in,
+ code_info::in, list(cell_arg)::out,
may_use_atomic_alloc::in, may_use_atomic_alloc::out) is semidet.
-generate_cons_args_2([], [], [], _, _, [], _, [], [], !MayUseAtomic).
+generate_cons_args_2([], [], [], [], _CurArgNum, _TakeAddr, _CI, [],
+ !MayUseAtomic).
generate_cons_args_2([Var | Vars], [Type | Types], [UniMode | UniModes],
- FirstOffset, CurArgNum, !.TakeAddr, CI, [MaybeRval | MaybeRvals],
- FieldAddrs, !MayUseAtomic) :-
+ [Width | Widths], CurArgNum, !.TakeAddr, CI, [CellArg | CellArgs],
+ !MayUseAtomic) :-
get_module_info(CI, ModuleInfo),
update_type_may_use_atomic_alloc(ModuleInfo, Type, !MayUseAtomic),
( !.TakeAddr = [CurArgNum | !:TakeAddr] ->
get_lcmc_null(CI, LCMCNull),
(
LCMCNull = no,
- MaybeRval = no
+ MaybeNull = no
;
LCMCNull = yes,
- MaybeRval = yes(const(llconst_int(0)))
+ MaybeNull = yes(const(llconst_int(0)))
),
+ CellArg = cell_arg_take_addr(Var, MaybeNull),
!:MayUseAtomic = may_not_use_atomic_alloc,
- generate_cons_args_2(Vars, Types, UniModes, FirstOffset, CurArgNum + 1,
- !.TakeAddr, CI, MaybeRvals, FieldAddrs1, !MayUseAtomic),
- % Whereas CurArgNum starts numbering the arguments from 1, offsets
- % into fields start from zero. However, if FirstOffset = 1, then the
- % first word in the cell is the secondary tag. This offset calculation
- % does not consider field packing; that is done subsequently.
- Offset = CurArgNum - 1 + FirstOffset,
- FieldAddrs = [field_addr(Offset, Var) | FieldAddrs1]
+ generate_cons_args_2(Vars, Types, UniModes, Widths, CurArgNum + 1,
+ !.TakeAddr, CI, CellArgs, !MayUseAtomic)
;
UniMode = ((_LI - RI) -> (_LF - RF)),
mode_to_arg_mode(ModuleInfo, (RI -> RF), Type, ArgMode),
(
ArgMode = top_in,
- MaybeRval = yes(var(Var))
+ (
+ ( Width = full_word
+ ; Width = partial_word_first(_)
+ ; Width = partial_word_shifted(_, _)
+ ),
+ CellArg = cell_arg_full_word(var(Var), complete)
+ ;
+ Width = double_word,
+ CellArg = cell_arg_double_word(var(Var))
+ )
;
( ArgMode = top_out
; ArgMode = top_unused
),
- MaybeRval = no
+ CellArg = cell_arg_skip
),
- generate_cons_args_2(Vars, Types, UniModes, FirstOffset, CurArgNum + 1,
- !.TakeAddr, CI, MaybeRvals, FieldAddrs, !MayUseAtomic)
+ generate_cons_args_2(Vars, Types, UniModes, Widths, CurArgNum + 1,
+ !.TakeAddr, CI, CellArgs, !MayUseAtomic)
).
:- func initial_may_use_atomic(module_info) = may_use_atomic_alloc.
@@ -1028,30 +1021,12 @@ initial_may_use_atomic(ModuleInfo) = InitMayUseAtomic :-
).
:- pred pack_cell_rvals(list(arg_width)::in,
- list(maybe(rval))::in, list(maybe(rval))::out, bool::out,
+ list(cell_arg)::in, list(cell_arg)::out,
llds_code::out, code_info::in, code_info::out) is det.
-pack_cell_rvals(ArgWidths, Rvals0, Rvals, AllFilled, Code, !CI) :-
- % Check whether all arguments are filled in. This has to be done on the
- % unpacked rvals list.
- AllFilled = (list.contains(Rvals0, no) -> no ; yes),
- pack_args(shift_combine_arg, ArgWidths, Rvals0, Rvals, empty, Code, !CI).
-
-:- pred pack_field_addrs(list(arg_width)::in,
- list(field_addr(unpacked))::in, list(field_addr(packed))::out) is det.
-
-pack_field_addrs(ArgWidths, FieldAddrs0, FieldAddrs) :-
- list.map(pack_field_addr(ArgWidths), FieldAddrs0, FieldAddrs).
-
-:- pred pack_field_addr(list(arg_width)::in,
- field_addr(unpacked)::in, field_addr(packed)::out) is det.
-
-pack_field_addr(ArgWidths, field_addr(Num0, Var), field_addr(Num, Var)) :-
- ( list.take(Num0, ArgWidths, ArgWidthsToVar) ->
- Num = count_distinct_words(ArgWidthsToVar)
- ;
- unexpected($module, $pred, "more fields than arg_widths")
- ).
+pack_cell_rvals(ArgWidths, CellArgs0, CellArgs, Code, !CI) :-
+ pack_args(shift_combine_arg, ArgWidths, CellArgs0, CellArgs, empty, Code,
+ !CI).
:- pred pack_how_to_construct(list(arg_width)::in,
how_to_construct::in, how_to_construct::out) is det.
@@ -1068,7 +1043,7 @@ pack_how_to_construct(ArgWidths, !HowToConstruct) :-
% If an argument within a packed field needs updating,
% the field needs updating.
CellToReuse0 = cell_to_reuse(Var, ConsIds, NeedsUpdates0),
- chunk_list_by_words(ArgWidths, NeedsUpdates0, NeedsUpdates1),
+ group_same_word_elements(ArgWidths, NeedsUpdates0, NeedsUpdates1),
list.map(condense_needs_updates, NeedsUpdates1) = NeedsUpdates,
CellToReuse = cell_to_reuse(Var, ConsIds, NeedsUpdates),
!:HowToConstruct = reuse_cell(CellToReuse)
@@ -1083,13 +1058,13 @@ condense_needs_updates(NeedsUpdatess) =
does_not_need_update
).
-:- pred construct_cell(prog_var::in, tag::in, list(maybe(rval))::in, bool::in,
- how_to_construct::in, maybe(term_size_value)::in,
- list(field_addr(packed))::in, prog_context::in, may_use_atomic_alloc::in,
- llds_code::out, code_info::in, code_info::out) is det.
+:- pred construct_cell(prog_var::in, tag::in, list(cell_arg)::in,
+ how_to_construct::in, maybe(term_size_value)::in, prog_context::in,
+ may_use_atomic_alloc::in, llds_code::out, code_info::in, code_info::out)
+ is det.
-construct_cell(Var, Ptag, MaybeRvals, AllFilled, HowToConstruct, MaybeSize,
- FieldAddrs, Context, MayUseAtomic, Code, !CI) :-
+construct_cell(Var, Ptag, CellArgs, HowToConstruct, MaybeSize, Context,
+ MayUseAtomic, Code, !CI) :-
VarType = variable_type(!.CI, Var),
var_type_msg(VarType, VarTypeMsg),
% If we're doing accurate GC, then for types which hold RTTI that
@@ -1108,30 +1083,25 @@ construct_cell(Var, Ptag, MaybeRvals, AllFilled, HowToConstruct, MaybeSize,
;
ReserveWordAtStart = no
),
- FieldNums = list.map(get_field_num, FieldAddrs),
- Size = list.length(MaybeRvals),
+ Size = size_of_cell_args(CellArgs),
maybe_add_alloc_site_info(Context, VarTypeMsg, Size, MaybeAllocId, !CI),
- assign_cell_to_var(Var, ReserveWordAtStart, Ptag, MaybeRvals, AllFilled,
- HowToConstruct, MaybeSize, FieldNums, MaybeAllocId, MayUseAtomic,
- CellCode, !CI),
+ assign_cell_to_var(Var, ReserveWordAtStart, Ptag, CellArgs, HowToConstruct,
+ MaybeSize, MaybeAllocId, MayUseAtomic, CellCode, !CI),
+ generate_field_addrs(CellArgs, FieldAddrs),
(
FieldAddrs = [],
% Optimize common case.
Code = CellCode
;
FieldAddrs = [_ | _],
- % Any field whose address we take will be represented by a `no'
- % in MaybeRvals, which should prevent the cell from being made
+ % Any field whose address we take will be represented by a
+ % `cell_arg_take_addr' which should prevent the cell from being made
% into static data.
generate_field_take_address_assigns(FieldAddrs, Var, Ptag,
FieldCode, !CI),
Code = CellCode ++ FieldCode
).
-:- func get_field_num(field_addr(packed)) = int.
-
-get_field_num(field_addr(Num, _Var)) = Num.
-
:- pred maybe_add_alloc_site_info(prog_context::in, string::in, int::in,
maybe(alloc_site_id)::out, code_info::in, code_info::out) is det.
@@ -1147,7 +1117,32 @@ maybe_add_alloc_site_info(Context, VarTypeMsg, Size, MaybeAllocId, !CI) :-
MaybeAllocId = no
).
-:- pred generate_field_take_address_assigns(list(field_addr(packed))::in,
+:- pred generate_field_addrs(list(cell_arg)::in, list(field_addr)::out) is det.
+
+generate_field_addrs(CellArgs, FieldAddrs) :-
+ list.foldl2(generate_field_addr, CellArgs, 0, _, [], RevFieldAddrs),
+ list.reverse(RevFieldAddrs, FieldAddrs).
+
+:- pred generate_field_addr(cell_arg::in, int::in, int::out,
+ list(field_addr)::in, list(field_addr)::out) is det.
+
+generate_field_addr(CellArg, ArgOffset, NextOffset, !RevFieldAddrs) :-
+ (
+ ( CellArg = cell_arg_full_word(_, _)
+ ; CellArg = cell_arg_skip
+ ),
+ NextOffset = ArgOffset + 1
+ ;
+ CellArg = cell_arg_double_word(_),
+ NextOffset = ArgOffset + 2
+ ;
+ CellArg = cell_arg_take_addr(Var, _),
+ NextOffset = ArgOffset + 1,
+ FieldAddr = field_addr(ArgOffset, Var),
+ !:RevFieldAddrs = [FieldAddr | !.RevFieldAddrs]
+ ).
+
+:- pred generate_field_take_address_assigns(list(field_addr)::in,
prog_var::in, int::in, llds_code::out, code_info::in, code_info::out)
is det.
@@ -1451,8 +1446,17 @@ generate_sub_assign(Left, Right, Code, !CI) :-
"Update part of word"))
;
LeftWidth = double_word,
- % Not yet supported in LLDS grades.
- sorry($module, $pred, "double_word")
+ ( field_offset_pair(Lval, LvalA, LvalB) ->
+ SrcA = binop(float_word_bits, Source, const(llconst_int(0))),
+ SrcB = binop(float_word_bits, Source, const(llconst_int(1))),
+ Comment = "Update double word",
+ AssignCode = from_list([
+ llds_instr(assign(LvalA, SrcA), Comment),
+ llds_instr(assign(LvalB, SrcB), Comment)
+ ])
+ ;
+ sorry($module, $pred, "double_word: non-field lval")
+ )
),
Code = SourceCode ++ MaterializeCode ++ AssignCode
;
@@ -1473,11 +1477,18 @@ generate_sub_assign(Left, Right, Code, !CI) :-
Rval0 = right_shift_rval(lval(Lval), Shift)
),
Rval = binop(bitwise_and, Rval0, const(llconst_int(Mask))),
- assign_field_lval_expr_to_var(Lvar, Lval, Rval, Code, !CI)
+ assign_field_lval_expr_to_var(Lvar, [Lval], Rval, Code,
+ !CI)
;
RightWidth = double_word,
- % Not yet supported in LLDS grades.
- sorry($module, $pred, "double_word")
+ ( field_offset_pair(Lval, LvalA, LvalB) ->
+ Rval = binop(float_from_dword,
+ lval(LvalA), lval(LvalB)),
+ assign_field_lval_expr_to_var(Lvar, [LvalA, LvalB],
+ Rval, Code, !CI)
+ ;
+ sorry($module, $pred, "double_word: non-field lval")
+ )
)
;
Right = ref(Rvar),
@@ -1490,6 +1501,12 @@ generate_sub_assign(Left, Right, Code, !CI) :-
)
).
+:- pred field_offset_pair(lval::in, lval::out, lval::out) is semidet.
+
+field_offset_pair(LvalA, LvalA, LvalB) :-
+ LvalA = field(Ptag, Address, const(llconst_int(Offset))),
+ LvalB = field(Ptag, Address, const(llconst_int(Offset + 1))).
+
%---------------------------------------------------------------------------%
% Generate a direct arg unification between
@@ -1737,7 +1754,8 @@ generate_ground_term_conjunct_tag(Var, ConsTag, Args, ConsArgWidths,
;
ConsTag = unshared_tag(Ptag)
),
- generate_ground_term_args(Args, ArgRvalsTypes, !ActiveMap),
+ generate_ground_term_args(Args, ConsArgWidths, ArgRvalsTypes,
+ !ActiveMap),
pack_ground_term_args(ConsArgWidths, ArgRvalsTypes, PackArgRvalsTypes),
add_scalar_static_cell(PackArgRvalsTypes, DataAddr, !StaticCellInfo),
MaybeOffset = no,
@@ -1761,7 +1779,8 @@ generate_ground_term_conjunct_tag(Var, ConsTag, Args, ConsArgWidths,
)
;
ConsTag = shared_remote_tag(Ptag, Stag),
- generate_ground_term_args(Args, ArgRvalsTypes, !ActiveMap),
+ generate_ground_term_args(Args, ConsArgWidths, ArgRvalsTypes,
+ !ActiveMap),
pack_ground_term_args(ConsArgWidths, ArgRvalsTypes, PackArgRvalsTypes),
StagRvalType = const(llconst_int(Stag)) - lt_integer,
AllRvalsTypes = [StagRvalType | PackArgRvalsTypes],
@@ -1782,14 +1801,30 @@ generate_ground_term_conjunct_tag(Var, ConsTag, Args, ConsArgWidths,
unexpected($module, $pred, "unexpected tag")
).
-:- pred generate_ground_term_args(list(prog_var)::in,
+:- pred generate_ground_term_args(list(prog_var)::in, list(arg_width)::in,
assoc_list(rval, llds_type)::out,
active_ground_term_map::in, active_ground_term_map::out) is det.
-generate_ground_term_args([], [], !ActiveMap).
-generate_ground_term_args([Var | Vars], [RvalType | RvalsTypes], !ActiveMap) :-
- map.det_remove(Var, RvalType, !ActiveMap),
- generate_ground_term_args(Vars, RvalsTypes, !ActiveMap).
+generate_ground_term_args(Vars, ConsArgWidths, RvalsTypes, !ActiveMap) :-
+ list.map_corresponding_foldl(generate_ground_term_arg, Vars, ConsArgWidths,
+ RvalsTypes, !ActiveMap).
+
+:- pred generate_ground_term_arg(prog_var::in, arg_width::in,
+ pair(rval, llds_type)::out,
+ active_ground_term_map::in, active_ground_term_map::out) is det.
+
+generate_ground_term_arg(Var, ConsArgWidth, RvalType, !ActiveMap) :-
+ map.det_remove(Var, RvalType0, !ActiveMap),
+ % Though a standalone float might have needed to boxed, it may be stored in
+ % unboxed form as a constructor argument.
+ (
+ ConsArgWidth = double_word,
+ RvalType0 = Rval - lt_data_ptr
+ ->
+ RvalType = Rval - lt_float
+ ;
+ RvalType = RvalType0
+ ).
:- pred pack_ground_term_args(list(arg_width)::in,
assoc_list(rval, llds_type)::in, assoc_list(rval, llds_type)::out) is det.
@@ -1799,46 +1834,65 @@ pack_ground_term_args(Widths, !RvalsTypes) :-
%-----------------------------------------------------------------------------%
-:- pred shift_combine_arg(maybe(rval)::in, int::in,
- maybe(maybe(rval))::in, maybe(rval)::out,
- llds_code::in, llds_code::out, code_info::in, code_info::out) is det.
+:- pred shift_combine_arg(cell_arg::in, int::in, maybe(cell_arg)::in,
+ cell_arg::out, llds_code::in, llds_code::out,
+ code_info::in, code_info::out) is det.
-shift_combine_arg(ArgA, Shift, MaybeArgB, FinalArg, !Code, !CI) :-
+shift_combine_arg(CellArgA, Shift, MaybeCellArgB, FinalCellArg, !Code, !CI) :-
(
Shift = 0,
- MaybeArgB = no
+ MaybeCellArgB = no
->
- FinalArg = ArgA
+ FinalCellArg = CellArgA
;
(
- ArgA = yes(RvalA),
+ CellArgA = cell_arg_full_word(RvalA, Completeness),
( RvalA = var(Var) ->
IsDummy = variable_is_of_dummy_type(!.CI, Var),
(
IsDummy = is_dummy_type,
- ShiftArgA = no
+ ShiftCellArgA = cell_arg_skip
;
IsDummy = is_not_dummy_type,
produce_variable(Var, VarCode, VarRval, !CI),
- ShiftArgA = yes(maybe_left_shift_rval(VarRval, Shift)),
+ ShiftCellArgA = cell_arg_full_word(
+ maybe_left_shift_rval(VarRval, Shift),
+ Completeness),
!:Code = !.Code ++ VarCode
)
; RvalA = const(llconst_int(Int)) ->
NewInt = maybe_left_shift_int(Int, Shift),
- ShiftArgA = yes(const(llconst_int(NewInt)))
+ ShiftCellArgA = cell_arg_full_word(const(llconst_int(NewInt)),
+ Completeness)
;
unexpected($module, $pred, "non-var or int argument")
)
;
- ArgA = no,
- ShiftArgA = no
+ CellArgA = cell_arg_double_word(RvalA),
+ expect(unify(Shift, 0), $module, $pred,
+ "double word rval cannot be shifted"),
+ ( RvalA = var(Var) ->
+ produce_variable(Var, VarCode, VarRval, !CI),
+ ShiftCellArgA = cell_arg_double_word(VarRval),
+ !:Code = !.Code ++ VarCode
+ ; RvalA = const(llconst_float(_)) ->
+ ShiftCellArgA = CellArgA
+ ;
+ unexpected($module, $pred, "non-var or float argument")
+ )
+ ;
+ CellArgA = cell_arg_skip,
+ ShiftCellArgA = cell_arg_skip
+ ;
+ CellArgA = cell_arg_take_addr(_, _),
+ unexpected($module, $pred, "cell_arg_take_addr")
),
(
- MaybeArgB = yes(ArgB),
- FinalArg = bitwise_or_maybe_rval(ShiftArgA, ArgB)
+ MaybeCellArgB = yes(CellArgB),
+ FinalCellArg = bitwise_or_cell_arg(ShiftCellArgA, CellArgB)
;
- MaybeArgB = no,
- FinalArg = ShiftArgA
+ MaybeCellArgB = no,
+ FinalCellArg = ShiftCellArgA
)
).
@@ -1885,27 +1939,46 @@ maybe_left_shift_int(X, Shift) =
right_shift_rval(Rval, Shift) =
binop(unchecked_right_shift, Rval, const(llconst_int(Shift))).
-:- func bitwise_or_maybe_rval(maybe(rval), maybe(rval)) = maybe(rval).
+:- func bitwise_or_cell_arg(cell_arg, cell_arg) = cell_arg.
-bitwise_or_maybe_rval(MaybeRvalA, MaybeRvalB) = MaybeRval :-
- (
- MaybeRvalA = yes(RvalA),
- MaybeRvalB = yes(RvalB),
- MaybeRval = yes(binop(bitwise_or, RvalA, RvalB))
- ;
- MaybeRvalA = yes(_),
- MaybeRvalB = no,
- MaybeRval = MaybeRvalA
- ;
- MaybeRvalA = no,
- MaybeRvalB = yes(_),
- MaybeRval = MaybeRvalB
+bitwise_or_cell_arg(CellArgA, CellArgB) = CellArg :-
+ ( bitwise_or_cell_arg(CellArgA, CellArgB, CellArgPrime) ->
+ CellArg = CellArgPrime
;
- MaybeRvalA = no,
- MaybeRvalB = no,
- MaybeRval = no
+ unexpected($module, $pred, "invalid combination")
).
+:- pred bitwise_or_cell_arg(cell_arg::in, cell_arg::in, cell_arg::out)
+ is semidet.
+
+bitwise_or_cell_arg(CellArgA, CellArgB, CellArg) :-
+ (
+ CellArgA = cell_arg_full_word(RvalA, CompletenessA),
+ CellArgB = cell_arg_full_word(RvalB, CompletenessB),
+ Expr = binop(bitwise_or, RvalA, RvalB),
+ Completeness = combine_completeness(CompletenessA, CompletenessB),
+ CellArg = cell_arg_full_word(Expr, Completeness)
+ ;
+ CellArgA = cell_arg_full_word(Rval, _),
+ CellArgB = cell_arg_skip,
+ CellArg = cell_arg_full_word(Rval, incomplete)
+ ;
+ CellArgA = cell_arg_skip,
+ CellArgB = cell_arg_full_word(Rval, _),
+ CellArg = cell_arg_full_word(Rval, incomplete)
+ ;
+ CellArgA = cell_arg_skip,
+ CellArgB = cell_arg_skip,
+ CellArg = cell_arg_skip
+ ).
+
+:- func combine_completeness(completeness, completeness) = completeness.
+
+combine_completeness(complete, complete) = complete.
+combine_completeness(incomplete, complete) = incomplete.
+combine_completeness(complete, incomplete) = incomplete.
+combine_completeness(incomplete, incomplete) = incomplete.
+
%---------------------------------------------------------------------------%
:- pred var_type_msg(mer_type::in, string::out) is det.
diff --git a/compiler/var_locn.m b/compiler/var_locn.m
index ca066dd..9fab8cb 100644
--- a/compiler/var_locn.m
+++ b/compiler/var_locn.m
@@ -145,15 +145,15 @@
static_cell_info::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
- % var_locn_assign_field_lval_expr_to_var(ModuleInfo, Var, FieldLval, Expr,
+ % var_locn_assign_field_lval_expr_to_var(ModuleInfo, Var, BaseVar, Expr,
% StaticCellInfo, Code, !VarLocnInfo);
%
% Reflects the effect of the assignment Var := Expr,
- % where Expr contains on the field lval FieldLval.
+ % where Expr contains only field lvals with the base BaseVar.
% Any code required to effect the assignment will be returned in Code.
%
:- pred var_locn_assign_field_lval_expr_to_var(prog_var::in,
- lval::in, rval::in, llds_code::out,
+ prog_var::in, rval::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_assign_const_to_var(ExprnOpts, Var, ConstRval,
@@ -193,8 +193,8 @@
% obvious conflict.) Label can be used in the generated code if necessary.
%
:- pred var_locn_assign_cell_to_var(module_info::in, exprn_opts::in,
- prog_var::in, bool::in, tag::in, list(maybe(rval))::in, bool::in,
- how_to_construct::in, maybe(term_size_value)::in, list(int)::in,
+ prog_var::in, bool::in, tag::in, list(cell_arg)::in,
+ how_to_construct::in, maybe(term_size_value)::in,
maybe(alloc_site_id)::in, may_use_atomic_alloc::in, label::in,
llds_code::out, static_cell_info::in, static_cell_info::out,
var_locn_info::in, var_locn_info::out) is det.
@@ -770,18 +770,14 @@ var_locn_assign_lval_to_var(ModuleInfo, Var, Lval0, StaticCellInfo, Code,
add_field_offset(Ptag, Offset, Base) =
field(Ptag, lval(Base), Offset).
-var_locn_assign_field_lval_expr_to_var(Var, Lval, Expr, Code, !VLI) :-
+var_locn_assign_field_lval_expr_to_var(Var, BaseVar, Expr, Code, !VLI) :-
check_var_is_unknown(!.VLI, Var),
- ( Lval = field(yes(_Ptag), var(BaseVar), const(llconst_int(_Offset))) ->
- var_locn_get_var_state_map(!.VLI, VarStateMap0),
- State = var_state(set.init, no, yes(Expr), set_of_var.init, doa_alive),
- map.det_insert(Var, State, VarStateMap0, VarStateMap1),
- add_use_ref(BaseVar, Var, VarStateMap1, VarStateMap),
- var_locn_set_var_state_map(VarStateMap, !VLI),
- Code = empty
- ;
- unexpected($module, $pred, "not field lval")
- ).
+ var_locn_get_var_state_map(!.VLI, VarStateMap0),
+ State = var_state(set.init, no, yes(Expr), set_of_var.init, doa_alive),
+ map.det_insert(Var, State, VarStateMap0, VarStateMap1),
+ add_use_ref(BaseVar, Var, VarStateMap1, VarStateMap),
+ var_locn_set_var_state_map(VarStateMap, !VLI),
+ Code = empty.
%----------------------------------------------------------------------------%
@@ -835,8 +831,8 @@ add_use_ref(ContainedVar, UsingVar, !VarStateMap) :-
%----------------------------------------------------------------------------%
var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var, ReserveWordAtStart,
- Ptag, MaybeRvals0, AllFilled, HowToConstruct, MaybeSize, FieldAddrs,
- MaybeAllocId, MayUseAtomic, Label, Code, !StaticCellInfo, !VLI) :-
+ Ptag, CellArgs0, HowToConstruct, MaybeSize, MaybeAllocId, MayUseAtomic,
+ Label, Code, !StaticCellInfo, !VLI) :-
(
MaybeSize = yes(SizeSource),
(
@@ -846,11 +842,11 @@ var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var, ReserveWordAtStart,
SizeSource = dynamic_size(SizeVar),
SizeRval = var(SizeVar)
),
- MaybeRvals = [yes(SizeRval) | MaybeRvals0],
+ CellArgs = [cell_arg_full_word(SizeRval, complete) | CellArgs0],
MaybeOffset = yes(1)
;
MaybeSize = no,
- MaybeRvals = MaybeRvals0,
+ CellArgs = CellArgs0,
MaybeOffset = no
),
var_locn_get_var_state_map(!.VLI, VarStateMap),
@@ -858,10 +854,8 @@ var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var, ReserveWordAtStart,
% We can make the cell a constant only if all its fields are filled in,
% and they are all constants.
(
- AllFilled = yes,
StaticGroundCells = have_static_ground_cells,
- FieldAddrs = [],
- cell_is_constant(VarStateMap, ExprnOpts, MaybeRvals, RvalsTypes)
+ cell_is_constant(VarStateMap, ExprnOpts, CellArgs, RvalsTypes)
->
add_scalar_static_cell(RvalsTypes, DataAddr, !StaticCellInfo),
CellPtrConst = const(llconst_data_addr(DataAddr, MaybeOffset)),
@@ -870,12 +864,12 @@ var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var, ReserveWordAtStart,
Code = empty
;
var_locn_assign_dynamic_cell_to_var(ModuleInfo, Var,
- ReserveWordAtStart, Ptag, MaybeRvals, HowToConstruct,
+ ReserveWordAtStart, Ptag, CellArgs, HowToConstruct,
MaybeOffset, MaybeAllocId, MayUseAtomic, Label, Code, !VLI)
).
:- pred var_locn_assign_dynamic_cell_to_var(module_info::in, prog_var::in,
- bool::in, tag::in, list(maybe(rval))::in, how_to_construct::in,
+ bool::in, tag::in, list(cell_arg)::in, how_to_construct::in,
maybe(int)::in, maybe(alloc_site_id)::in, may_use_atomic_alloc::in,
label::in, llds_code::out, var_locn_info::in, var_locn_info::out) is det.
@@ -886,7 +880,7 @@ var_locn_assign_dynamic_cell_to_var(ModuleInfo, Var, ReserveWordAtStart, Ptag,
select_preferred_reg_or_stack(!.VLI, Var, Lval),
get_var_name(!.VLI, Var, VarName),
- list.length(Vector, Size),
+ Size = size_of_cell_args(Vector),
(
ReserveWordAtStart = yes,
(
@@ -985,7 +979,7 @@ var_locn_assign_dynamic_cell_to_var(ModuleInfo, Var, ReserveWordAtStart, Ptag,
Code = SetupReuseCode ++ CellCode ++ RegionVarCode ++ ArgsCode.
:- pred assign_reused_cell_to_var(module_info::in, lval::in, tag::in,
- list(maybe(rval))::in, cell_to_reuse::in, lval::in, llds_code::in,
+ list(cell_arg)::in, cell_to_reuse::in, lval::in, llds_code::in,
int::in, label::in, llds_reuse::out, llds_code::out, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
@@ -1048,41 +1042,75 @@ assign_reused_cell_to_var(ModuleInfo, Lval, Ptag, Vector, CellToReuse,
list.foldl(var_locn_release_reg, TempRegs, !VLI).
-:- pred assign_all_cell_args(module_info::in, list(maybe(rval))::in,
+:- pred assign_all_cell_args(module_info::in, list(cell_arg)::in,
maybe(tag)::in, rval::in, int::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
assign_all_cell_args(_, [], _, _, _, empty, !VLI).
-assign_all_cell_args(ModuleInfo, [MaybeRval | MaybeRvals], Ptag, Base, Offset,
+assign_all_cell_args(ModuleInfo, [CellArg | CellArgs], Ptag, Base, Offset,
Code, !VLI) :-
(
- MaybeRval = yes(Rval),
- assign_cell_arg(ModuleInfo, Rval, Ptag, Base, Offset, ThisCode, !VLI)
- ;
- MaybeRval = no,
- ThisCode = empty
+ ( CellArg = cell_arg_full_word(Rval, _Completeness)
+ ; CellArg = cell_arg_take_addr(_, yes(Rval))
+ ),
+ assign_cell_arg(ModuleInfo, Rval, Ptag, Base, Offset, ThisCode, !VLI),
+ NextOffset = Offset + 1
+ ;
+ CellArg = cell_arg_double_word(Rval0),
+ materialize_if_var(ModuleInfo, Rval0, EvalCode, Rval, !VLI),
+ RvalA = binop(float_word_bits, Rval, const(llconst_int(0))),
+ RvalB = binop(float_word_bits, Rval, const(llconst_int(1))),
+ assign_cell_arg(ModuleInfo, RvalA, Ptag, Base, Offset,
+ ThisCodeA, !VLI),
+ assign_cell_arg(ModuleInfo, RvalB, Ptag, Base, Offset + 1,
+ ThisCodeB, !VLI),
+ ThisCode = EvalCode ++ ThisCodeA ++ ThisCodeB,
+ NextOffset = Offset + 2
+ ;
+ ( CellArg = cell_arg_skip
+ ; CellArg = cell_arg_take_addr(_, no)
+ ),
+ ThisCode = empty,
+ NextOffset = Offset + 1
),
- assign_all_cell_args(ModuleInfo, MaybeRvals, Ptag, Base, Offset + 1,
+ assign_all_cell_args(ModuleInfo, CellArgs, Ptag, Base, NextOffset,
RestCode, !VLI),
Code = ThisCode ++ RestCode.
-:- pred assign_some_cell_args(module_info::in, list(maybe(rval))::in,
+:- pred assign_some_cell_args(module_info::in, list(cell_arg)::in,
list(needs_update)::in, maybe(tag)::in, rval::in, int::in, llds_code::out,
llds_code::out, var_locn_info::in, var_locn_info::out) is det.
assign_some_cell_args(_, [], [], _, _, _, empty, empty, !VLI).
assign_some_cell_args(ModuleInfo,
- [MaybeRval | MaybeRvals], [NeedsUpdate | NeedsUpdates],
+ [CellArg | CellArgs], [NeedsUpdate | NeedsUpdates],
Ptag, Base, Offset, CannotSkipArgsCode, CanSkipArgsCode, !VLI) :-
(
- MaybeRval = yes(Rval),
- assign_cell_arg(ModuleInfo, Rval, Ptag, Base, Offset, ThisCode, !VLI)
- ;
- MaybeRval = no,
- ThisCode = empty
+ ( CellArg = cell_arg_full_word(Rval, _Completeness)
+ ; CellArg = cell_arg_take_addr(_, yes(Rval))
+ ),
+ assign_cell_arg(ModuleInfo, Rval, Ptag, Base, Offset, ThisCode, !VLI),
+ NextOffset = Offset + 1
+ ;
+ CellArg = cell_arg_double_word(Rval0),
+ materialize_if_var(ModuleInfo, Rval0, EvalCode, Rval, !VLI),
+ RvalA = binop(float_word_bits, Rval, const(llconst_int(0))),
+ RvalB = binop(float_word_bits, Rval, const(llconst_int(1))),
+ assign_cell_arg(ModuleInfo, RvalA, Ptag, Base, Offset,
+ ThisCodeA, !VLI),
+ assign_cell_arg(ModuleInfo, RvalB, Ptag, Base, Offset + 1,
+ ThisCodeB, !VLI),
+ ThisCode = EvalCode ++ ThisCodeA ++ ThisCodeB,
+ NextOffset = Offset + 2
+ ;
+ ( CellArg = cell_arg_skip
+ ; CellArg = cell_arg_take_addr(_, no)
+ ),
+ ThisCode = empty,
+ NextOffset = Offset + 1
),
- assign_some_cell_args(ModuleInfo, MaybeRvals, NeedsUpdates, Ptag, Base,
- Offset + 1, RestCannotSkipArgsCode, RestCanSkipArgsCode, !VLI),
+ assign_some_cell_args(ModuleInfo, CellArgs, NeedsUpdates, Ptag, Base,
+ NextOffset, RestCannotSkipArgsCode, RestCanSkipArgsCode, !VLI),
(
NeedsUpdate = needs_update,
CannotSkipArgsCode = ThisCode ++ RestCannotSkipArgsCode,
@@ -1105,15 +1133,7 @@ assign_cell_arg(ModuleInfo, Rval0, Ptag, Base, Offset, Code, !VLI) :-
Target = field(Ptag, Base, const(llconst_int(Offset))),
(
Rval0 = var(Var),
- find_var_availability(!.VLI, Var, no, Avail),
- (
- Avail = available(Rval),
- EvalCode = empty
- ;
- Avail = needs_materialization,
- materialize_var(ModuleInfo, Var, no, no, [], Rval, EvalCode,
- !VLI)
- ),
+ materialize_if_var(ModuleInfo, Rval0, EvalCode, Rval, !VLI),
var_locn_get_vartypes(!.VLI, VarTypes),
map.lookup(VarTypes, Var, Type),
IsDummy = check_dummy_type(ModuleInfo, Type),
@@ -1152,6 +1172,33 @@ assign_cell_arg(ModuleInfo, Rval0, Ptag, Base, Offset, Code, !VLI) :-
),
Code = EvalCode ++ AssignCode.
+:- pred materialize_if_var(module_info::in, rval::in, llds_code::out,
+ rval::out, var_locn_info::in, var_locn_info::out) is det.
+
+materialize_if_var(ModuleInfo, Rval0, EvalCode, Rval, !VLI) :-
+ (
+ Rval0 = var(Var),
+ find_var_availability(!.VLI, Var, no, Avail),
+ (
+ Avail = available(Rval),
+ EvalCode = empty
+ ;
+ Avail = needs_materialization,
+ materialize_var(ModuleInfo, Var, no, no, [], Rval, EvalCode,
+ !VLI)
+ )
+ ;
+ ( Rval0 = const(_)
+ ; Rval0 = mkword(_, _)
+ ; Rval0 = unop(_, _)
+ ; Rval0 = binop(_, _, _)
+ ; Rval0 = lval(_)
+ ; Rval0 = mem_addr(_)
+ ),
+ EvalCode = empty,
+ Rval = Rval0
+ ).
+
var_locn_save_cell_fields(ModuleInfo, ReuseVar, ReuseLval, Code, Regs, !VLI) :-
var_locn_get_var_state_map(!.VLI, VarStateMap),
map.lookup(VarStateMap, ReuseVar, ReuseVarState0),
@@ -2126,14 +2173,28 @@ var_locn_max_reg_in_use(VLI, Max) :-
%----------------------------------------------------------------------------%
:- pred cell_is_constant(var_state_map::in, exprn_opts::in,
- list(maybe(rval))::in, assoc_list(rval, llds_type)::out) is semidet.
+ list(cell_arg)::in, assoc_list(rval, llds_type)::out) is semidet.
cell_is_constant(_VarStateMap, _ExprnOpts, [], []).
-cell_is_constant(VarStateMap, ExprnOpts, [yes(Rval0) | MaybeRvals],
+cell_is_constant(VarStateMap, ExprnOpts, [CellArg | CellArgs],
[Rval - LldsType | RvalsTypes]) :-
+ require_complete_switch [CellArg]
+ (
+ CellArg = cell_arg_full_word(Rval0, complete),
+ ArgWidth = full_word
+ ;
+ CellArg = cell_arg_double_word(Rval0),
+ ArgWidth = double_word
+ ;
+ CellArg = cell_arg_take_addr(_, _),
+ fail
+ ;
+ CellArg = cell_arg_skip,
+ fail
+ ),
expr_is_constant(VarStateMap, ExprnOpts, Rval0, Rval),
- LldsType = rval_type_as_arg(get_unboxed_floats(ExprnOpts), Rval),
- cell_is_constant(VarStateMap, ExprnOpts, MaybeRvals, RvalsTypes).
+ LldsType = rval_type_as_arg(get_unboxed_floats(ExprnOpts), ArgWidth, Rval),
+ cell_is_constant(VarStateMap, ExprnOpts, CellArgs, RvalsTypes).
% expr_is_constant(VarStateMap, ExprnOpts, Rval0, Rval):
% Check if Rval0 is a constant rval, after substituting the values of the
diff --git a/runtime/mercury_float.h b/runtime/mercury_float.h
index b0036f8..d8f72c1 100644
--- a/runtime/mercury_float.h
+++ b/runtime/mercury_float.h
@@ -78,7 +78,7 @@
};
#define MR_float_word_bits(F, I) \
- (((union MR_Float_Dword) (F)).w[(I)])
+ (((union MR_Float_Dword) (MR_Float) (F)).w[(I)])
#define MR_float_from_dword_ptr(ptr) \
(((union MR_Float_Dword *) (ptr))->f)
diff --git a/tests/hard_coded/Mercury.options b/tests/hard_coded/Mercury.options
index ae87721..2e6cb07 100644
--- a/tests/hard_coded/Mercury.options
+++ b/tests/hard_coded/Mercury.options
@@ -63,6 +63,7 @@ MCFLAGS-lco_pack_args = --optimize-constructor-last-call
MCFLAGS-lookup_switch_simple_non = --no-warn-det-decls-too-lax
MCFLAGS-opt_format = --optimize-format-calls
MCFLAGS-pack_args_reuse = --structure-reuse
+MCFLAGS-reuse_double = --ctgc
MCFLAGS-reuse_ho = --ctgc --no-optimise-higher-order
MCFLAGS-sharing_comb = --ctgc --structure-sharing-widening 2
MCFLAGS-simplify_multi_arm_switch = -O3
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index a7cd49e..9d878eb 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -436,6 +436,7 @@ ifeq "$(findstring debug,$(GRADE))" ""
bad_indirect_reuse3 \
pack_args_reuse \
reuse_array \
+ reuse_double \
reuse_ho \
sharing_comb \
uncond_reuse \
diff --git a/tests/hard_coded/lookup_disj.exp b/tests/hard_coded/lookup_disj.exp
index e9e5a32..545ffd5 100644
--- a/tests/hard_coded/lookup_disj.exp
+++ b/tests/hard_coded/lookup_disj.exp
@@ -3,11 +3,11 @@ peek p 2
peek p 3
peek p 4
peek p 5
-p soln 1.10 - one, 11, a
-p soln 2.20 - two, 12, b
-p soln 3.30 - three, 13, c
-p soln 4.40 - four, 14, f(a)
-p soln 5.50 - five, 15, g(a)
+p soln 1.10 - one, 11, 10.10, a
+p soln 2.20 - two, 12, 20.20, b
+p soln 3.30 - three, 13, 30.30, c
+p soln 4.40 - four, 14, 40.40, f(a)
+p soln 5.50 - five, 15, 50.50, g(a)
peek q 1 11
peek q 1 22
peek q 1 33
diff --git a/tests/hard_coded/lookup_disj.m b/tests/hard_coded/lookup_disj.m
index 0ea319d..876258c 100644
--- a/tests/hard_coded/lookup_disj.m
+++ b/tests/hard_coded/lookup_disj.m
@@ -33,7 +33,8 @@ main(!IO) :-
---> p_soln(
pair(float, string),
int,
- t
+ t,
+ float
).
:- type q_soln
@@ -48,9 +49,9 @@ main(!IO) :-
:- pred test_p(p_soln::out) is multi.
test_p(Soln) :-
- p(Pair, Int0, T),
+ p(Pair, Int0, T, F),
peek_at_p_solution(Int0, Int),
- Soln = p_soln(Pair, Int, T).
+ Soln = p_soln(Pair, Int, T, F).
:- pred test_q(q_soln::out) is multi.
@@ -59,14 +60,14 @@ test_q(Soln) :-
peek_at_q_solution(IntA0, IntA, IntB0, IntB),
Soln = q_soln(Pair, IntA, TA, IntB, TB).
-:- pred p(pair(float, string)::out, int::out, t::out) is multi.
+:- pred p(pair(float, string)::out, int::out, t::out, float::out) is multi.
-p(A, B, C) :-
- ( A = 1.1 - "one", B = 1, C = a
- ; A = 2.2 - "two", B = 2, C = b
- ; A = 3.3 - "three", B = 3, C = c
- ; A = 4.4 - "four", B = 4, C = f(a)
- ; A = 5.5 - "five", B = 5, C = g(a)
+p(A, B, C, D) :-
+ ( A = 1.1 - "one", B = 1, C = a, D = 10.1
+ ; A = 2.2 - "two", B = 2, C = b, D = 20.2
+ ; A = 3.3 - "three", B = 3, C = c, D = 30.3
+ ; A = 4.4 - "four", B = 4, C = f(a), D = 40.4
+ ; A = 5.5 - "five", B = 5, C = g(a), D = 50.5
).
:- pred q(pair(float, string)::out, int::out, t::out, int::out, t::out)
@@ -106,8 +107,9 @@ peek_at_q_solution(IntA0, IntA, IntB0, IntB) :-
:- pred write_p_solution(p_soln::in, io::di, io::uo) is det.
write_p_solution(Soln, !IO) :-
- Soln = p_soln(Float - Str, Int, T),
- io.format("p soln %.2f - %5s, %d, ", [f(Float), s(Str), i(Int)], !IO),
+ Soln = p_soln(Float - Str, Int, T, Float2),
+ io.format("p soln %.2f - %5s, %d, %.2f, ",
+ [f(Float), s(Str), i(Int), f(Float2)], !IO),
io.write(T, !IO),
io.nl(!IO).
diff --git a/tests/hard_coded/reuse_double.exp b/tests/hard_coded/reuse_double.exp
new file mode 100644
index 0000000..571fcd2
--- /dev/null
+++ b/tests/hard_coded/reuse_double.exp
@@ -0,0 +1 @@
+tt(3.3, aa, bb, 2.2, dd, cc, 1.1)
diff --git a/tests/hard_coded/reuse_double.m b/tests/hard_coded/reuse_double.m
new file mode 100644
index 0000000..d881efa
--- /dev/null
+++ b/tests/hard_coded/reuse_double.m
@@ -0,0 +1,40 @@
+%-----------------------------------------------------------------------------%
+% Test reuse of cells containing double width arguments.
+
+:- module reuse_double.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module float.
+
+:- type tt
+ ---> tt(float, enum, enum, float, enum, enum, float).
+
+:- type enum
+ ---> aa ; bb ; cc ; dd.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ T0 = tt(1.1, aa, bb, 2.2, cc, dd, 3.3),
+ copy(T0, T1),
+ swap(T1, T2),
+ io.write(T2, !IO),
+ io.nl(!IO).
+
+:- pred swap(tt::di, tt::uo) is det.
+
+swap(TT0, TT1) :-
+ TT0 = tt(A, X1, X2, B, X3, X4, C),
+ TT1 = tt(C, X1, X2, B, X4, X3, A).
+
+%-----------------------------------------------------------------------------%
+% 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