mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
b0dd1ac0ed
compiler/check_hlds.m:
compiler/hlds.m:
compiler/mode_top_functor.m:
Move the mode_top_functor module from the check_hlds package
to the hlds package, because most of its users are outside check_hlds.
compiler/arg_info.m:
compiler/deep_profiling.m:
compiler/foreign_proc_gen.m:
compiler/hlds_rtti.m:
compiler/lco.m:
compiler/liveness.m:
compiler/mark_tail_calls.m:
compiler/ml_args_util.m:
compiler/ml_foreign_proc_gen.m:
compiler/ml_unify_gen_construct.m:
compiler/ml_unify_gen_util.m:
compiler/modecheck_unify.m:
compiler/structure_sharing.domain.m:
compiler/unify_gen_construct.m:
compiler/unify_gen_util.m:
Conform to the changes above. (Many of these modules do not import
anything from the check_hlds package after this.)
1604 lines
66 KiB
Mathematica
1604 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-2022, 2024-2025 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 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.mode_top_functor.
|
|
:- import_module hlds.pred_name.
|
|
:- import_module hlds.type_util.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.optimization_options.
|
|
:- 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 parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_table.
|
|
|
|
:- 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)),
|
|
CtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info),
|
|
DataId = rtti_data_id(CtorRttiId),
|
|
ConstRval = const(llconst_data_addr(DataId))
|
|
;
|
|
ConsTag = base_typeclass_info_tag(ModuleName, ClassId, Instance),
|
|
TCName = generate_class_name(ClassId),
|
|
TCRttiName = type_class_base_typeclass_info(ModuleName, Instance),
|
|
TCRttiId = tc_rtti_id(TCName, TCRttiName),
|
|
DataId = rtti_data_id(TCRttiId),
|
|
ConstRval = const(llconst_data_addr(DataId))
|
|
;
|
|
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_compiler(made_for_uci(_, _)) 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))
|
|
;
|
|
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))
|
|
;
|
|
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))
|
|
),
|
|
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, !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"),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
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(NonLocals, LHSVar, RHSVar,
|
|
RHSType, ArgMode, Code, !.CI, !CLD)
|
|
;
|
|
ConsTag = direct_arg_tag(Ptag),
|
|
expect(unify(TakeAddr, []), $pred, "direct_arg_tag: take_addr"),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
get_notag_or_direct_arg_arg_mode(RHSVars, ArgModes, RHSVar, ArgMode),
|
|
RHSType = variable_type(!.CI, RHSVar),
|
|
generate_direct_arg_construct(NonLocals, LHSVar, RHSVar, RHSType,
|
|
Ptag, ArgMode, Code, !.CI, !CLD)
|
|
;
|
|
ConsTag = closure_tag(PredId, ProcId),
|
|
expect(unify(TakeAddr, []), $pred, "closure_tag has take_addr"),
|
|
expect(unify(MaybeSize, no), $pred, "closure_tag has size"),
|
|
construct_closure(PredId, ProcId, 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 = do_not_opt_lcmc_null,
|
|
MaybeNull = no
|
|
;
|
|
LCMCNull = opt_lcmc_null,
|
|
MaybeNull = yes(const(llconst_int(0)))
|
|
),
|
|
HeadCellArgs = [cell_arg_take_addr_one_word(RHSVar, MaybeNull)]
|
|
;
|
|
ArgPosWidth = apw_double(_, _, _),
|
|
(
|
|
LCMCNull = do_not_opt_lcmc_null,
|
|
MaybeNulls = no
|
|
;
|
|
LCMCNull = opt_lcmc_null,
|
|
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 mismatch").
|
|
generate_and_pack_one_cons_word([_ | _], [], _, _, _, _,
|
|
!TakeAddr, !RevToOrRvals, !Completeness, !Code, _, !CLD) :-
|
|
unexpected($pred, "length mismatch").
|
|
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 mismatch").
|
|
generate_and_pack_tagword([_ | _], [], !RevToOrRvals, _) :-
|
|
unexpected($pred, "length mismatch").
|
|
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, !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_var_table(CI, VarTable),
|
|
lookup_var_entry(VarTable, RHSVar, RHSVarEntry),
|
|
RHSType = RHSVarEntry ^ vte_type,
|
|
init_final_insts_to_top_functor_mode(ModuleInfo, RHSInitInst, RHSFinalInst,
|
|
RHSType, RHSTopFunctorMode),
|
|
(
|
|
RHSTopFunctorMode = top_in,
|
|
IsDummy = RHSVarEntry ^ vte_is_dummy,
|
|
(
|
|
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(set_of_progvar::in,
|
|
prog_var::in, prog_var::in, mer_type::in, ptag::in, unify_mode::in,
|
|
llds_code::out, code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_direct_arg_construct(NonLocals, LHSVar, RHSVar, RHSVarType,
|
|
Ptag, ArgMode, Code, CI, !CLD) :-
|
|
get_module_info(CI, ModuleInfo),
|
|
compute_assign_direction(ModuleInfo, NonLocals, RHSVar, RHSVarType,
|
|
ArgMode, Dir),
|
|
(
|
|
Dir = assign_right,
|
|
unexpected($pred, "assign right in construction")
|
|
;
|
|
Dir = assign_left,
|
|
( if Ptag = ptag(0u8) then
|
|
assign_var_to_var(LHSVar, RHSVar, !CLD),
|
|
Code = empty
|
|
else
|
|
assign_expr_to_var(LHSVar, mkword(Ptag, var(RHSVar)), 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(LHSVar, 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),
|
|
CellPtrConst = const(llconst_data_addr(DataAddr)),
|
|
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),
|
|
CellPtrConst = const(llconst_data_addr(DataAddr)),
|
|
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)),
|
|
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)),
|
|
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.
|
|
%---------------------------------------------------------------------------%
|