mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 13:23:53 +00:00
df9420c3e6
compiler/hlds_goal.m:
Change the unify_mode structure from
unify_modes_lhs_rhs(from_to_insts(LI, LF), from_to_insts(RI, RF))
to
unify_modes_li_lf_ri_rf(LI, LF, RI, RF)
This requires fewer memory allocations (1 vs 3) and less memory
(4 words vs 6), though the performance improvement is too small
to measure.
It should also require writing fewer function symbols in code.
compiler/instmap.m:
compiler/mode_util.m:
For each utility predicate that works with from_to_insts, provide
a version that works with the separate insts contained in it.
Delete the from_to_insts version if no longer needed.
compiler/prog_mode.m:
Delete utility predicates on from_to_insts that are not needed anymore.
compiler/accumulator.m:
compiler/add_pred.m:
compiler/bytecode_gen.m:
compiler/common.m:
compiler/const_prop.m:
compiler/deep_profiling.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/equiv_type_hlds.m:
compiler/erl_unify_gen.m:
compiler/float_regs.m:
compiler/format_call.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/interval.m:
compiler/lambda.m:
compiler/lco.m:
compiler/make_goal.m:
compiler/ml_unify_gen_construct.m:
compiler/ml_unify_gen_util.m:
compiler/modecheck_goal.m:
compiler/modecheck_unify.m:
compiler/polymorphism.m:
compiler/proc_requests.m:
compiler/prog_rep.m:
compiler/rbmm.region_transformation.m:
compiler/simplify_goal_call.m:
compiler/simplify_goal_scope.m:
compiler/simplify_goal_switch.m:
compiler/size_prof.m:
compiler/stm_expand.m:
compiler/term_util.m:
compiler/unify_gen_construct.m:
compiler/unify_gen_util.m:
compiler/unused_args.m:
Conform to the changes above.
1597 lines
66 KiB
Mathematica
1597 lines
66 KiB
Mathematica
%---------------------------------------------------------------------------e
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------e
|
|
% Copyright (C) 1994-2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2018 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module ll_backend.unify_gen_construct.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module ll_backend.code_info.
|
|
:- import_module ll_backend.code_loc_dep.
|
|
:- import_module ll_backend.global_data.
|
|
:- import_module ll_backend.llds.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% A construction unification is implemented as a simple assignment
|
|
% of a function symbol if the function symbol has arity zero.
|
|
% If the function symbol's arity is greater than zero, and all its
|
|
% arguments are constants, the construction is implemented by
|
|
% constructing the new term statically. If not all the arguments are
|
|
% constants, the construction is implemented as a heap-increment
|
|
% to create a term, and a series of [optional] assignments to
|
|
% instantiate the arguments of that term.
|
|
%
|
|
:- pred generate_construction_unification(prog_var::in, cons_id::in,
|
|
list(prog_var)::in, list(unify_mode)::in, how_to_construct::in,
|
|
list(int)::in, maybe(term_size_value)::in, hlds_goal_info::in,
|
|
llds_code::out,
|
|
code_info::in, code_info::out, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred generate_ground_term(prog_var::in, hlds_goal::in,
|
|
code_info::in, code_info::out, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred generate_const_structs(module_info::in, const_struct_map::out,
|
|
global_data::in, global_data::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module backend_libs.
|
|
:- import_module backend_libs.proc_label.
|
|
:- import_module backend_libs.rtti.
|
|
:- import_module backend_libs.type_class_info.
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.const_struct.
|
|
:- import_module hlds.goal_form.
|
|
:- import_module hlds.hlds_code_util.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.hlds_rtti.
|
|
:- import_module hlds.vartypes.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module ll_backend.closure_gen.
|
|
:- import_module ll_backend.code_util.
|
|
:- import_module ll_backend.layout.
|
|
:- import_module ll_backend.unify_gen_deconstruct.
|
|
:- import_module ll_backend.unify_gen_util.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module uint16.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_construction_unification(LHSVar, ConsId, RHSVars, ArgModes,
|
|
HowToConstruct0, TakeAddr, MaybeSize, GoalInfo, Code, !CI, !CLD) :-
|
|
get_module_info(!.CI, ModuleInfo),
|
|
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
|
|
associate_cons_id_args_with_widths(ModuleInfo, ConsId,
|
|
RHSVars, RHSVarsWidths),
|
|
(
|
|
% Constants.
|
|
( ConsTag = int_tag(_)
|
|
; ConsTag = float_tag(_)
|
|
; ConsTag = string_tag(_)
|
|
; ConsTag = foreign_tag(_, _)
|
|
; ConsTag = dummy_tag
|
|
; ConsTag = shared_local_tag_no_args(_, _, _)
|
|
; ConsTag = ground_term_const_tag(_, _)
|
|
; ConsTag = type_info_const_tag(_)
|
|
; ConsTag = typeclass_info_const_tag(_)
|
|
; ConsTag = type_ctor_info_tag(_, _, _)
|
|
; ConsTag = base_typeclass_info_tag(_, _, _)
|
|
; ConsTag = deep_profiling_proc_layout_tag(_, _)
|
|
; ConsTag = tabling_info_tag(_, _)
|
|
; ConsTag = table_io_entry_tag(_, _)
|
|
),
|
|
expect(unify(RHSVars, []), $pred, "constant has arguments"),
|
|
(
|
|
ConsTag = int_tag(IntTag),
|
|
int_tag_to_const_and_int_type(IntTag, Const, _),
|
|
ConstRval = const(Const)
|
|
;
|
|
ConsTag = float_tag(Float),
|
|
ConstRval = const(llconst_float(Float))
|
|
;
|
|
ConsTag = string_tag(String),
|
|
ConstRval = const(llconst_string(String))
|
|
;
|
|
ConsTag = foreign_tag(Lang, Value),
|
|
expect(unify(Lang, lang_c), $pred,
|
|
"foreign_tag for language other than C"),
|
|
ConstRval = const(llconst_foreign(Value, lt_int(int_type_int)))
|
|
;
|
|
ConsTag = dummy_tag,
|
|
% XXX The assignment is likely to be dead code, but *proving*
|
|
% that the assigned-to variable is never used is difficult.
|
|
ConstRval = const(llconst_int(0))
|
|
;
|
|
ConsTag = shared_local_tag_no_args(_Ptag, LocalSectag, _MustMask),
|
|
LocalSectag = local_sectag(_, PrimSec, _),
|
|
ConstRval = const(llconst_uint(PrimSec))
|
|
;
|
|
( ConsTag = type_info_const_tag(ConstNum)
|
|
; ConsTag = typeclass_info_const_tag(ConstNum)
|
|
; ConsTag = ground_term_const_tag(ConstNum, _)
|
|
),
|
|
get_const_struct_map(!.CI, ConstStructMap),
|
|
map.lookup(ConstStructMap, ConstNum, TypedRval),
|
|
TypedRval = typed_rval(ConstRval, _Type)
|
|
;
|
|
ConsTag = type_ctor_info_tag(ModuleName, TypeName, TypeArity),
|
|
RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName,
|
|
uint16.det_from_int(TypeArity)),
|
|
DataId = rtti_data_id(ctor_rtti_id(RttiTypeCtor,
|
|
type_ctor_type_ctor_info)),
|
|
ConstRval = const(llconst_data_addr(DataId, no))
|
|
;
|
|
ConsTag = base_typeclass_info_tag(ModuleName, ClassId, Instance),
|
|
TCName = generate_class_name(ClassId),
|
|
DataId = rtti_data_id(tc_rtti_id(TCName,
|
|
type_class_base_typeclass_info(ModuleName, Instance))),
|
|
ConstRval = const(llconst_data_addr(DataId, no))
|
|
;
|
|
ConsTag = deep_profiling_proc_layout_tag(PredId, ProcId),
|
|
RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
|
|
Origin = RttiProcLabel ^ rpl_pred_info_origin,
|
|
( if Origin = origin_special_pred(_, _) then
|
|
UserOrUCI = uci
|
|
else
|
|
UserOrUCI = user
|
|
),
|
|
ProcKind = proc_layout_proc_id(UserOrUCI),
|
|
DataId = layout_id(proc_layout(RttiProcLabel, ProcKind)),
|
|
ConstRval = const(llconst_data_addr(DataId, no))
|
|
;
|
|
ConsTag = tabling_info_tag(PredId, ProcId),
|
|
ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId),
|
|
DataId = proc_tabling_data_id(ProcLabel, tabling_info),
|
|
ConstRval = const(llconst_data_addr(DataId, no))
|
|
;
|
|
ConsTag = table_io_entry_tag(PredId, ProcId),
|
|
PredProcId = proc(PredId, ProcId),
|
|
DataId = layout_slot_id(table_io_entry_id, PredProcId),
|
|
ConstRval = const(llconst_data_addr(DataId, no))
|
|
),
|
|
assign_const_to_var(LHSVar, ConstRval, !.CI, !CLD),
|
|
Code = empty
|
|
;
|
|
ConsTag = remote_args_tag(RemoteArgsTagInfo),
|
|
FirstArgNum0 = 1,
|
|
get_may_use_atomic_alloc(!.CI, MayUseAtomic0),
|
|
(
|
|
(
|
|
RemoteArgsTagInfo = remote_args_only_functor,
|
|
Ptag = ptag(0u8)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_unshared(Ptag)
|
|
),
|
|
TagwordCode = empty,
|
|
generate_and_pack_construct_args(RHSVarsWidths, ArgModes,
|
|
FirstArgNum0, TakeAddr, CellArgs, MayUseAtomic0, MayUseAtomic,
|
|
empty, NonTagwordCode, !.CI, !CLD)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_shared(Ptag, RemoteSectag),
|
|
RemoteSectag = remote_sectag(SectagUint, SectagSize),
|
|
(
|
|
SectagSize = rsectag_word,
|
|
FirstArgNum = FirstArgNum0,
|
|
TagwordRval = const(llconst_uint(SectagUint)),
|
|
NonTagwordRHSVarsWidths = RHSVarsWidths,
|
|
NonTagwordArgModes = ArgModes,
|
|
TagwordCode = empty
|
|
;
|
|
SectagSize = rsectag_subword(_),
|
|
take_tagword_args_widths_modes(RHSVarsWidths, ArgModes,
|
|
TagwordRHSVarsWidths, TagwordArgModes,
|
|
NonTagwordRHSVarsWidths, NonTagwordArgModes,
|
|
FirstArgNum0, FirstArgNum),
|
|
( if SectagUint = 0u then
|
|
RevToOrRvals0 = []
|
|
else
|
|
RevToOrRvals0 = [const(llconst_uint(SectagUint))]
|
|
),
|
|
generate_and_pack_tagword(
|
|
TagwordRHSVarsWidths, TagwordArgModes,
|
|
RevToOrRvals0, RevToOrRvals, !.CI),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
TagwordRval0 = bitwise_or_rvals(ToOrRvals),
|
|
materialize_vars_in_rval(TagwordRval0, TagwordRval,
|
|
TagwordCode, !.CI, !CLD)
|
|
),
|
|
TagwordArg = cell_arg_full_word(TagwordRval, complete),
|
|
generate_and_pack_construct_args(
|
|
NonTagwordRHSVarsWidths, NonTagwordArgModes,
|
|
FirstArgNum, TakeAddr, CellArgs0,
|
|
MayUseAtomic0, MayUseAtomic, empty, NonTagwordCode,
|
|
!.CI, !CLD),
|
|
CellArgs = [TagwordArg | CellArgs0]
|
|
;
|
|
RemoteArgsTagInfo = remote_args_ctor(_),
|
|
% These are supported only on the MLDS backend.
|
|
unexpected($pred, "remote_args_ctor")
|
|
),
|
|
pack_how_to_construct(RHSVarsWidths, HowToConstruct0, HowToConstruct),
|
|
Context = goal_info_get_context(GoalInfo),
|
|
construct_cell(LHSVar, Ptag, CellArgs, HowToConstruct, MaybeSize,
|
|
Context, MayUseAtomic, ConstructCode, !CI, !CLD),
|
|
Code = TagwordCode ++ NonTagwordCode ++ ConstructCode
|
|
;
|
|
ConsTag = local_args_tag(LocalArgsTagInfo),
|
|
expect(unify(TakeAddr, []), $pred, "local_args_tag, TakeAddr != []"),
|
|
maybe_accumulate_local_sectag(LocalArgsTagInfo, RevToOrRvals0),
|
|
generate_and_pack_tagword(RHSVarsWidths, ArgModes,
|
|
RevToOrRvals0, RevToOrRvals, !.CI),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
PackedRval = bitwise_or_rvals(ToOrRvals),
|
|
assign_expr_to_var(LHSVar, PackedRval, Code, !CLD)
|
|
;
|
|
ConsTag = no_tag,
|
|
expect(unify(TakeAddr, []), $pred, "notag: take_addr"),
|
|
get_notag_or_direct_arg_arg_mode(RHSVars, ArgModes, RHSVar, ArgMode),
|
|
RHSType = variable_type(!.CI, RHSVar),
|
|
% Information can flow to the left as well as to the right
|
|
% in deconstructions.
|
|
generate_deconstruct_no_tag_unify_arg(LHSVar, RHSVar, RHSType, ArgMode,
|
|
Code, !.CI, !CLD)
|
|
;
|
|
ConsTag = direct_arg_tag(Ptag),
|
|
expect(unify(TakeAddr, []), $pred, "direct_arg_tag: take_addr"),
|
|
get_notag_or_direct_arg_arg_mode(RHSVars, ArgModes, RHSVar, ArgMode),
|
|
Type = variable_type(!.CI, RHSVar),
|
|
generate_direct_arg_construct(LHSVar, RHSVar, Ptag,
|
|
ArgMode, Type, Code, !.CI, !CLD)
|
|
;
|
|
ConsTag = closure_tag(PredId, ProcId, EvalMethod),
|
|
expect(unify(TakeAddr, []), $pred, "closure_tag has take_addr"),
|
|
expect(unify(MaybeSize, no), $pred, "closure_tag has size"),
|
|
construct_closure(PredId, ProcId, EvalMethod, LHSVar, RHSVars,
|
|
GoalInfo, Code, !CI, !CLD)
|
|
).
|
|
|
|
% Create a list of cell_args for the argument words or double words
|
|
% for a construction unification, while packing sub-word arguments
|
|
% into words.
|
|
%
|
|
:- pred generate_and_pack_construct_args(
|
|
list(arg_and_width(prog_var))::in, list(unify_mode)::in,
|
|
int::in, list(int)::in, list(cell_arg)::out,
|
|
may_use_atomic_alloc::in, may_use_atomic_alloc::out,
|
|
llds_code::in, llds_code::out,
|
|
code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_and_pack_construct_args([], [], _, !.TakeAddr, [],
|
|
!MayUseAtomic, !Code, _, !CLD) :-
|
|
expect(unify(!.TakeAddr, []), $pred, "TakeAddr != [] at end").
|
|
generate_and_pack_construct_args([], [_ | _], _, _, _,
|
|
!MayUseAtomic, !Code, _, !CLD) :-
|
|
unexpected($pred, "length mismatch").
|
|
generate_and_pack_construct_args([_ | _], [], _, _, _,
|
|
!MayUseAtomic, !Code, _, !CLD) :-
|
|
unexpected($pred, "length mismatch").
|
|
generate_and_pack_construct_args([RHSVarWidth | RHSVarsWidths],
|
|
[ArgMode | ArgModes], CurArgNum, !.TakeAddr, CellArgs,
|
|
!MayUseAtomic, !Code, CI, !CLD) :-
|
|
RHSVarWidth = arg_and_width(RHSVar, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
),
|
|
( if !.TakeAddr = [CurArgNum | !:TakeAddr] then
|
|
get_lcmc_null(CI, LCMCNull),
|
|
(
|
|
ArgPosWidth = apw_full(_, _),
|
|
(
|
|
LCMCNull = no,
|
|
MaybeNull = no
|
|
;
|
|
LCMCNull = yes,
|
|
MaybeNull = yes(const(llconst_int(0)))
|
|
),
|
|
HeadCellArgs = [cell_arg_take_addr_one_word(RHSVar, MaybeNull)]
|
|
;
|
|
ArgPosWidth = apw_double(_, _, _),
|
|
(
|
|
LCMCNull = no,
|
|
MaybeNulls = no
|
|
;
|
|
LCMCNull = yes,
|
|
Null = const(llconst_int(0)),
|
|
MaybeNulls = yes({Null, Null})
|
|
),
|
|
HeadCellArgs =
|
|
[cell_arg_take_addr_two_words(RHSVar, MaybeNulls)]
|
|
),
|
|
!:MayUseAtomic = may_not_use_atomic_alloc
|
|
else
|
|
generate_construct_arg_rval(RHSVar, ArgMode, RHSType, IsReal,
|
|
RHSRval, !Code, CI, !CLD),
|
|
get_module_info(CI, ModuleInfo),
|
|
% XXX Should we update !MayUseAtomic for dummy types?
|
|
update_type_may_use_atomic_alloc(ModuleInfo, RHSType,
|
|
!MayUseAtomic),
|
|
(
|
|
ArgPosWidth = apw_full(_, _),
|
|
(
|
|
IsReal = not_real_input_arg,
|
|
HeadCellArgs = [cell_arg_skip_one_word]
|
|
;
|
|
IsReal = real_input_arg,
|
|
HeadCellArgs = [cell_arg_full_word(RHSRval, complete)]
|
|
)
|
|
;
|
|
ArgPosWidth = apw_double(_, _, _),
|
|
(
|
|
IsReal = not_real_input_arg,
|
|
HeadCellArgs = [cell_arg_skip_two_words]
|
|
;
|
|
IsReal = real_input_arg,
|
|
HeadCellArgs = [cell_arg_double_word(RHSRval)]
|
|
)
|
|
)
|
|
),
|
|
LeftOverRHSVarsWidths = RHSVarsWidths,
|
|
LeftOverArgModes = ArgModes,
|
|
LeftOverArgNum = CurArgNum + 1
|
|
;
|
|
ArgPosWidth = apw_partial_first(_, _, Shift, _, _, Fill),
|
|
expect(not_taking_addr_of_cur_arg(!.TakeAddr, CurArgNum), $pred,
|
|
"taking address of partial word"),
|
|
generate_construct_arg_rval(RHSVar, ArgMode, RHSType, IsReal,
|
|
RHSRval, !Code, CI, !CLD),
|
|
get_module_info(CI, ModuleInfo),
|
|
update_type_may_use_atomic_alloc(ModuleInfo, RHSType, !MayUseAtomic),
|
|
(
|
|
IsReal = not_real_input_arg,
|
|
Completeness0 = incomplete,
|
|
RevToOrRvals0 = []
|
|
;
|
|
IsReal = real_input_arg,
|
|
Completeness0 = complete,
|
|
maybe_shift_and_accumulate_or_rval(RHSRval, Shift, Fill,
|
|
[], RevToOrRvals0)
|
|
),
|
|
NextArgNum = CurArgNum + 1,
|
|
% Since we define a word to be the same size as a pointer,
|
|
% a sub-word-sized argument cannot possibly hold a pointer.
|
|
% this is why we don't need to update !MayUseAtomic here.
|
|
generate_and_pack_one_cons_word(RHSVarsWidths, ArgModes,
|
|
LeftOverRHSVarsWidths, LeftOverArgModes,
|
|
NextArgNum, LeftOverArgNum, !TakeAddr,
|
|
RevToOrRvals0, RevToOrRvals, Completeness0, Completeness,
|
|
!Code, CI, !CLD),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
PackedRval = bitwise_or_rvals(ToOrRvals),
|
|
% ARG_PACK: Attach Completeness to the *vector* of cell args,
|
|
% not to each *individual* cell arg.
|
|
HeadCellArgs = [cell_arg_full_word(PackedRval, Completeness)]
|
|
;
|
|
ArgPosWidth = apw_none_nowhere,
|
|
expect(not_taking_addr_of_cur_arg(!.TakeAddr, CurArgNum), $pred,
|
|
"taking address of dummy"),
|
|
HeadCellArgs = [],
|
|
LeftOverRHSVarsWidths = RHSVarsWidths,
|
|
LeftOverArgModes = ArgModes,
|
|
LeftOverArgNum = CurArgNum + 1
|
|
;
|
|
ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _),
|
|
unexpected($pred, "apw_partial_shifted")
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _),
|
|
unexpected($pred, "apw_none_shifted")
|
|
),
|
|
generate_and_pack_construct_args(LeftOverRHSVarsWidths, LeftOverArgModes,
|
|
LeftOverArgNum, !.TakeAddr, TailCellArgs,
|
|
!MayUseAtomic, !Code, CI, !CLD),
|
|
CellArgs = HeadCellArgs ++ TailCellArgs.
|
|
|
|
:- pred generate_and_pack_one_cons_word(
|
|
list(arg_and_width(prog_var))::in, list(unify_mode)::in,
|
|
list(arg_and_width(prog_var))::out, list(unify_mode)::out,
|
|
int::in, int::out, list(int)::in, list(int)::out,
|
|
list(rval)::in, list(rval)::out, completeness::in, completeness::out,
|
|
llds_code::in, llds_code::out,
|
|
code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_and_pack_one_cons_word([], [], [], [], CurArgNum, LeftOverArgNum,
|
|
!TakeAddr, !RevToOrRvals, !Completeness, !Code, _, !CLD) :-
|
|
LeftOverArgNum = CurArgNum.
|
|
generate_and_pack_one_cons_word([], [_ | _], _, _, _, _,
|
|
!TakeAddr, !RevToOrRvals, !Completeness, !Code, _, !CLD) :-
|
|
unexpected($pred, "length misnatch").
|
|
generate_and_pack_one_cons_word([_ | _], [], _, _, _, _,
|
|
!TakeAddr, !RevToOrRvals, !Completeness, !Code, _, !CLD) :-
|
|
unexpected($pred, "length misnatch").
|
|
generate_and_pack_one_cons_word([RHSVarWidth | RHSVarsWidths],
|
|
[ArgMode | ArgModes], LeftOverRHSVarsWidths, LeftOverArgModes,
|
|
CurArgNum, LeftOverArgNum,
|
|
!TakeAddr, !RevToOrRvals, !Completeness, !Code, CI, !CLD) :-
|
|
RHSVarWidth = arg_and_width(RHSVar, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
),
|
|
% This argument is not part of this word.
|
|
LeftOverRHSVarsWidths = [RHSVarWidth | RHSVarsWidths],
|
|
LeftOverArgModes = [ArgMode | ArgModes],
|
|
LeftOverArgNum = CurArgNum
|
|
;
|
|
( ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
% This argument *is* part of this word.
|
|
expect(not_taking_addr_of_cur_arg(!.TakeAddr, CurArgNum), $pred,
|
|
"taking address of partial word"),
|
|
generate_construct_arg_rval(RHSVar, ArgMode, _RHSType, IsReal, RHSRval,
|
|
!Code, CI, !CLD),
|
|
(
|
|
ArgPosWidth = apw_partial_shifted(_, _, Shift, _, _, Fill),
|
|
(
|
|
IsReal = not_real_input_arg,
|
|
!:Completeness = incomplete
|
|
;
|
|
IsReal = real_input_arg,
|
|
maybe_shift_and_accumulate_or_rval(RHSRval, Shift, Fill,
|
|
!RevToOrRvals)
|
|
)
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _)
|
|
% We change neither !Completeness nor !RevToOrRvals.
|
|
),
|
|
NextArgNum = CurArgNum + 1,
|
|
generate_and_pack_one_cons_word(RHSVarsWidths, ArgModes,
|
|
LeftOverRHSVarsWidths, LeftOverArgModes, NextArgNum, LeftOverArgNum,
|
|
!TakeAddr, !RevToOrRvals, !Completeness, !Code, CI, !CLD)
|
|
).
|
|
|
|
:- pred generate_and_pack_tagword(
|
|
list(arg_and_width(prog_var))::in, list(unify_mode)::in,
|
|
list(rval)::in, list(rval)::out, code_info::in) is det.
|
|
|
|
generate_and_pack_tagword([], [], !RevToOrRvals, _).
|
|
generate_and_pack_tagword([], [_ | _], !RevToOrRvals, _) :-
|
|
unexpected($pred, "length misnatch").
|
|
generate_and_pack_tagword([_ | _], [], !RevToOrRvals, _) :-
|
|
unexpected($pred, "length misnatch").
|
|
generate_and_pack_tagword([RHSVarWidth | RHSVarsWidths], [ArgMode | ArgModes],
|
|
!RevToOrRvals, CI) :-
|
|
RHSVarWidth = arg_and_width(RHSVar, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
),
|
|
unexpected($pred, "ArgPosWidth is not a packed arg_pos_width")
|
|
;
|
|
ArgPosWidth = apw_partial_shifted(_, _, Shift, _, _, Fill),
|
|
is_arg_unify_real(CI, RHSVar, ArgMode, _RHSType, IsReal),
|
|
(
|
|
IsReal = not_real_input_arg,
|
|
RHSRval = const(llconst_uint(0u)) % Dummy.
|
|
;
|
|
IsReal = real_input_arg,
|
|
RHSRval = var(RHSVar)
|
|
),
|
|
ShiftedRHSRval = left_shift_rval(RHSRval, Shift, Fill),
|
|
!:RevToOrRvals = [ShiftedRHSRval | !.RevToOrRvals]
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
generate_and_pack_tagword(RHSVarsWidths, ArgModes, !RevToOrRvals, CI).
|
|
|
|
:- pred generate_construct_arg_rval(prog_var::in, unify_mode::in,
|
|
mer_type::out, maybe_real_input_arg::out, rval::out,
|
|
llds_code::in, llds_code::out,
|
|
code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_construct_arg_rval(RHSVar, ArgMode, RHSType, IsReal, RHSRval,
|
|
!Code, CI, !CLD) :-
|
|
is_arg_unify_real(CI, RHSVar, ArgMode, RHSType, IsReal),
|
|
(
|
|
IsReal = not_real_input_arg,
|
|
RHSRval = const(llconst_uint(0u)) % Dummy.
|
|
;
|
|
IsReal = real_input_arg,
|
|
produce_variable(RHSVar, RHSVarCode, RHSRval, CI, !CLD),
|
|
!:Code = !.Code ++ RHSVarCode
|
|
).
|
|
|
|
:- type maybe_real_input_arg
|
|
---> not_real_input_arg
|
|
% The argument is either input to the construction unification
|
|
% but of a dummy type, or it is not an input to the construction.
|
|
% The rval next to this is a dummy.
|
|
; real_input_arg.
|
|
% The argument is an input to the construction unification
|
|
% and its type is not a dummy type. The rval next to this is real.
|
|
% (The reason why we don't store the rval as an argument of
|
|
% real_input_arg, making this type a synonym for the maybe type,
|
|
% is to avoid the memory allocation that this would require;
|
|
% construction unifications are one of the most frequent types
|
|
% of goals.)
|
|
|
|
:- pred is_arg_unify_real(code_info::in, prog_var::in,
|
|
unify_mode::in, mer_type::out, maybe_real_input_arg::out) is det.
|
|
|
|
is_arg_unify_real(CI, RHSVar, ArgMode, RHSType, IsReal) :-
|
|
get_module_info(CI, ModuleInfo),
|
|
ArgMode = unify_modes_li_lf_ri_rf(_, _, RHSInitInst, RHSFinalInst),
|
|
get_vartypes(CI, VarTypes),
|
|
lookup_var_type(VarTypes, RHSVar, RHSType),
|
|
init_final_insts_to_top_functor_mode(ModuleInfo, RHSInitInst, RHSFinalInst,
|
|
RHSType, RHSTopFunctorMode),
|
|
(
|
|
RHSTopFunctorMode = top_in,
|
|
IsDummy = variable_is_of_dummy_type(CI, RHSVar),
|
|
(
|
|
IsDummy = is_dummy_type,
|
|
IsReal = not_real_input_arg
|
|
;
|
|
IsDummy = is_not_dummy_type,
|
|
IsReal = real_input_arg
|
|
)
|
|
;
|
|
( RHSTopFunctorMode = top_out
|
|
; RHSTopFunctorMode = top_unused
|
|
),
|
|
IsReal = not_real_input_arg
|
|
).
|
|
|
|
:- pred construct_cell(prog_var::in, ptag::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, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
construct_cell(LHSVar, Ptag, CellArgs, HowToConstruct, MaybeSize, Context,
|
|
MayUseAtomic, Code, !CI, !CLD) :-
|
|
LHSType = variable_type(!.CI, LHSVar),
|
|
var_type_msg(LHSType, VarTypeMsg),
|
|
% If we are doing accurate GC, then for types which hold RTTI that
|
|
% will be traversed by the collector at GC-time, we need to allocate
|
|
% an extra word at the start, to hold the forwarding pointer.
|
|
% Normally we would just overwrite the first word of the object
|
|
% in the "from" space, but this can't be done for objects which will be
|
|
% referenced during the garbage collection process.
|
|
get_gc_method(!.CI, GCMethod),
|
|
( if
|
|
GCMethod = gc_accurate,
|
|
is_introduced_type_info_type(LHSType)
|
|
then
|
|
ReserveWordAtStart = yes
|
|
else
|
|
ReserveWordAtStart = no
|
|
),
|
|
Size = size_of_cell_args(CellArgs),
|
|
maybe_add_alloc_site_info(Context, VarTypeMsg, Size, MaybeAllocId, !CI),
|
|
assign_cell_to_var(LHSVar, ReserveWordAtStart, Ptag, CellArgs,
|
|
HowToConstruct, MaybeSize, MaybeAllocId, MayUseAtomic, CellCode,
|
|
!CI, !CLD),
|
|
generate_field_addrs(CellArgs, FieldAddrs),
|
|
(
|
|
FieldAddrs = [],
|
|
% Optimize common case.
|
|
Code = CellCode
|
|
;
|
|
FieldAddrs = [_ | _],
|
|
% 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, LHSVar, Ptag,
|
|
FieldCode, !CLD),
|
|
Code = CellCode ++ FieldCode
|
|
).
|
|
|
|
:- pred var_type_msg(mer_type::in, string::out) is det.
|
|
|
|
var_type_msg(Type, Msg) :-
|
|
type_to_ctor_det(Type, TypeCtor),
|
|
TypeCtor = type_ctor(TypeSym, TypeArity),
|
|
TypeSymStr = sym_name_to_string(TypeSym),
|
|
string.int_to_string(TypeArity, TypeArityStr),
|
|
Msg = TypeSymStr ++ "/" ++ TypeArityStr.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type field_addr
|
|
---> field_addr(
|
|
fa_offset :: int,
|
|
fa_var :: prog_var
|
|
).
|
|
|
|
:- 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) :-
|
|
% XXX ARG_PACK We should be able to take the offsets for FieldAddrs
|
|
% from the ArgPosWidth of the field whose address is being taken.
|
|
% Counting offsets should *not* be necessary.
|
|
(
|
|
( CellArg = cell_arg_full_word(_, _)
|
|
; CellArg = cell_arg_skip_one_word
|
|
),
|
|
NextOffset = ArgOffset + 1
|
|
;
|
|
( CellArg = cell_arg_double_word(_)
|
|
; CellArg = cell_arg_skip_two_words
|
|
),
|
|
NextOffset = ArgOffset + 2
|
|
;
|
|
(
|
|
CellArg = cell_arg_take_addr_one_word(Var, _),
|
|
NextOffset = ArgOffset + 1
|
|
;
|
|
CellArg = cell_arg_take_addr_two_words(Var, _),
|
|
NextOffset = ArgOffset + 2
|
|
),
|
|
FieldAddr = field_addr(ArgOffset, Var),
|
|
!:RevFieldAddrs = [FieldAddr | !.RevFieldAddrs]
|
|
).
|
|
|
|
:- pred generate_field_take_address_assigns(list(field_addr)::in,
|
|
prog_var::in, ptag::in, llds_code::out,
|
|
code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_field_take_address_assigns([], _, _, empty, !CLD).
|
|
generate_field_take_address_assigns([FieldAddr | FieldAddrs],
|
|
CellVar, CellPtag, ThisCode ++ RestCode, !CLD) :-
|
|
FieldAddr = field_addr(FieldNum, Var),
|
|
FieldNumRval = const(llconst_int(FieldNum)),
|
|
Addr = mem_addr(heap_ref(var(CellVar), yes(CellPtag), FieldNumRval)),
|
|
assign_expr_to_var(Var, Addr, ThisCode, !CLD),
|
|
generate_field_take_address_assigns(FieldAddrs, CellVar, CellPtag,
|
|
RestCode, !CLD).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate a direct arg unification between
|
|
% - the left-hand-side (the whole term), and
|
|
% - the right-hand-side (the one argument).
|
|
%
|
|
:- pred generate_direct_arg_construct(prog_var::in, prog_var::in, ptag::in,
|
|
unify_mode::in, mer_type::in, llds_code::out,
|
|
code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_direct_arg_construct(Var, ArgVar, Ptag, ArgMode, Type, Code,
|
|
CI, !CLD) :-
|
|
get_module_info(CI, ModuleInfo),
|
|
compute_assign_direction(ModuleInfo, ArgMode, Type, Dir),
|
|
(
|
|
Dir = assign_right,
|
|
unexpected($pred, "assign right in construction")
|
|
;
|
|
Dir = assign_left,
|
|
( if Ptag = ptag(0u8) then
|
|
assign_var_to_var(Var, ArgVar, !CLD),
|
|
Code = empty
|
|
else
|
|
assign_expr_to_var(Var, mkword(Ptag, var(ArgVar)), Code, !CLD)
|
|
)
|
|
;
|
|
Dir = assign_unused,
|
|
% Construct a tagged pointer to a pointer value
|
|
% which is as yet unknown.
|
|
% XXX This will have to change if we start to support aliasing.
|
|
assign_const_to_var(Var, mkword_hole(Ptag), CI, !CLD),
|
|
Code = empty
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred pack_how_to_construct(list(arg_and_width(prog_var))::in,
|
|
how_to_construct::in, how_to_construct::out) is det.
|
|
|
|
pack_how_to_construct(ArgVarsWidths, !HowToConstruct) :-
|
|
(
|
|
( !.HowToConstruct = construct_statically
|
|
; !.HowToConstruct = construct_dynamically
|
|
; !.HowToConstruct = construct_in_region(_)
|
|
)
|
|
;
|
|
!.HowToConstruct = reuse_cell(CellToReuse0),
|
|
% If any argument packed into a word needs updating,
|
|
% the whole word needs updating.
|
|
% XXX This code changes the meaning of the third argument of
|
|
% cell_to_reuse, from having one element for each *argument*,
|
|
% to one element for each *word* or *double word*.
|
|
% I (zs) see two problems with this. First, the change in
|
|
% meaning is not reflected in the data structure anywhere,
|
|
% and second, given the potential presence of double-word floats,
|
|
% you cannot say simply that the Nth element of NeedsUpdates
|
|
% corresponds to the Nth word of the memory cell.
|
|
% Given that the different ConsIds may have double-word floats
|
|
% in different word positions, I don't see how a correctness
|
|
% argument for this code could be made if we allowed reuse of a cell
|
|
% that originally stored a term with one cons_id for a term with
|
|
% a different cons_id. This is why we currently don't allow such reuse
|
|
% even though such reuse would significantly expand the set of
|
|
% opportunities for reuse.
|
|
CellToReuse0 = cell_to_reuse(Var, ConsIds, NeedsUpdates0),
|
|
needs_update_args_to_words(ArgVarsWidths, NeedsUpdates0, NeedsUpdates),
|
|
CellToReuse = cell_to_reuse(Var, ConsIds, NeedsUpdates),
|
|
!:HowToConstruct = reuse_cell(CellToReuse)
|
|
).
|
|
|
|
:- pred needs_update_args_to_words(list(arg_and_width(prog_var))::in,
|
|
list(needs_update)::in, list(needs_update)::out) is det.
|
|
|
|
needs_update_args_to_words([], [], []).
|
|
needs_update_args_to_words([], [_ | _], _) :-
|
|
unexpected($pred, "mismatched lists").
|
|
needs_update_args_to_words([_ | _], [], []) :-
|
|
unexpected($pred, "mismatched lists").
|
|
needs_update_args_to_words([VarWidth | VarsWidths], [ArgNU | ArgNUs],
|
|
WordNUs) :-
|
|
VarWidth = arg_and_width(_Var, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
),
|
|
needs_update_args_to_words(VarsWidths, ArgNUs, TailWordNUs),
|
|
WordNUs = [ArgNU | TailWordNUs]
|
|
;
|
|
ArgPosWidth = apw_partial_first(_, _, _, _, _, _),
|
|
does_any_arg_in_word_need_update(VarsWidths, ArgNUs, ArgNU, WordNU,
|
|
LaterWordVarsWidths, LaterWordArgNUs),
|
|
needs_update_args_to_words(LaterWordVarsWidths, LaterWordArgNUs,
|
|
TailWordNUs),
|
|
WordNUs = [WordNU | TailWordNUs]
|
|
;
|
|
ArgPosWidth = apw_none_nowhere,
|
|
needs_update_args_to_words(VarsWidths, ArgNUs, WordNUs)
|
|
;
|
|
ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _),
|
|
unexpected($pred, "apw_partial_shifted")
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _),
|
|
unexpected($pred, "none_shifted")
|
|
).
|
|
|
|
:- pred does_any_arg_in_word_need_update(
|
|
list(arg_and_width(prog_var))::in, list(needs_update)::in,
|
|
needs_update::in, needs_update::out,
|
|
list(arg_and_width(prog_var))::out, list(needs_update)::out) is det.
|
|
|
|
does_any_arg_in_word_need_update([], [], !NU, [], []).
|
|
does_any_arg_in_word_need_update([], [_ | _], !NU, _, _) :-
|
|
unexpected($pred, "mismatched lists").
|
|
does_any_arg_in_word_need_update([_ | _], [], !NU, _, _) :-
|
|
unexpected($pred, "mismatched lists").
|
|
does_any_arg_in_word_need_update([VarWidth | VarsWidths], [ArgNU | ArgNUs],
|
|
!NU, LaterWordVarsWidths, LaterWordArgNUs) :-
|
|
VarWidth = arg_and_width(_Var, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
),
|
|
LaterWordVarsWidths = [VarWidth | VarsWidths],
|
|
LaterWordArgNUs = [ArgNU | ArgNUs]
|
|
;
|
|
( ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
(
|
|
ArgNU = needs_update,
|
|
!:NU = needs_update
|
|
;
|
|
ArgNU = does_not_need_update
|
|
),
|
|
does_any_arg_in_word_need_update(VarsWidths, ArgNUs, !NU,
|
|
LaterWordVarsWidths, LaterWordArgNUs)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_ground_term(TermVar, Goal, !CI, !CLD) :-
|
|
get_from_ground_term_construct_info(TermVar, Goal,
|
|
TermVarIsNeeded, Conjuncts, GoalInfo),
|
|
(
|
|
TermVarIsNeeded = termvar_is_not_needed
|
|
% There is nothing to do.
|
|
;
|
|
TermVarIsNeeded = termvar_is_needed,
|
|
get_module_info(!.CI, ModuleInfo),
|
|
get_exprn_opts(!.CI, ExprnOpts),
|
|
get_static_cell_info(!.CI, StaticCellInfo0),
|
|
map.init(ActiveMap0),
|
|
generate_ground_term_conjuncts(ModuleInfo, ExprnOpts,
|
|
Conjuncts, StaticCellInfo0, StaticCellInfo,
|
|
ActiveMap0, ActiveMap),
|
|
map.to_assoc_list(ActiveMap, ActivePairs),
|
|
( if ActivePairs = [TermVar - GroundTerm] then
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
add_forward_live_vars(NonLocals, !CLD),
|
|
set_static_cell_info(StaticCellInfo, !CI),
|
|
GroundTerm = typed_rval(Rval, _),
|
|
assign_const_to_var(TermVar, Rval, !.CI, !CLD)
|
|
else
|
|
unexpected($pred, "no active pairs")
|
|
)
|
|
).
|
|
|
|
:- type active_ground_term_map == map(prog_var, typed_rval).
|
|
|
|
:- pred generate_ground_term_conjuncts(module_info::in, exprn_opts::in,
|
|
list(hlds_goal)::in, static_cell_info::in, static_cell_info::out,
|
|
active_ground_term_map::in, active_ground_term_map::out) is det.
|
|
|
|
generate_ground_term_conjuncts(_ModuleInfo, _ExprnOpts, [],
|
|
!StaticCellInfo, !ActiveMap).
|
|
generate_ground_term_conjuncts(ModuleInfo, ExprnOpts, [Goal | Goals],
|
|
!StaticCellInfo, !ActiveMap) :-
|
|
generate_ground_term_conjunct(ModuleInfo, ExprnOpts, Goal,
|
|
!StaticCellInfo, !ActiveMap),
|
|
generate_ground_term_conjuncts(ModuleInfo, ExprnOpts, Goals,
|
|
!StaticCellInfo, !ActiveMap).
|
|
|
|
:- pred generate_ground_term_conjunct(module_info::in, exprn_opts::in,
|
|
hlds_goal::in, static_cell_info::in, static_cell_info::out,
|
|
active_ground_term_map::in, active_ground_term_map::out) is det.
|
|
|
|
generate_ground_term_conjunct(ModuleInfo, ExprnOpts, Goal,
|
|
!StaticCellInfo, !ActiveMap) :-
|
|
get_from_ground_term_construct_conjunct_info(Goal, LHSVar, ConsId, RHSVars,
|
|
_GoalInfo),
|
|
% The code of this predicate is very similar to the code of
|
|
% generate_const_struct_arg_tag. Any changes here may also
|
|
% require similar changes there.
|
|
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
|
|
(
|
|
(
|
|
ConsTag = int_tag(IntTag),
|
|
int_tag_to_const_and_int_type(IntTag, Const, IntType),
|
|
UnboxedInt64s = get_unboxed_int64s(ExprnOpts),
|
|
store_int_tag_statically(IntType, UnboxedInt64s,
|
|
may_not_store_double_width_natively, Type)
|
|
;
|
|
ConsTag = float_tag(Float),
|
|
Const = llconst_float(Float),
|
|
UnboxedFloats = get_unboxed_floats(ExprnOpts),
|
|
store_float_tag_statically(UnboxedFloats,
|
|
may_not_store_double_width_natively, Type)
|
|
;
|
|
ConsTag = string_tag(String),
|
|
Const = llconst_string(String),
|
|
Type = lt_string
|
|
;
|
|
ConsTag = foreign_tag(Lang, Val),
|
|
expect(unify(Lang, lang_c), $pred,
|
|
"foreign_tag for language other than C"),
|
|
Const = llconst_foreign(Val, lt_int(int_type_int)),
|
|
Type = lt_int(int_type_int)
|
|
;
|
|
ConsTag = dummy_tag,
|
|
Const = llconst_int(0),
|
|
Type = lt_int(int_type_int)
|
|
;
|
|
ConsTag = shared_local_tag_no_args(_Ptag, LocalSectag, _MustMask),
|
|
LocalSectag = local_sectag(_, PrimSec, _),
|
|
Const = llconst_uint(PrimSec),
|
|
Type = lt_data_ptr
|
|
),
|
|
expect(unify(RHSVars, []), $pred, "constant has args"),
|
|
ActiveGroundTerm = typed_rval(const(Const), Type),
|
|
map.det_insert(LHSVar, ActiveGroundTerm, !ActiveMap)
|
|
;
|
|
( ConsTag = ground_term_const_tag(_, _)
|
|
; ConsTag = type_info_const_tag(_)
|
|
; ConsTag = typeclass_info_const_tag(_)
|
|
; ConsTag = type_ctor_info_tag(_, _, _)
|
|
; ConsTag = base_typeclass_info_tag(_, _, _)
|
|
; ConsTag = deep_profiling_proc_layout_tag(_, _)
|
|
; ConsTag = tabling_info_tag(_, _)
|
|
; ConsTag = table_io_entry_tag(_, _)
|
|
),
|
|
unexpected($pred, "unexpected constant")
|
|
;
|
|
ConsTag = remote_args_tag(RemoteArgsTagInfo),
|
|
associate_cons_id_args_with_widths(ModuleInfo, ConsId,
|
|
RHSVars, RHSVarsWidths),
|
|
(
|
|
(
|
|
RemoteArgsTagInfo = remote_args_only_functor,
|
|
Ptag = ptag(0u8)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_unshared(Ptag)
|
|
),
|
|
generate_ground_term_args(RHSVarsWidths, PackedRHSTypedRvals,
|
|
!ActiveMap),
|
|
AllRHSTypedRvals = PackedRHSTypedRvals
|
|
;
|
|
RemoteArgsTagInfo = remote_args_shared(Ptag, RemoteSectag),
|
|
RemoteSectag = remote_sectag(SectagUint, SectagSize),
|
|
(
|
|
SectagSize = rsectag_word,
|
|
TagwordTypedRval = typed_rval(const(llconst_uint(SectagUint)),
|
|
lt_int(int_type_uint)),
|
|
NonTagwordRHSVarsWidths = RHSVarsWidths
|
|
;
|
|
SectagSize = rsectag_subword(_),
|
|
% XXX ARG_PACK Factor out this code pattern.
|
|
( if SectagUint = 0u then
|
|
RevToOrRvals0 = []
|
|
else
|
|
RevToOrRvals0 = [const(llconst_uint(SectagUint))]
|
|
),
|
|
generate_ground_term_args_for_one_word(RHSVarsWidths,
|
|
NonTagwordRHSVarsWidths, RevToOrRvals0, RevToOrRvals,
|
|
!ActiveMap),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
TagwordRval = bitwise_or_rvals(ToOrRvals),
|
|
TagwordTypedRval = typed_rval(TagwordRval,
|
|
lt_int(int_type_uint))
|
|
),
|
|
generate_ground_term_args(NonTagwordRHSVarsWidths,
|
|
NonTagwordPackedRHSTypedRvals, !ActiveMap),
|
|
AllRHSTypedRvals =
|
|
[TagwordTypedRval | NonTagwordPackedRHSTypedRvals]
|
|
;
|
|
RemoteArgsTagInfo = remote_args_ctor(_),
|
|
% These are supported only on the MLDS backend.
|
|
unexpected($pred, "remote_args_ctor")
|
|
),
|
|
add_scalar_static_cell(AllRHSTypedRvals, DataAddr, !StaticCellInfo),
|
|
MaybeOffset = no,
|
|
CellPtrConst = const(llconst_data_addr(DataAddr, MaybeOffset)),
|
|
LHSRval = mkword(Ptag, CellPtrConst),
|
|
ActiveGroundTerm = typed_rval(LHSRval, lt_data_ptr),
|
|
map.det_insert(LHSVar, ActiveGroundTerm, !ActiveMap)
|
|
;
|
|
ConsTag = local_args_tag(LocalArgsTagInfo),
|
|
expect_not(unify(RHSVars, []), $pred, "local_args_tag has no args"),
|
|
maybe_accumulate_local_sectag(LocalArgsTagInfo, RevToOrRvals0),
|
|
associate_cons_id_args_with_widths(ModuleInfo, ConsId,
|
|
RHSVars, RHSVarsWidths),
|
|
generate_ground_term_args_for_one_word(RHSVarsWidths,
|
|
LeftOverRHSVarsWidths, RevToOrRvals0, RevToOrRvals, !ActiveMap),
|
|
expect(unify(LeftOverRHSVarsWidths, []), $pred, "left over args"),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
PackedRval = bitwise_or_rvals(ToOrRvals),
|
|
ActiveGroundTerm = typed_rval(PackedRval, lt_data_ptr),
|
|
map.det_insert(LHSVar, ActiveGroundTerm, !ActiveMap)
|
|
;
|
|
ConsTag = no_tag,
|
|
get_notag_or_direct_arg_arg(RHSVars, RHSVar),
|
|
map.det_remove(RHSVar, RvalType, !ActiveMap),
|
|
map.det_insert(LHSVar, RvalType, !ActiveMap)
|
|
;
|
|
ConsTag = direct_arg_tag(Ptag),
|
|
get_notag_or_direct_arg_arg(RHSVars, RHSVar),
|
|
map.det_remove(RHSVar, typed_rval(RHSRval, _RvalType), !ActiveMap),
|
|
( if Ptag = ptag(0u8) then
|
|
LHSRval = RHSRval
|
|
else
|
|
LHSRval = mkword(Ptag, RHSRval)
|
|
),
|
|
ActiveGroundTerm = typed_rval(LHSRval, lt_data_ptr),
|
|
map.det_insert(LHSVar, ActiveGroundTerm, !ActiveMap)
|
|
;
|
|
% Lambda expressions cannot occur in from_ground_term_construct scopes
|
|
% during code generation, because if they do occur there originally,
|
|
% semantic analysis will change the scope reason to something else.
|
|
ConsTag = closure_tag(_, _, _),
|
|
unexpected($pred, "unexpected closure")
|
|
).
|
|
|
|
:- pred generate_ground_term_args(list(arg_and_width(prog_var))::in,
|
|
list(typed_rval)::out,
|
|
active_ground_term_map::in, active_ground_term_map::out) is det.
|
|
|
|
generate_ground_term_args([], [], !ActiveMap).
|
|
generate_ground_term_args([ArgVarWidth | ArgVarsWidths],
|
|
[TypedRval | TypedRvals], !ActiveMap) :-
|
|
ArgVarWidth = arg_and_width(ArgVar, ArgPosWidth),
|
|
map.det_remove(ArgVar, ArgTypedRval, !ActiveMap),
|
|
(
|
|
ArgPosWidth = apw_full(_, _),
|
|
TypedRval = ArgTypedRval,
|
|
generate_ground_term_args(ArgVarsWidths, TypedRvals, !ActiveMap)
|
|
;
|
|
ArgPosWidth = apw_double(_, _, DoubleWordKind),
|
|
% Though a standalone value of type float, int64 or int64
|
|
% might have needed to boxed, it may be stored in unboxed form
|
|
% as a constructor argument.
|
|
( if ArgTypedRval = typed_rval(ArgRval, lt_data_ptr) then
|
|
(
|
|
DoubleWordKind = dw_float,
|
|
TypedRval = typed_rval(ArgRval, lt_float)
|
|
;
|
|
DoubleWordKind = dw_int64,
|
|
TypedRval = typed_rval(ArgRval, lt_int(int_type_int64))
|
|
;
|
|
DoubleWordKind = dw_uint64,
|
|
TypedRval = typed_rval(ArgRval, lt_int(int_type_uint64))
|
|
)
|
|
else
|
|
TypedRval = ArgTypedRval
|
|
),
|
|
generate_ground_term_args(ArgVarsWidths, TypedRvals, !ActiveMap)
|
|
;
|
|
ArgPosWidth = apw_partial_first(_, _, Shift, _, _, Fill),
|
|
ArgTypedRval = typed_rval(ArgRval, _),
|
|
maybe_shift_and_accumulate_or_rval(ArgRval, Shift, Fill,
|
|
[], RevToOrRvals0),
|
|
generate_ground_term_args_for_one_word(ArgVarsWidths,
|
|
LeftOverArgVarsWidths, RevToOrRvals0, RevToOrRvals, !ActiveMap),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
PackedRval = bitwise_or_rvals(ToOrRvals),
|
|
TypedRval = typed_rval(PackedRval, lt_int(int_type_uint)),
|
|
generate_ground_term_args(LeftOverArgVarsWidths, TypedRvals,
|
|
!ActiveMap)
|
|
;
|
|
ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _),
|
|
unexpected($pred, "apw_partial_shifted")
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _),
|
|
unexpected($pred, "apw_none_shifted")
|
|
;
|
|
ArgPosWidth = apw_none_nowhere,
|
|
unexpected($pred, "apw_none_nowhere")
|
|
).
|
|
|
|
:- pred generate_ground_term_args_for_one_word(
|
|
list(arg_and_width(prog_var))::in, list(arg_and_width(prog_var))::out,
|
|
list(rval)::in, list(rval)::out,
|
|
active_ground_term_map::in, active_ground_term_map::out) is det.
|
|
|
|
generate_ground_term_args_for_one_word([], [], !RevToOrRvals, !ActiveMap).
|
|
generate_ground_term_args_for_one_word([ArgVarWidth | ArgVarsWidths],
|
|
LeftOverArgVarsWidths, !RevToOrRvals, !ActiveMap) :-
|
|
ArgVarWidth = arg_and_width(ArgVar, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
),
|
|
% These are not part of the current word.
|
|
LeftOverArgVarsWidths = [ArgVarWidth | ArgVarsWidths]
|
|
;
|
|
(
|
|
ArgPosWidth = apw_partial_shifted(_, _, Shift, _, _, Fill),
|
|
map.det_remove(ArgVar, ArgTypedRval, !ActiveMap),
|
|
ArgTypedRval = typed_rval(ArgRval, _ArgRvalType),
|
|
maybe_shift_and_accumulate_or_rval(ArgRval, Shift, Fill,
|
|
!RevToOrRvals)
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _),
|
|
map.det_remove(ArgVar, _ArgTypedRval, !ActiveMap)
|
|
),
|
|
generate_ground_term_args_for_one_word(ArgVarsWidths,
|
|
LeftOverArgVarsWidths, !RevToOrRvals, !ActiveMap)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_const_structs(ModuleInfo, ConstStructMap, !GlobalData) :-
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, unboxed_float, OptUnboxedFloats),
|
|
(
|
|
OptUnboxedFloats = yes,
|
|
UnboxedFloats = have_unboxed_floats
|
|
;
|
|
OptUnboxedFloats = no,
|
|
UnboxedFloats = do_not_have_unboxed_floats
|
|
),
|
|
globals.lookup_bool_option(Globals, unboxed_int64s, OptUnboxedInt64s),
|
|
(
|
|
OptUnboxedInt64s = yes,
|
|
UnboxedInt64s = have_unboxed_int64s
|
|
;
|
|
OptUnboxedInt64s = no,
|
|
UnboxedInt64s = do_not_have_unboxed_int64s
|
|
),
|
|
module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
|
|
const_struct_db_get_structs(ConstStructDb, ConstStructs),
|
|
global_data_get_static_cell_info(!.GlobalData, StaticCellInfo0),
|
|
list.foldl2(
|
|
generate_const_struct(ModuleInfo, UnboxedFloats, UnboxedInt64s),
|
|
ConstStructs, map.init, ConstStructMap,
|
|
StaticCellInfo0, StaticCellInfo),
|
|
global_data_set_static_cell_info(StaticCellInfo, !GlobalData).
|
|
|
|
:- pred generate_const_struct(module_info::in,
|
|
have_unboxed_floats::in, have_unboxed_int64s::in,
|
|
pair(int, const_struct)::in,
|
|
const_struct_map::in, const_struct_map::out,
|
|
static_cell_info::in, static_cell_info::out) is det.
|
|
|
|
generate_const_struct(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstNum - ConstStruct, !ConstStructMap, !StaticCellInfo) :-
|
|
ConstStruct = const_struct(ConsId, ConstArgs, _, _),
|
|
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
|
|
associate_cons_id_args_with_widths(ModuleInfo, ConsId,
|
|
ConstArgs, ConsArgsPosWidths),
|
|
generate_const_struct_rval(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
!.ConstStructMap, ConsTag, ConsArgsPosWidths, Rval, !StaticCellInfo),
|
|
map.det_insert(ConstNum, Rval, !ConstStructMap).
|
|
|
|
:- pred generate_const_struct_rval(module_info::in, have_unboxed_floats::in,
|
|
have_unboxed_int64s::in, const_struct_map::in, cons_tag::in,
|
|
list(arg_and_width(const_struct_arg))::in, typed_rval::out,
|
|
static_cell_info::in, static_cell_info::out) is det.
|
|
|
|
generate_const_struct_rval(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConsTag, ConstArgsPosWidths, TypedRval,
|
|
!StaticCellInfo) :-
|
|
(
|
|
ConsTag = remote_args_tag(RemoteArgsTagInfo),
|
|
(
|
|
(
|
|
RemoteArgsTagInfo = remote_args_only_functor,
|
|
Ptag = ptag(0u8)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_unshared(Ptag)
|
|
),
|
|
generate_const_struct_args(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgsPosWidths, RHSTypedRvals)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_shared(Ptag, RemoteSectag),
|
|
RemoteSectag = remote_sectag(SectagUint, SectagSize),
|
|
(
|
|
SectagSize = rsectag_word,
|
|
TypedTagwordRval = typed_rval(const(llconst_uint(SectagUint)),
|
|
lt_int(int_type_uint)),
|
|
NonTagwordConstArgsPosWidths = ConstArgsPosWidths
|
|
;
|
|
SectagSize = rsectag_subword(_),
|
|
( if SectagUint = 0u then
|
|
RevToOrRvals0 = []
|
|
else
|
|
RevToOrRvals0 = [const(llconst_uint(SectagUint))]
|
|
),
|
|
generate_const_struct_args_for_one_word(ModuleInfo,
|
|
UnboxedFloats, UnboxedInt64s, ConstStructMap,
|
|
ConstArgsPosWidths, NonTagwordConstArgsPosWidths,
|
|
RevToOrRvals0, RevToOrRvals),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
TagwordRval = bitwise_or_rvals(ToOrRvals),
|
|
TypedTagwordRval = typed_rval(TagwordRval,
|
|
lt_int(int_type_uint))
|
|
),
|
|
generate_const_struct_args(ModuleInfo, UnboxedFloats,
|
|
UnboxedInt64s, ConstStructMap, NonTagwordConstArgsPosWidths,
|
|
NonTagwordTypedRvals),
|
|
RHSTypedRvals = [TypedTagwordRval | NonTagwordTypedRvals]
|
|
;
|
|
RemoteArgsTagInfo = remote_args_ctor(_),
|
|
% These are supported only on the MLDS backend.
|
|
unexpected($pred, "remote_args_ctor")
|
|
),
|
|
add_scalar_static_cell(RHSTypedRvals, DataAddr, !StaticCellInfo),
|
|
MaybeOffset = no,
|
|
CellPtrConst = const(llconst_data_addr(DataAddr, MaybeOffset)),
|
|
Rval = mkword(Ptag, CellPtrConst),
|
|
TypedRval = typed_rval(Rval, lt_data_ptr)
|
|
;
|
|
ConsTag = local_args_tag(LocalArgsTagInfo),
|
|
expect_not(unify(ConstArgsPosWidths, []), $pred,
|
|
"local_args_tag has no args"),
|
|
maybe_accumulate_local_sectag(LocalArgsTagInfo, RevToOrRvals0),
|
|
generate_const_struct_args_for_one_word(ModuleInfo,
|
|
UnboxedFloats, UnboxedInt64s, ConstStructMap,
|
|
ConstArgsPosWidths, LeftOverConstArgsPosWidths,
|
|
RevToOrRvals0, RevToOrRvals),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
Rval = bitwise_or_rvals(ToOrRvals),
|
|
expect(unify(LeftOverConstArgsPosWidths, []), $pred, "left over args"),
|
|
TypedRval = typed_rval(Rval, lt_data_ptr)
|
|
;
|
|
ConsTag = no_tag,
|
|
get_notag_or_direct_arg_arg(ConstArgsPosWidths, ConstArgPosWidth),
|
|
generate_const_struct_arg(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgPosWidth, ArgTypedRval),
|
|
TypedRval = ArgTypedRval
|
|
;
|
|
ConsTag = direct_arg_tag(Ptag),
|
|
get_notag_or_direct_arg_arg(ConstArgsPosWidths, ConstArgPosWidth),
|
|
generate_const_struct_arg(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgPosWidth, ArgTypedRval),
|
|
ArgTypedRval = typed_rval(ArgRval, _RvalType),
|
|
( if Ptag = ptag(0u8) then
|
|
Rval = ArgRval
|
|
else
|
|
Rval = mkword(Ptag, ArgRval)
|
|
),
|
|
TypedRval = typed_rval(Rval, lt_data_ptr)
|
|
;
|
|
( ConsTag = int_tag(_)
|
|
; ConsTag = float_tag(_)
|
|
; ConsTag = string_tag(_)
|
|
; ConsTag = foreign_tag(_, _)
|
|
; ConsTag = dummy_tag
|
|
; ConsTag = shared_local_tag_no_args(_, _, _)
|
|
; ConsTag = ground_term_const_tag(_, _)
|
|
; ConsTag = type_info_const_tag(_)
|
|
; ConsTag = typeclass_info_const_tag(_)
|
|
; ConsTag = type_ctor_info_tag(_, _, _)
|
|
; ConsTag = base_typeclass_info_tag(_, _, _)
|
|
; ConsTag = deep_profiling_proc_layout_tag(_, _)
|
|
; ConsTag = tabling_info_tag(_, _)
|
|
; ConsTag = table_io_entry_tag(_, _)
|
|
; ConsTag = closure_tag(_, _, _)
|
|
),
|
|
unexpected($pred, "unexpected tag")
|
|
).
|
|
|
|
:- pred generate_const_struct_args(module_info::in, have_unboxed_floats::in,
|
|
have_unboxed_int64s::in, const_struct_map::in,
|
|
list(arg_and_width(const_struct_arg))::in, list(typed_rval)::out) is det.
|
|
|
|
generate_const_struct_args(_, _, _, _, [], []) .
|
|
generate_const_struct_args(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, [ConstArgPosWidth | ConstArgsPosWidths], TypedRvals) :-
|
|
ConstArgPosWidth = arg_and_width(_ConstArg, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
),
|
|
% For the reason why we handle double word arguments the same as
|
|
% full word arguments, see the comment in ml_unify_gen.m in the
|
|
% predicate ml_pack_ground_term_args_into_word_inits.
|
|
generate_const_struct_arg(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgPosWidth, HeadTypedRval),
|
|
generate_const_struct_args(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgsPosWidths, TailTypedRvals),
|
|
TypedRvals = [HeadTypedRval | TailTypedRvals]
|
|
;
|
|
ArgPosWidth = apw_partial_first(_, _, Shift, _, _, Fill),
|
|
generate_const_struct_arg(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgPosWidth, FirstTypedRval),
|
|
FirstTypedRval = typed_rval(FirstRval, _FirstRvalType),
|
|
maybe_shift_and_accumulate_or_rval(FirstRval, Shift, Fill,
|
|
[], RevToOrRvals0),
|
|
generate_const_struct_args_for_one_word(ModuleInfo,
|
|
UnboxedFloats, UnboxedInt64s, ConstStructMap,
|
|
ConstArgsPosWidths, LeftOverConstArgsPosWidths,
|
|
RevToOrRvals0, RevToOrRvals),
|
|
list.reverse(RevToOrRvals, ToOrRvals),
|
|
HeadRval = bitwise_or_rvals(ToOrRvals),
|
|
HeadTypedRval = typed_rval(HeadRval, lt_int(int_type_uint)),
|
|
generate_const_struct_args(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, LeftOverConstArgsPosWidths, TailTypedRvals),
|
|
TypedRvals = [HeadTypedRval | TailTypedRvals]
|
|
;
|
|
ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _),
|
|
unexpected($pred, "apw_partial_shifted")
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _),
|
|
unexpected($pred, "apw_none_shifted")
|
|
;
|
|
ArgPosWidth = apw_none_nowhere,
|
|
% Generate nothing for this argument.
|
|
generate_const_struct_args(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgsPosWidths, TypedRvals)
|
|
).
|
|
|
|
:- pred generate_const_struct_args_for_one_word(module_info::in,
|
|
have_unboxed_floats::in, have_unboxed_int64s::in, const_struct_map::in,
|
|
list(arg_and_width(const_struct_arg))::in,
|
|
list(arg_and_width(const_struct_arg))::out,
|
|
list(rval)::in, list(rval)::out) is det.
|
|
|
|
generate_const_struct_args_for_one_word(_, _, _, _, [], [], !RevToOrRvals).
|
|
generate_const_struct_args_for_one_word(ModuleInfo,
|
|
UnboxedFloats, UnboxedInt64s, ConstStructMap,
|
|
[ConstArgPosWidth | ConstArgsPosWidths], LeftOverConstArgsPosWidths,
|
|
!RevToOrRvals) :-
|
|
ConstArgPosWidth = arg_and_width(_ConstArg, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
),
|
|
% These are not part of the current word.
|
|
LeftOverConstArgsPosWidths = [ConstArgPosWidth | ConstArgsPosWidths]
|
|
;
|
|
(
|
|
ArgPosWidth = apw_partial_shifted(_, _, Shift, _, _, Fill),
|
|
generate_const_struct_arg(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, ConstArgPosWidth, ArgTypedRval),
|
|
ArgTypedRval = typed_rval(ArgRval, _ArgRvalType),
|
|
maybe_shift_and_accumulate_or_rval(ArgRval, Shift, Fill,
|
|
!RevToOrRvals)
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
generate_const_struct_args_for_one_word(ModuleInfo,
|
|
UnboxedFloats, UnboxedInt64s, ConstStructMap,
|
|
ConstArgsPosWidths, LeftOverConstArgsPosWidths, !RevToOrRvals)
|
|
).
|
|
|
|
:- pred generate_const_struct_arg(module_info::in, have_unboxed_floats::in,
|
|
have_unboxed_int64s::in, const_struct_map::in,
|
|
arg_and_width(const_struct_arg)::in, typed_rval::out) is det.
|
|
|
|
generate_const_struct_arg(ModuleInfo, UnboxedFloats, UnboxedInt64s,
|
|
ConstStructMap, arg_and_width(ConstArg, ArgPosWidth), TypedRval) :-
|
|
(
|
|
ConstArg = csa_const_struct(ConstNum),
|
|
map.lookup(ConstStructMap, ConstNum, TypedRval)
|
|
;
|
|
ConstArg = csa_constant(ConsId, _),
|
|
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
|
|
generate_const_struct_arg_tag(UnboxedFloats, UnboxedInt64s,
|
|
ConsTag, ArgPosWidth, TypedRval)
|
|
).
|
|
|
|
:- pred generate_const_struct_arg_tag(have_unboxed_floats::in,
|
|
have_unboxed_int64s::in, cons_tag::in, arg_pos_width::in,
|
|
typed_rval::out) is det.
|
|
|
|
generate_const_struct_arg_tag(UnboxedFloats, UnboxedInt64s,
|
|
ConsTag, ArgPosWidth, TypedRval) :-
|
|
% The code of this predicate is very similar to the code of
|
|
% generate_ground_term_conjunct_tag. Any changes here may also
|
|
% require similar changes there.
|
|
(
|
|
(
|
|
ConsTag = int_tag(IntTag),
|
|
int_tag_to_const_and_int_type(IntTag, Const, IntType),
|
|
store_int_tag_statically(IntType, UnboxedInt64s,
|
|
may_store_double_width_natively(ArgPosWidth), Type)
|
|
;
|
|
ConsTag = float_tag(Float),
|
|
Const = llconst_float(Float),
|
|
store_float_tag_statically(UnboxedFloats,
|
|
may_store_double_width_natively(ArgPosWidth), Type)
|
|
;
|
|
ConsTag = string_tag(String),
|
|
Const = llconst_string(String),
|
|
Type = lt_string
|
|
;
|
|
ConsTag = foreign_tag(Lang, Val),
|
|
expect(unify(Lang, lang_c), $pred,
|
|
"foreign_tag for language other than C"),
|
|
Const = llconst_foreign(Val, lt_int(int_type_int)),
|
|
Type = lt_int(int_type_int)
|
|
;
|
|
ConsTag = dummy_tag,
|
|
Const = llconst_int(0),
|
|
Type = lt_int(int_type_int)
|
|
),
|
|
TypedRval = typed_rval(const(Const), Type)
|
|
;
|
|
ConsTag = shared_local_tag_no_args(_Ptag, LocalSectag, _MustMask),
|
|
LocalSectag = local_sectag(_, PrimSec, _),
|
|
Rval = const(llconst_uint(PrimSec)),
|
|
TypedRval = typed_rval(Rval, lt_data_ptr)
|
|
;
|
|
ConsTag = type_ctor_info_tag(ModuleName, TypeName, TypeArity),
|
|
RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName,
|
|
uint16.det_from_int(TypeArity)),
|
|
DataId = rtti_data_id(ctor_rtti_id(RttiTypeCtor,
|
|
type_ctor_type_ctor_info)),
|
|
Rval = const(llconst_data_addr(DataId, no)),
|
|
Type = lt_data_ptr,
|
|
TypedRval = typed_rval(Rval, Type)
|
|
;
|
|
ConsTag = base_typeclass_info_tag(ModuleName, ClassId, Instance),
|
|
TCName = generate_class_name(ClassId),
|
|
DataId = rtti_data_id(tc_rtti_id(TCName,
|
|
type_class_base_typeclass_info(ModuleName, Instance))),
|
|
Rval = const(llconst_data_addr(DataId, no)),
|
|
Type = lt_data_ptr,
|
|
TypedRval = typed_rval(Rval, Type)
|
|
;
|
|
% XXX ARG_PACK Document why these should not occur here ...
|
|
( ConsTag = ground_term_const_tag(_, _)
|
|
; ConsTag = type_info_const_tag(_)
|
|
; ConsTag = typeclass_info_const_tag(_)
|
|
|
|
% These should not occur here because the structures that these tags
|
|
% point to are writeable.
|
|
; ConsTag = deep_profiling_proc_layout_tag(_, _)
|
|
; ConsTag = tabling_info_tag(_, _)
|
|
; ConsTag = table_io_entry_tag(_, _)
|
|
|
|
% These tags have arguments, and thus should be handled in
|
|
% generate_const_struct_rval.
|
|
; ConsTag = remote_args_tag(_)
|
|
; ConsTag = local_args_tag(_)
|
|
; ConsTag = no_tag
|
|
; ConsTag = direct_arg_tag(_)
|
|
; ConsTag = closure_tag(_, _, _)
|
|
),
|
|
unexpected($pred, "unexpected tag")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred maybe_accumulate_local_sectag(local_args_tag_info::in,
|
|
list(rval)::out) is det.
|
|
|
|
maybe_accumulate_local_sectag(LocalArgsTagInfo, RevToOrRvals0) :-
|
|
(
|
|
LocalArgsTagInfo = local_args_only_functor,
|
|
PrimSec = 0u
|
|
;
|
|
LocalArgsTagInfo = local_args_not_only_functor(_Ptag, LocalSectag),
|
|
LocalSectag = local_sectag(_, PrimSec, _)
|
|
),
|
|
( if PrimSec = 0u then
|
|
RevToOrRvals0 = []
|
|
else
|
|
RevToOrRvals0 = [const(llconst_uint(PrimSec))]
|
|
).
|
|
|
|
:- pred maybe_shift_and_accumulate_or_rval(rval::in, arg_shift::in,
|
|
fill_kind::in, list(rval)::in, list(rval)::out) is det.
|
|
|
|
maybe_shift_and_accumulate_or_rval(Rval, Shift, Fill, !RevToOrRvals) :-
|
|
( if
|
|
Rval = const(Const),
|
|
is_zero_const(Const) = is_zero_const
|
|
then
|
|
% We may get zeros from constant fields. Since OR with zero is a noop,
|
|
% do not include them in the list of rvals to be OR-ed later.
|
|
true
|
|
else
|
|
ShiftedUnsignedRval = left_shift_rval(Rval, Shift, Fill),
|
|
!:RevToOrRvals = [ShiftedUnsignedRval | !.RevToOrRvals]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type may_store_double_width_natively
|
|
---> may_not_store_double_width_natively
|
|
; may_store_double_width_natively(arg_pos_width).
|
|
|
|
:- pred store_int_tag_statically(int_type::in, have_unboxed_int64s::in,
|
|
may_store_double_width_natively::in, llds_type::out) is det.
|
|
|
|
store_int_tag_statically(IntType, UnboxedInt64s, MayStoreDoubleWidthStatically,
|
|
Type) :-
|
|
(
|
|
( IntType = int_type_int
|
|
; IntType = int_type_int8
|
|
; IntType = int_type_int16
|
|
; IntType = int_type_int32
|
|
),
|
|
Type = lt_int(int_type_int)
|
|
;
|
|
( IntType = int_type_uint
|
|
; IntType = int_type_uint8
|
|
; IntType = int_type_uint16
|
|
; IntType = int_type_uint32
|
|
),
|
|
Type = lt_int(int_type_uint)
|
|
;
|
|
( IntType = int_type_int64
|
|
; IntType = int_type_uint64
|
|
),
|
|
(
|
|
UnboxedInt64s = have_unboxed_int64s,
|
|
Type = lt_int(IntType)
|
|
;
|
|
UnboxedInt64s = do_not_have_unboxed_int64s,
|
|
( if
|
|
MayStoreDoubleWidthStatically =
|
|
may_store_double_width_natively(ArgPosWidth),
|
|
ArgPosWidth = apw_double(_, _, _)
|
|
then
|
|
Type = lt_int(IntType)
|
|
else
|
|
Type = lt_data_ptr
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred store_float_tag_statically(have_unboxed_floats::in,
|
|
may_store_double_width_natively::in, llds_type::out) is det.
|
|
|
|
store_float_tag_statically(UnboxedFloats, MayStoreDoubleWidthStatically,
|
|
Type) :-
|
|
(
|
|
UnboxedFloats = have_unboxed_floats,
|
|
Type = lt_float
|
|
;
|
|
UnboxedFloats = do_not_have_unboxed_floats,
|
|
( if
|
|
MayStoreDoubleWidthStatically =
|
|
may_store_double_width_natively(ArgPosWidth),
|
|
ArgPosWidth = apw_double(_, _, _)
|
|
then
|
|
Type = lt_float
|
|
else
|
|
Type = lt_data_ptr
|
|
)
|
|
).
|
|
|
|
:- pred not_taking_addr_of_cur_arg(list(int)::in, int::in) is semidet.
|
|
|
|
not_taking_addr_of_cur_arg(TakeAddr, CurArgNum) :-
|
|
( if TakeAddr = [CurArgNum | _TailTakeAddr] then
|
|
fail
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred take_tagword_args_widths_modes(
|
|
list(arg_and_width(ArgType))::in, list(unify_mode)::in,
|
|
list(arg_and_width(ArgType))::out, list(unify_mode)::out,
|
|
list(arg_and_width(ArgType))::out, list(unify_mode)::out,
|
|
int::in, int::out) is det.
|
|
|
|
take_tagword_args_widths_modes([], [], [], [], [], [], !CurArgNum).
|
|
take_tagword_args_widths_modes([], [_ | _], _, _, _, _, !CurArgNum) :-
|
|
unexpected($pred, "length mismatch").
|
|
take_tagword_args_widths_modes([_ | _], [], _, _, _, _, !CurArgNum) :-
|
|
unexpected($pred, "length mismatch").
|
|
take_tagword_args_widths_modes(
|
|
[ArgWidth | ArgsWidths], [ArgMode | ArgModes],
|
|
TagwordArgsWidths, TagwordArgModes,
|
|
NonTagwordArgsWidths, NonTagwordArgModes, !CurArgNum) :-
|
|
ArgWidth = arg_and_width(_Arg, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
!:CurArgNum = !.CurArgNum + 1,
|
|
take_tagword_args_widths_modes(ArgsWidths, ArgModes,
|
|
TailTagwordArgsWidths, TailTagwordArgModes,
|
|
NonTagwordArgsWidths, NonTagwordArgModes, !CurArgNum),
|
|
TagwordArgsWidths = [ArgWidth | TailTagwordArgsWidths],
|
|
TagwordArgModes = [ArgMode | TailTagwordArgModes]
|
|
;
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
),
|
|
TagwordArgsWidths = [],
|
|
TagwordArgModes = [],
|
|
NonTagwordArgsWidths = [ArgWidth | ArgsWidths],
|
|
NonTagwordArgModes = [ArgMode | ArgModes]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module ll_backend.unify_gen_construct.
|
|
%---------------------------------------------------------------------------%
|