mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
d8a31e574e
compiler/inst_lookup.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_util.m:
compiler/mode_util.m:
compiler/type_util.m:
Move these modules from the check_hlds package to the hlds package.
The reason is that all the content of five of these modules, and
most of the content of one module (inst_util.m) is not used
exclusively during semantic checking passes. (A later diff
should deal with the exception.) Some are used by the pass that
builds the initial HLDS, and all are used by middle-end and backend
passes. The move therefore reduces the number of inappropriate imports
of the check_hlds package.
compiler/check_hlds.m:
compiler/hlds.m:
Effect the transfer.
compiler/*.m:
Conform to the changes above.
700 lines
29 KiB
Mathematica
700 lines
29 KiB
Mathematica
%---------------------------------------------------------------------------e
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------e
|
|
% Copyright (C) 1994-2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2020, 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_deconstruct.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module ll_backend.code_info.
|
|
:- import_module ll_backend.code_loc_dep.
|
|
:- import_module ll_backend.llds.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.set_of_var.
|
|
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred generate_deconstruction_unification(set_of_progvar::in,
|
|
prog_var::in, cons_id::in, list(prog_var)::in, list(unify_mode)::in,
|
|
can_fail::in, can_cgc::in, llds_code::out, code_info::in, code_info::out,
|
|
code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate a subunification between two [field | variable].
|
|
%
|
|
:- pred generate_deconstruct_no_tag_unify_arg(set_of_progvar::in,
|
|
prog_var::in, prog_var::in, mer_type::in, unify_mode::in, llds_code::out,
|
|
code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module backend_libs.
|
|
:- import_module backend_libs.builtin_ops.
|
|
:- import_module hlds.goal_form.
|
|
:- import_module hlds.hlds_code_util.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.type_util.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module ll_backend.unify_gen_test.
|
|
:- 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.var_table.
|
|
|
|
:- import_module cord.
|
|
:- import_module int.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module uint.
|
|
:- import_module uint8.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_deconstruction_unification(NonLocals, LHSVar, ConsId,
|
|
RHSVars, ArgModes, CanFail, CanCGC, Code, !CI, !CLD) :-
|
|
(
|
|
CanFail = can_fail,
|
|
generate_semi_deconstruction(NonLocals, LHSVar, ConsId,
|
|
RHSVars, ArgModes, DeconstructCode, !CI, !CLD)
|
|
;
|
|
CanFail = cannot_fail,
|
|
generate_det_deconstruction(NonLocals, LHSVar, ConsId,
|
|
RHSVars, ArgModes, DeconstructCode, !.CI, !CLD)
|
|
),
|
|
(
|
|
CanCGC = can_cgc,
|
|
get_var_table(!.CI, VarTable),
|
|
lookup_var_entry(VarTable, LHSVar, LHSVarEntry),
|
|
LHSVarName = var_entry_name(LHSVar, LHSVarEntry),
|
|
produce_variable(LHSVar, ProduceVarCode, VarRval, !CLD),
|
|
( if VarRval = lval(VarLval) then
|
|
save_reused_cell_fields(LHSVar, VarLval, SaveArgsCode, Regs, !CLD),
|
|
% This seems to be fine.
|
|
list.foldl(release_reg, Regs, !CLD),
|
|
% XXX avoid strip_tag when we know what ptag it will have
|
|
FreeVarCode = singleton(
|
|
llds_instr(free_heap(unop(strip_tag, VarRval)),
|
|
"Free " ++ LHSVarName)
|
|
),
|
|
Code = DeconstructCode ++
|
|
ProduceVarCode ++ SaveArgsCode ++ FreeVarCode
|
|
else
|
|
Code = DeconstructCode
|
|
)
|
|
;
|
|
CanCGC = cannot_cgc,
|
|
Code = DeconstructCode
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate a semideterministic deconstruction.
|
|
% A semideterministic deconstruction unification is tag-test
|
|
% followed by a deterministic deconstruction.
|
|
%
|
|
:- pred generate_semi_deconstruction(set_of_progvar::in, prog_var::in,
|
|
cons_id::in, list(prog_var)::in, list(unify_mode)::in,
|
|
llds_code::out, code_info::in, code_info::out,
|
|
code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_semi_deconstruction(NonLocals, LHSVar, ConsId, RHSVars, Modes, Code,
|
|
!CI, !CLD) :-
|
|
produce_variable(LHSVar, LHSVarCode, LHSVarRval, !CLD),
|
|
get_var_table(!.CI, VarTable),
|
|
lookup_var_entry(VarTable, LHSVar, LHSVarEntry),
|
|
LHSVarName = var_entry_name(LHSVar, LHSVarEntry),
|
|
LHSVarType = LHSVarEntry ^ vte_type,
|
|
CheaperTagTest = lookup_cheaper_tag_test(!.CI, LHSVarType),
|
|
generate_test_var_has_cons_id(LHSVarRval, LHSVarName, ConsId,
|
|
CheaperTagTest, branch_on_success, SuccLabel, TagTestCode, !CI),
|
|
remember_position(!.CLD, AfterUnify),
|
|
generate_failure(FailCode, !.CI, !.CLD),
|
|
reset_to_position(AfterUnify, !.CI, !:CLD),
|
|
generate_det_deconstruction(NonLocals, LHSVar, ConsId, RHSVars, Modes,
|
|
DetDeconstructCode, !.CI, !CLD),
|
|
SuccessLabelCode = singleton(llds_instr(label(SuccLabel), "")),
|
|
Code = LHSVarCode ++ TagTestCode ++ FailCode ++
|
|
SuccessLabelCode ++ DetDeconstructCode.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate a deterministic deconstruction. In a deterministic
|
|
% deconstruction, we know the value of the cons_id, so we don't need
|
|
% to generate a test for it.
|
|
%
|
|
% Deconstructions are generated semi-eagerly. Any test sub-unifications
|
|
% are generated eagerly (they _must_ be), but assignment unifications
|
|
% are cached.
|
|
%
|
|
:- pred generate_det_deconstruction(set_of_progvar::in, prog_var::in,
|
|
cons_id::in, list(prog_var)::in, list(unify_mode)::in,
|
|
llds_code::out, code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_det_deconstruction(NonLocals, LHSVar, ConsId, RHSVars, ArgModes, Code,
|
|
CI, !CLD) :-
|
|
get_module_info(CI, ModuleInfo),
|
|
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
|
|
(
|
|
( ConsTag = string_tag(_String)
|
|
; ConsTag = int_tag(_)
|
|
; ConsTag = foreign_tag(_, _)
|
|
; ConsTag = float_tag(_Float)
|
|
; ConsTag = dummy_tag
|
|
; ConsTag = closure_tag(_, _)
|
|
; ConsTag = type_ctor_info_tag(_, _, _)
|
|
; ConsTag = base_typeclass_info_tag(_, _, _)
|
|
; ConsTag = tabling_info_tag(_, _)
|
|
; ConsTag = deep_profiling_proc_layout_tag(_, _)
|
|
; ConsTag = shared_local_tag_no_args(_, _, _)
|
|
),
|
|
% For constants, if the deconstruction is det, then we already know
|
|
% the value of the constant.
|
|
Code = empty
|
|
;
|
|
( ConsTag = type_info_const_tag(_)
|
|
; ConsTag = typeclass_info_const_tag(_)
|
|
; ConsTag = ground_term_const_tag(_, _)
|
|
; ConsTag = table_io_entry_tag(_, _)
|
|
),
|
|
unexpected($pred, "unexpected tag")
|
|
;
|
|
ConsTag = no_tag,
|
|
get_notag_or_direct_arg_arg_mode(RHSVars, ArgModes, RHSVar, ArgMode),
|
|
VarType = variable_type(CI, LHSVar),
|
|
IsDummy = is_type_a_dummy(ModuleInfo, VarType),
|
|
(
|
|
IsDummy = is_dummy_type,
|
|
% We must handle this case specially. If we didn't, the
|
|
% generated code would copy the reference to the Var's
|
|
% current location, which may be stackvar(N) or framevar(N)
|
|
% for negative N, to be the location of Arg, and since Arg
|
|
% may not be a dummy type, it would actually use that location.
|
|
% This can happen in the unify/compare routines for e.g.
|
|
% io.state.
|
|
( if variable_is_forward_live(!.CLD, RHSVar) then
|
|
assign_const_to_var(RHSVar, const(llconst_int(0)), CI, !CLD)
|
|
else
|
|
true
|
|
),
|
|
Code = empty
|
|
;
|
|
IsDummy = is_not_dummy_type,
|
|
RHSType = variable_type(CI, RHSVar),
|
|
generate_deconstruct_no_tag_unify_arg(NonLocals, LHSVar, RHSVar,
|
|
RHSType, ArgMode, Code, CI, !CLD)
|
|
)
|
|
;
|
|
ConsTag = direct_arg_tag(Ptag),
|
|
get_notag_or_direct_arg_arg_mode(RHSVars, ArgModes, RHSVar, ArgMode),
|
|
generate_direct_arg_deconstruct(NonLocals, LHSVar, RHSVar,
|
|
Ptag, ArgMode, Code, CI, !CLD)
|
|
;
|
|
ConsTag = remote_args_tag(RemoteArgsTagInfo),
|
|
LHSBaseRval = var(LHSVar),
|
|
get_var_table(CI, VarTable),
|
|
associate_cons_id_args_with_widths(ModuleInfo, ConsId,
|
|
RHSVars, RHSVarsWidths),
|
|
(
|
|
(
|
|
RemoteArgsTagInfo = remote_args_only_functor,
|
|
LHSPtag = ptag(0u8)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_unshared(LHSPtag)
|
|
),
|
|
generate_deconstruct_unify_args(VarTable, NonLocals,
|
|
LHSPtag, LHSBaseRval, RHSVarsWidths, ArgModes, Code, CI, !CLD)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_shared(LHSPtag, RemoteSectag),
|
|
RemoteSectag = remote_sectag(_SectagUint, SectagSize),
|
|
(
|
|
SectagSize = rsectag_word,
|
|
generate_deconstruct_unify_args(VarTable, NonLocals,
|
|
LHSPtag, LHSBaseRval, RHSVarsWidths, ArgModes,
|
|
Code, CI, !CLD)
|
|
;
|
|
SectagSize = rsectag_subword(_),
|
|
take_tagword_args(RHSVarsWidths, ArgModes,
|
|
TagwordRHSVarsWidths, TagwordArgModes,
|
|
NonTagwordRHSVarsWidths, NonTagwordArgModes),
|
|
LHSSectagWordLval = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(0))),
|
|
LHSSectagWordRval0 = lval(LHSSectagWordLval),
|
|
LHSSectagWordRval = LHSSectagWordRval0,
|
|
MaterializeTagwordCode = empty,
|
|
generate_deconstruct_tagword_unify_args(NonLocals,
|
|
LHSSectagWordRval, TagwordRHSVarsWidths, TagwordArgModes,
|
|
[LHSSectagWordLval], [], ToOrRvals, 0u, ToOrMask,
|
|
AssignRightCode, CI, !CLD),
|
|
(
|
|
ToOrRvals = [],
|
|
TagwordCode = MaterializeTagwordCode ++ AssignRightCode
|
|
;
|
|
ToOrRvals = [HeadToOrRval | TailToOrRvals],
|
|
ToOrRval0 =
|
|
bitwise_or_some_rvals(HeadToOrRval, TailToOrRvals),
|
|
materialize_vars_in_rval(ToOrRval0, ToOrRval,
|
|
ToOrRvalCode, !CLD),
|
|
ComplementMask = const(llconst_uint(\ ToOrMask)),
|
|
MaskedOldSectagWordRval = binop(bitwise_and(int_type_uint),
|
|
lval(LHSSectagWordLval), ComplementMask),
|
|
NewSectagWordRval = binop(bitwise_or(int_type_uint),
|
|
MaskedOldSectagWordRval, ToOrRval),
|
|
Comment = "updating tagword",
|
|
AssignLeftCode = singleton(llds_instr(
|
|
assign(LHSSectagWordLval, NewSectagWordRval),
|
|
Comment)),
|
|
TagwordCode = MaterializeTagwordCode ++
|
|
AssignRightCode ++ ToOrRvalCode ++ AssignLeftCode
|
|
),
|
|
generate_deconstruct_unify_args(VarTable, NonLocals,
|
|
LHSPtag, LHSBaseRval,
|
|
NonTagwordRHSVarsWidths, NonTagwordArgModes,
|
|
NonTagwordCode, CI, !CLD),
|
|
Code = TagwordCode ++ NonTagwordCode
|
|
)
|
|
;
|
|
RemoteArgsTagInfo = remote_args_ctor(_Data),
|
|
% These are supported only on the MLDS backend.
|
|
unexpected($pred, "remote_args_ctor")
|
|
)
|
|
;
|
|
ConsTag = local_args_tag(_),
|
|
associate_cons_id_args_with_widths(ModuleInfo, ConsId,
|
|
RHSVars, RHSVarsWidths),
|
|
generate_deconstruct_tagword_unify_args(NonLocals, var(LHSVar),
|
|
RHSVarsWidths, ArgModes, [], [], ToOrRvals, 0u, ToOrMask,
|
|
AssignRightCode, CI, !CLD),
|
|
(
|
|
ToOrRvals = [],
|
|
Code = AssignRightCode
|
|
;
|
|
ToOrRvals = [HeadToOrRval | TailToOrRvals],
|
|
ToOrRval = bitwise_or_some_rvals(HeadToOrRval, TailToOrRvals),
|
|
reassign_tagword_var(LHSVar, ToOrMask, ToOrRval, AssignLeftCode,
|
|
!CLD),
|
|
Code = AssignRightCode ++ AssignLeftCode
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate code to perform a list of deterministic subunifications
|
|
% for the arguments of a construction.
|
|
%
|
|
:- pred generate_deconstruct_unify_args(var_table::in, set_of_progvar::in,
|
|
ptag::in, rval::in, list(arg_and_width(prog_var))::in,
|
|
list(unify_mode)::in, llds_code::out,
|
|
code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_deconstruct_unify_args(_, _, _, _, [], [], empty, _CI, !CLD).
|
|
generate_deconstruct_unify_args(_, _, _, _, [], [_ | _], _, _, !CLD) :-
|
|
unexpected($pred, "length mismatch").
|
|
generate_deconstruct_unify_args(_, _, _, _, [_ | _], [], _, _, !CLD) :-
|
|
unexpected($pred, "length mismatch").
|
|
generate_deconstruct_unify_args(VarTable, NonLocals, LHSPtag, LHSBaseRval,
|
|
[RHSVarLHSWidth | RHSVarsLHSWidths], [ArgMode | ArgModes],
|
|
Code, CI, !CLD) :-
|
|
RHSVarLHSWidth = arg_and_width(RHSVar, LHSArgPosWidth),
|
|
lookup_var_entry(VarTable, RHSVar, RHSVarEntry),
|
|
RHSType = RHSVarEntry ^ vte_type,
|
|
generate_deconstruct_unify_arg(NonLocals, LHSPtag,
|
|
LHSBaseRval, LHSArgPosWidth, RHSVar, RHSType, ArgMode,
|
|
HeadCode, CI, !CLD),
|
|
generate_deconstruct_unify_args(VarTable, NonLocals, LHSPtag, LHSBaseRval,
|
|
RHSVarsLHSWidths, ArgModes, TailCode, CI, !CLD),
|
|
Code = HeadCode ++ TailCode.
|
|
|
|
:- pred generate_deconstruct_unify_arg(set_of_progvar::in, ptag::in,
|
|
rval::in, arg_pos_width::in,
|
|
prog_var::in, mer_type::in, unify_mode::in, llds_code::out,
|
|
code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_deconstruct_unify_arg(NonLocals, LHSPtag, LHSBaseRval, LHSArgPosWidth,
|
|
RHSVar, RHSType, ArgMode, Code, CI, !CLD) :-
|
|
get_module_info(CI, ModuleInfo),
|
|
compute_assign_direction(ModuleInfo, NonLocals, RHSVar, RHSType, ArgMode,
|
|
Dir),
|
|
(
|
|
Dir = assign_right,
|
|
( if variable_is_forward_live(!.CLD, RHSVar) then
|
|
generate_deconstruct_assign_right(LHSPtag, LHSBaseRval,
|
|
LHSArgPosWidth, RHSVar, Code, CI, !CLD)
|
|
else
|
|
Code = empty
|
|
)
|
|
;
|
|
Dir = assign_left,
|
|
% Fields are always considered forward live.
|
|
generate_deconstruct_assign_left(LHSPtag, LHSBaseRval, LHSArgPosWidth,
|
|
RHSVar, Code, !CLD)
|
|
;
|
|
Dir = assign_unused,
|
|
% XXX This will have to change if we start to support aliasing.
|
|
Code = empty
|
|
).
|
|
|
|
generate_deconstruct_no_tag_unify_arg(NonLocals, LHSVar, RHSVar, RHSType,
|
|
ArgMode, Code, CI, !CLD) :-
|
|
get_module_info(CI, ModuleInfo),
|
|
compute_assign_direction(ModuleInfo, NonLocals, RHSVar, RHSType,
|
|
ArgMode, Dir),
|
|
(
|
|
Dir = assign_right,
|
|
( if variable_is_forward_live(!.CLD, RHSVar) then
|
|
assign_var_to_var(RHSVar, LHSVar, !CLD),
|
|
Code = empty
|
|
else
|
|
Code = empty
|
|
)
|
|
;
|
|
Dir = assign_left,
|
|
( if variable_is_forward_live(!.CLD, LHSVar) then
|
|
assign_var_to_var(LHSVar, RHSVar, !CLD)
|
|
else
|
|
true
|
|
),
|
|
Code = empty
|
|
;
|
|
Dir = assign_unused,
|
|
% XXX This will have to change if we start to support aliasing.
|
|
Code = empty
|
|
).
|
|
|
|
:- pred generate_deconstruct_tagword_unify_args(set_of_progvar::in, rval::in,
|
|
list(arg_and_width(prog_var))::in, list(unify_mode)::in, list(lval)::in,
|
|
list(rval)::in, list(rval)::out, uint::in, uint::out,
|
|
llds_code::out, code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_deconstruct_tagword_unify_args(_, _, [], [], _,
|
|
!ToOrRvals, !ToOrMask, empty, _CI, !CLD).
|
|
generate_deconstruct_tagword_unify_args(_, _, [], [_ | _], _,
|
|
!ToOrRvals, !ToOrMask, _, _, !CLD) :-
|
|
unexpected($pred, "length mismatch").
|
|
generate_deconstruct_tagword_unify_args(_, _, [_ | _], [], _,
|
|
!ToOrRvals, !ToOrMask, _, _, !CLD) :-
|
|
unexpected($pred, "length mismatch").
|
|
generate_deconstruct_tagword_unify_args(NonLocals, LHSRval,
|
|
[RHSVarWidth | RHSVarsWidths], [ArgMode | ArgModes], FieldLvals,
|
|
!ToOrRvals, !ToOrMask, Code, CI, !CLD) :-
|
|
generate_deconstruct_tagword_unify_arg(NonLocals, LHSRval, RHSVarWidth,
|
|
ArgMode, FieldLvals, !ToOrRvals, !ToOrMask, HeadCode, CI, !CLD),
|
|
generate_deconstruct_tagword_unify_args(NonLocals, LHSRval, RHSVarsWidths,
|
|
ArgModes, FieldLvals, !ToOrRvals, !ToOrMask, TailCode, CI, !CLD),
|
|
Code = HeadCode ++ TailCode.
|
|
|
|
% Unify (on the left)a word containing tags and packed arguments, and
|
|
% (on the right) a sequence of argument variables. Generate code for
|
|
% the assignments to the right, and update the state variables to help
|
|
% our caller generate a single assignment to the left.
|
|
%
|
|
:- pred generate_deconstruct_tagword_unify_arg(set_of_progvar::in, rval::in,
|
|
arg_and_width(prog_var)::in, unify_mode::in, list(lval)::in,
|
|
list(rval)::in, list(rval)::out, uint::in, uint::out,
|
|
llds_code::out, code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_deconstruct_tagword_unify_arg(NonLocals, LHSRval, RHSVarWidth,
|
|
ArgMode, FieldLvals, !ToOrRvals, !ToOrMask, Code, CI, !CLD) :-
|
|
RHSVarWidth = arg_and_width(RHSVar, ArgPosWidth),
|
|
get_module_info(CI, ModuleInfo),
|
|
get_var_table(CI, VarTable),
|
|
lookup_var_entry(VarTable, RHSVar, RHSVarEntry),
|
|
RHSType = RHSVarEntry ^ vte_type,
|
|
compute_assign_direction(ModuleInfo, NonLocals, RHSVar, RHSType, ArgMode,
|
|
Dir),
|
|
(
|
|
Dir = assign_right,
|
|
( if variable_is_forward_live(!.CLD, RHSVar) then
|
|
generate_deconstruct_tagword_assign_right(LHSRval, RHSVar,
|
|
ArgPosWidth, FieldLvals, Code, !CLD)
|
|
else
|
|
Code = empty
|
|
)
|
|
;
|
|
Dir = assign_left,
|
|
generate_deconstruct_tagword_assign_left(RHSVar, ArgPosWidth,
|
|
!ToOrRvals, !ToOrMask),
|
|
Code = empty
|
|
;
|
|
Dir = assign_unused,
|
|
% XXX This will have to change if we start to support aliasing.
|
|
Code = empty
|
|
).
|
|
|
|
:- pred generate_deconstruct_assign_right(ptag::in, rval::in,
|
|
arg_pos_width::in, prog_var::in,
|
|
llds_code::out, code_info::in, code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_deconstruct_assign_right(LHSPtag, LHSBaseRval, LHSArgPosWidth,
|
|
RHSVar, Code, CI, !CLD) :-
|
|
(
|
|
LHSArgPosWidth = apw_full(_, cell_offset(LHSCellOffset)),
|
|
LHSLval = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset))),
|
|
assign_lval_to_var(RHSVar, LHSLval, Code, CI, !CLD)
|
|
;
|
|
LHSArgPosWidth = apw_double(_, cell_offset(LHSCellOffset), _),
|
|
LHSLvalA = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset))),
|
|
LHSLvalB = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset + 1))),
|
|
LHSRval = binop(float_from_dword, lval(LHSLvalA), lval(LHSLvalB)),
|
|
assign_field_lval_expr_to_var(RHSVar, [LHSLvalA, LHSLvalB],
|
|
LHSRval, Code, !CLD)
|
|
;
|
|
(
|
|
LHSArgPosWidth = apw_partial_first(_, cell_offset(LHSCellOffset),
|
|
Shift, _, arg_mask(Mask), Fill)
|
|
;
|
|
LHSArgPosWidth = apw_partial_shifted(_, cell_offset(LHSCellOffset),
|
|
Shift, _, arg_mask(Mask), Fill)
|
|
),
|
|
LHSLval = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset))),
|
|
LHSRval0 = right_shift_rval(lval(LHSLval), Shift),
|
|
MaskedLHSRval0 = binop(bitwise_and(int_type_uint), LHSRval0,
|
|
const(llconst_int(Mask))),
|
|
maybe_cast_masked_off_rval(Fill, MaskedLHSRval0, MaskedLHSRval),
|
|
assign_field_lval_expr_to_var(RHSVar, [LHSLval], MaskedLHSRval,
|
|
Code, !CLD)
|
|
;
|
|
( LHSArgPosWidth = apw_none_nowhere
|
|
; LHSArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
% The value being assigned is of a dummy type, so no assignment
|
|
% is actually necessary.
|
|
Code = empty
|
|
).
|
|
|
|
:- pred generate_deconstruct_tagword_assign_right(rval::in, prog_var::in,
|
|
arg_pos_width::in, list(lval)::in, llds_code::out,
|
|
code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_deconstruct_tagword_assign_right(LHSRval, RHSVar, ArgPosWidth,
|
|
FieldLvals, Code, !CLD) :-
|
|
(
|
|
ArgPosWidth = apw_partial_shifted(_, _, Shift, _, Mask, Fill),
|
|
LeftRval0 = right_shift_rval(LHSRval, Shift),
|
|
Mask = arg_mask(MaskInt),
|
|
MaskedLeftRval0 = binop(bitwise_and(int_type_uint), LeftRval0,
|
|
const(llconst_int(MaskInt))),
|
|
maybe_cast_masked_off_rval(Fill, MaskedLeftRval0, MaskedLeftRval),
|
|
(
|
|
FieldLvals = [],
|
|
assign_expr_to_var(RHSVar, MaskedLeftRval, Code, !CLD)
|
|
;
|
|
FieldLvals = [_ | _],
|
|
assign_field_lval_expr_to_var(RHSVar, FieldLvals, MaskedLeftRval,
|
|
Code, !CLD)
|
|
)
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _),
|
|
% The value being assigned is of a dummy type, so no assignment
|
|
% is actually necessary.
|
|
Code = empty
|
|
;
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
),
|
|
unexpected($pred, "ArgPosWidth does not belong in tagword")
|
|
).
|
|
|
|
:- pred generate_deconstruct_assign_left(ptag::in, rval::in, arg_pos_width::in,
|
|
prog_var::in, llds_code::out,
|
|
code_loc_dep::in, code_loc_dep::out) is det.
|
|
|
|
generate_deconstruct_assign_left(LHSPtag, LHSBaseRval0, LHSArgPosWidth,
|
|
RHSVar, Code, !CLD) :-
|
|
% Assignment from a variable to an field in a memory cell;
|
|
% we cannot cache this, so generate code for it immediately.
|
|
produce_variable(RHSVar, ProduceRHSVarCode, RHSRval, !CLD),
|
|
materialize_vars_in_rval(LHSBaseRval0, LHSBaseRval,
|
|
MaterializeLHSBaseCode, !CLD),
|
|
(
|
|
LHSArgPosWidth = apw_full(_, cell_offset(LHSCellOffset)),
|
|
LHSLval = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset))),
|
|
AssignCode = singleton(llds_instr(assign(LHSLval, RHSRval),
|
|
"Copy value"))
|
|
;
|
|
LHSArgPosWidth = apw_double(_, cell_offset(LHSCellOffset), _),
|
|
LHSLvalA = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset))),
|
|
LHSLvalB = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset + 1))),
|
|
SrcA = unop(dword_float_get_word0, RHSRval),
|
|
SrcB = unop(dword_float_get_word1, RHSRval),
|
|
Comment = "Update double word",
|
|
AssignCode = from_list([
|
|
llds_instr(assign(LHSLvalA, SrcA), Comment),
|
|
llds_instr(assign(LHSLvalB, SrcB), Comment)
|
|
])
|
|
;
|
|
(
|
|
LHSArgPosWidth = apw_partial_first(_, cell_offset(LHSCellOffset),
|
|
Shift, _, Mask, Fill)
|
|
;
|
|
LHSArgPosWidth = apw_partial_shifted(_, cell_offset(LHSCellOffset),
|
|
Shift, _, Mask, Fill)
|
|
),
|
|
Shift = arg_shift(ShiftInt),
|
|
Mask = arg_mask(MaskInt),
|
|
% XXX ARG_PACK
|
|
% In the usual case where the heap cell we are assigning to
|
|
% is freshly created, this code is *seriously* suboptimal.
|
|
% Instead of filling in the bits belonging to each variable
|
|
% as if the other bits were already there, first looking them up
|
|
% and then putting them back, we should just compute the bits
|
|
% for each variable (shifted by the appropriate amount),
|
|
% and OR them together.
|
|
LHSLval = field(yes(LHSPtag), LHSBaseRval,
|
|
const(llconst_int(LHSCellOffset))),
|
|
ComplementMask = const(llconst_int(\ (MaskInt << ShiftInt))),
|
|
MaskOld = binop(bitwise_and(int_type_uint),
|
|
lval(LHSLval), ComplementMask),
|
|
ShiftedRHSRval = left_shift_rval(RHSRval, Shift, Fill),
|
|
CombinedRval = bitwise_or_two_rvals(MaskOld, ShiftedRHSRval),
|
|
AssignCode = singleton(llds_instr(assign(LHSLval, CombinedRval),
|
|
"Update part of word"))
|
|
;
|
|
( LHSArgPosWidth = apw_none_nowhere
|
|
; LHSArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
% The value being assigned is of a dummy type, so no assignment
|
|
% is actually necessary.
|
|
% XXX Should we try to avoid generating ProduceRHSVarCode
|
|
% and MaterializeLHSBaseCode as well? MaterializeLHSBaseCode
|
|
% is probably needed by other, non-dummy fields, and
|
|
% ProduceRHSVarCode is probably very cheap, so probably not.
|
|
AssignCode = empty
|
|
),
|
|
Code = ProduceRHSVarCode ++ MaterializeLHSBaseCode ++ AssignCode.
|
|
|
|
:- pred generate_deconstruct_tagword_assign_left(prog_var::in,
|
|
arg_pos_width::in,
|
|
list(rval)::in, list(rval)::out, uint::in, uint::out) is det.
|
|
|
|
generate_deconstruct_tagword_assign_left(RHSVar, ArgPosWidth,
|
|
!ToOrRvals, !ToOrMask) :-
|
|
(
|
|
ArgPosWidth = apw_partial_shifted(_, _, Shift, _, Mask, Fill),
|
|
Shift = arg_shift(ShiftInt),
|
|
Mask = arg_mask(MaskInt),
|
|
LeftShiftedRHSRval = left_shift_rval(var(RHSVar), Shift, Fill),
|
|
!:ToOrRvals = [LeftShiftedRHSRval | !.ToOrRvals],
|
|
!:ToOrMask = (uint.cast_from_int(MaskInt) << ShiftInt) \/ !.ToOrMask
|
|
;
|
|
ArgPosWidth = apw_none_shifted(_, _)
|
|
% The value being assigned is of a dummy type, so no assignment
|
|
% is actually necessary.
|
|
;
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
),
|
|
unexpected($pred, "ArgPosWidth is not a packed arg_pos_width")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred take_tagword_args(
|
|
list(arg_and_width(prog_var))::in, list(unify_mode)::in,
|
|
list(arg_and_width(prog_var))::out, list(unify_mode)::out,
|
|
list(arg_and_width(prog_var))::out, list(unify_mode)::out) is det.
|
|
|
|
take_tagword_args([], [], [], [], [], []).
|
|
take_tagword_args([], [_ | _], _, _, _, _) :-
|
|
unexpected($pred, "length mismatch").
|
|
take_tagword_args([_ | _], [], _, _, _, _) :-
|
|
unexpected($pred, "length mismatch").
|
|
take_tagword_args([VarWidth | VarsWidths], [ArgMode | ArgModes],
|
|
TagwordVarsWidths, TagwordArgModes,
|
|
NonTagwordVarsWidths, NonTagwordArgModes) :-
|
|
VarWidth = arg_and_width(_, ArgPosWidth),
|
|
(
|
|
( ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_shifted(_, _)
|
|
),
|
|
take_tagword_args(VarsWidths, ArgModes,
|
|
TailTagwordVarsWidths, TailTagwordArgModes,
|
|
NonTagwordVarsWidths, NonTagwordArgModes),
|
|
TagwordVarsWidths = [VarWidth | TailTagwordVarsWidths],
|
|
TagwordArgModes = [ArgMode | TailTagwordArgModes]
|
|
;
|
|
( ArgPosWidth = apw_full(_, _)
|
|
; ArgPosWidth = apw_double(_, _, _)
|
|
; ArgPosWidth = apw_partial_first(_, _, _, _, _, _)
|
|
; ArgPosWidth = apw_none_nowhere
|
|
),
|
|
TagwordVarsWidths = [],
|
|
TagwordArgModes = [],
|
|
NonTagwordVarsWidths = [VarWidth | VarsWidths],
|
|
NonTagwordArgModes = [ArgMode | ArgModes]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% 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_deconstruct(set_of_progvar::in,
|
|
prog_var::in, prog_var::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_deconstruct(NonLocals, LHSVar, RHSVar, Ptag, ArgMode, Code,
|
|
CI, !CLD) :-
|
|
get_module_info(CI, ModuleInfo),
|
|
RHSType = variable_type(CI, RHSVar),
|
|
compute_assign_direction(ModuleInfo, NonLocals, RHSVar, RHSType, ArgMode,
|
|
Dir),
|
|
(
|
|
Dir = assign_right,
|
|
( if variable_is_forward_live(!.CLD, RHSVar) then
|
|
Ptag = ptag(PtagUint8),
|
|
( if PtagUint8 = 0u8 then
|
|
% Masking off the ptag would be a null operation,
|
|
% since it is already all zeroes.
|
|
assign_var_to_var(RHSVar, LHSVar, !CLD),
|
|
Code = empty
|
|
else
|
|
LHSBodyRval = binop(body, var(LHSVar),
|
|
const(llconst_int(uint8.cast_to_int(PtagUint8)))),
|
|
assign_expr_to_var(RHSVar, LHSBodyRval, Code, !CLD)
|
|
)
|
|
else
|
|
Code = empty
|
|
)
|
|
;
|
|
Dir = assign_left,
|
|
reassign_mkword_hole_var(LHSVar, Ptag, var(RHSVar), Code, !CLD)
|
|
;
|
|
Dir = assign_unused,
|
|
% XXX This will have to change if we start to support aliasing.
|
|
Code = empty
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module ll_backend.unify_gen_deconstruct.
|
|
%---------------------------------------------------------------------------%
|