mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-27 07:14:20 +00:00
13e6050f16
compiler/builtin_ops.m:
Parameterize the unchecked left and right shift builtin ops
by whether the shift amount is an int or an uint. So far,
the shift amount has always been an int; allowing the shift amount
to be a uint is new.
Recognize the Mercury functions unchecked_{left,right}_ushift
as being builtins implemented by the new variants of the unchecked
shift builtin ops mentioned above. These Mercury functions do not
exist yet. They will be added in step two of this diff, *after* this
change has been installed. (Making something a builtin, and *then*
defining it, is easier than defining it, and *then* making it a builtin,
because in the latter case, the stage 1 and stage 2 compilers disagree
on whether the function in question needs to have a definition.)
compiler/options.m:
Provide a way to check whether an installed compiler has this diff.
(This is needed for step 2.)
compiler/lookup_switch.m:
compiler/ml_lookup_switch.m:
compiler/ml_unify_gen_util.m:
compiler/unify_gen_util.m:
When generating references to unchecked shift ops, specify that the
shift amount is an int.
compiler/erl_call_gen.m:
Don't treat unchecked shifts by uint amounts as builtins, since I (zs)
don't know how this should be done in Erlang.
compiler/llds_out_data.m:
compiler/mlds_to_c_data.m:
compiler/mlds_to_cs_data.m:
When writing out unchecked shifts for C or C#, cast the shift amount
to int if it was originally uint.
compiler/mlds_to_java_data.m:
When writing out unchecked shifts for Java, ignore the type of the
shift amount, since (in the absence of a uint type in Java) we
represent both int and uint values the same way.
compiler/bytecode.m:
compiler/c_util.m:
compiler/llds.m:
compiler/ml_global_data.m:
compiler/mlds_dump.m:
compiler/opt_debug.m:
Conform to the changes above.
428 lines
15 KiB
Mathematica
428 lines
15 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_util.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module ll_backend.llds.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred int_tag_to_const_and_int_type(int_tag::in, rval_const::out,
|
|
int_type::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type arg_and_width(Arg)
|
|
---> arg_and_width(Arg, arg_pos_width).
|
|
|
|
:- pred associate_cons_id_args_with_widths(module_info::in, cons_id::in,
|
|
list(Arg)::in, list(arg_and_width(Arg))::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% OR together the given rvals.
|
|
%
|
|
:- func bitwise_or_rvals(list(rval)) = rval.
|
|
:- func bitwise_or_some_rvals(rval, list(rval)) = rval.
|
|
:- func bitwise_or_two_rvals(rval, rval) = rval.
|
|
|
|
:- func left_shift_rval(rval, arg_shift, fill_kind) = rval.
|
|
|
|
:- func right_shift_rval(rval, arg_shift) = rval.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type maybe_zero_const
|
|
---> is_not_zero_const
|
|
; is_zero_const.
|
|
|
|
:- func is_zero_const(rval_const) = maybe_zero_const.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% If a sub-word-sized signed integer has a negative value, then it will
|
|
% have sign-extend bits *beyond* its usual size. OR-ing the raw form
|
|
% of that sub-word-sized signed integer with the values of the other fields
|
|
% may thus stomp all over the bits assigned to store the other fields
|
|
% that are to the left of the sub-word-sized signed integer.
|
|
%
|
|
% Prevent this by casting sub-word-sized signed integers to their
|
|
% unsigned counterparts before casting them to the word-sized unsigned type
|
|
% that is the usual input type of shift and OR operations.
|
|
%
|
|
:- pred cast_to_unsigned_without_sign_extend(fill_kind::in,
|
|
rval::in, rval::out) is det.
|
|
|
|
:- pred maybe_cast_masked_off_rval(fill_kind::in, rval::in, rval::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type assign_dir
|
|
---> assign_left
|
|
; assign_right
|
|
; assign_unused.
|
|
|
|
% Figure out in which direction the assignment goes
|
|
% between a field of a term, and the corresponding argument.
|
|
%
|
|
:- pred compute_assign_direction(module_info::in, unify_mode::in, mer_type::in,
|
|
assign_dir::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module backend_libs.
|
|
:- import_module backend_libs.builtin_ops.
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
|
|
:- import_module int.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module term.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
int_tag_to_const_and_int_type(IntTag, Const, Type) :-
|
|
(
|
|
IntTag = int_tag_int(Int),
|
|
Const = llconst_int(Int),
|
|
Type = int_type_int
|
|
;
|
|
IntTag = int_tag_uint(UInt),
|
|
Const = llconst_uint(UInt),
|
|
Type = int_type_uint
|
|
;
|
|
IntTag = int_tag_int8(Int8),
|
|
Const = llconst_int8(Int8),
|
|
Type = int_type_int8
|
|
;
|
|
IntTag = int_tag_uint8(UInt8),
|
|
Const = llconst_uint8(UInt8),
|
|
Type = int_type_uint8
|
|
;
|
|
IntTag = int_tag_int16(Int16),
|
|
Const = llconst_int16(Int16),
|
|
Type = int_type_int16
|
|
;
|
|
IntTag = int_tag_uint16(UInt16),
|
|
Const = llconst_uint16(UInt16),
|
|
Type = int_type_uint16
|
|
;
|
|
IntTag = int_tag_int32(Int32),
|
|
Const = llconst_int32(Int32),
|
|
Type = int_type_int32
|
|
;
|
|
IntTag = int_tag_uint32(UInt32),
|
|
Const = llconst_uint32(UInt32),
|
|
Type = int_type_uint32
|
|
;
|
|
IntTag = int_tag_int64(Int64),
|
|
Const = llconst_int64(Int64),
|
|
Type = int_type_int64
|
|
;
|
|
IntTag = int_tag_uint64(UInt64),
|
|
Const = llconst_uint64(UInt64),
|
|
Type = int_type_uint64
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
associate_cons_id_args_with_widths(ModuleInfo, ConsId, AllArgs,
|
|
AllArgsPosWidths) :-
|
|
( if get_cons_repn_defn(ModuleInfo, ConsId, ConsRepnDefn) then
|
|
ConsArgRepns = ConsRepnDefn ^ cr_args,
|
|
ConsTag = ConsRepnDefn ^ cr_tag,
|
|
list.length(AllArgs, NumAllArgs),
|
|
list.length(ConsArgRepns, NumConsArgs),
|
|
NumExtraArgs = NumAllArgs - NumConsArgs,
|
|
( if NumExtraArgs = 0 then
|
|
zip_args_widths(AllArgs, ConsArgRepns, AllArgsPosWidths)
|
|
else if NumExtraArgs > 0 then
|
|
list.det_split_list(NumExtraArgs, AllArgs, ExtraArgs, ConsArgs),
|
|
( if
|
|
ConsTag = remote_args_tag(RemoteArgsTagInfo),
|
|
RemoteArgsTagInfo = remote_args_shared(_, RemoteSecTag),
|
|
RemoteSecTag = remote_sectag(_, SectagSize),
|
|
SectagSize = rsectag_word
|
|
then
|
|
InitOffset = 1
|
|
else
|
|
InitOffset = 0
|
|
),
|
|
allocate_consecutive_full_words(InitOffset,
|
|
ExtraArgs, ExtraArgsPosWidths),
|
|
zip_args_widths(ConsArgs, ConsArgRepns, ConsArgsPosWidths),
|
|
AllArgsPosWidths = ExtraArgsPosWidths ++ ConsArgsPosWidths
|
|
else
|
|
unexpected($pred, "too few arguments")
|
|
)
|
|
else
|
|
allocate_consecutive_full_words(0, AllArgs, AllArgsPosWidths)
|
|
).
|
|
|
|
:- pred zip_args_widths(list(Arg)::in,
|
|
list(constructor_arg_repn)::in, list(arg_and_width(Arg))::out) is det.
|
|
|
|
zip_args_widths([], [], []).
|
|
zip_args_widths([], [_ | _], _) :-
|
|
unexpected($pred, "length mismatch").
|
|
zip_args_widths([_ | _], [], _) :-
|
|
unexpected($pred, "length mismatch").
|
|
zip_args_widths([Arg | Args], [ConsArgRepn | ConsArgRepns],
|
|
[ArgTypeWidth | ArgsTypesWidth]) :-
|
|
ArgTypeWidth = arg_and_width(Arg, ConsArgRepn ^ car_pos_width),
|
|
zip_args_widths(Args, ConsArgRepns, ArgsTypesWidth).
|
|
|
|
% The initial offset that our callers should specify
|
|
% depends on the absence/presence of a secondary tag.
|
|
%
|
|
:- pred allocate_consecutive_full_words(int::in,
|
|
list(Arg)::in, list(arg_and_width(Arg))::out) is det.
|
|
|
|
allocate_consecutive_full_words(_, [], []).
|
|
allocate_consecutive_full_words(CurOffset,
|
|
[Arg | Args], [ArgPosWidth | ArgsPosWidths]) :-
|
|
PosWidth = apw_full(arg_only_offset(CurOffset), cell_offset(CurOffset)),
|
|
ArgPosWidth = arg_and_width(Arg, PosWidth),
|
|
allocate_consecutive_full_words(CurOffset + 1, Args, ArgsPosWidths).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
bitwise_or_rvals(Rvals) = OrAllRval :-
|
|
(
|
|
Rvals = [],
|
|
OrAllRval = const(llconst_int(0))
|
|
;
|
|
Rvals = [HeadRval | TailRvals],
|
|
OrAllRval = bitwise_or_some_rvals(HeadRval, TailRvals)
|
|
).
|
|
|
|
bitwise_or_some_rvals(HeadRval, TailRvals) = OrAllRval :-
|
|
% We currently do this a linear fashion, starting at the rightmost
|
|
% arguments, and moving towards the left.
|
|
%
|
|
% We could explore whether other strategies, such as balanced trees,
|
|
% (or rather, trees that are as balanced as possible) would work better.
|
|
(
|
|
TailRvals = [],
|
|
OrAllRval = HeadRval
|
|
;
|
|
TailRvals = [HeadTailRval | TailTailRvals],
|
|
TailOrAllRval = bitwise_or_some_rvals(HeadTailRval, TailTailRvals),
|
|
OrAllRval = bitwise_or_two_rvals(HeadRval, TailOrAllRval)
|
|
).
|
|
|
|
bitwise_or_two_rvals(RvalA, RvalB) = OrRval :-
|
|
% OR-ing anything with zero has no effect.
|
|
( if
|
|
( RvalA = const(llconst_int(0))
|
|
; RvalA = const(llconst_uint(0u))
|
|
)
|
|
then
|
|
OrRval = RvalB
|
|
else if
|
|
( RvalB = const(llconst_int(0))
|
|
; RvalB = const(llconst_uint(0u))
|
|
)
|
|
then
|
|
OrRval = RvalA
|
|
else
|
|
OrRval = binop(bitwise_or(int_type_uint), RvalA, RvalB)
|
|
).
|
|
|
|
left_shift_rval(Rval, Shift, Fill) = ShiftedUnsignedRval :-
|
|
Shift = arg_shift(ShiftInt),
|
|
cast_to_unsigned_without_sign_extend(Fill, Rval, UnsignedRval),
|
|
( if
|
|
(
|
|
% Shifting anything by zero bits has no effect.
|
|
ShiftInt = 0
|
|
;
|
|
% Shifting zero any number of bits has no effect.
|
|
Rval = const(Const),
|
|
is_zero_const(Const) = is_zero_const
|
|
)
|
|
then
|
|
ShiftedUnsignedRval = UnsignedRval
|
|
else
|
|
ShiftedUnsignedRval =
|
|
binop(unchecked_left_shift(int_type_uint, shift_by_int),
|
|
UnsignedRval, const(llconst_int(ShiftInt)))
|
|
).
|
|
|
|
right_shift_rval(Rval, Shift) = ShiftedRval :-
|
|
Shift = arg_shift(ShiftInt),
|
|
% Shifting anything by zero bits has no effect.
|
|
% Shifting zero any number of bits has no effect.
|
|
% However, our caller won't give us either a zero shift amount
|
|
% or a constant zero rval to shift.
|
|
% XXX ARG_PACK Should we cast Rval to unsigned like left_shift_rval?
|
|
ShiftedRval = binop(unchecked_right_shift(int_type_uint, shift_by_int),
|
|
Rval, const(llconst_int(ShiftInt))).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
is_zero_const(Const) = IsZero :-
|
|
(
|
|
Const = llconst_int(Int),
|
|
IsZero = (if Int = 0 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_uint(Uint),
|
|
IsZero = (if Uint = 0u then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_int8(Int8),
|
|
IsZero = (if Int8 = 0i8 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_uint8(Uint8),
|
|
IsZero = (if Uint8 = 0u8 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_int16(Int16),
|
|
IsZero = (if Int16 = 0i16 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_uint16(Uint16),
|
|
IsZero = (if Uint16 = 0u16 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_int32(Int32),
|
|
IsZero = (if Int32 = 0i32 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_uint32(Uint32),
|
|
IsZero = (if Uint32 = 0u32 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_int64(Int64),
|
|
IsZero = (if Int64 = 0i64 then is_zero_const else is_not_zero_const)
|
|
;
|
|
Const = llconst_uint64(Uint64),
|
|
IsZero = (if Uint64 = 0u64 then is_zero_const else is_not_zero_const)
|
|
;
|
|
( Const = llconst_true
|
|
; Const = llconst_false
|
|
; Const = llconst_foreign(_, _)
|
|
; Const = llconst_float(_)
|
|
; Const = llconst_string(_)
|
|
; Const = llconst_multi_string(_)
|
|
; Const = llconst_code_addr(_)
|
|
; Const = llconst_data_addr(_, _)
|
|
),
|
|
IsZero = is_not_zero_const
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
cast_to_unsigned_without_sign_extend(Fill, Rval0, Rval) :-
|
|
(
|
|
( Fill = fill_enum
|
|
; Fill = fill_uint8
|
|
; Fill = fill_uint16
|
|
; Fill = fill_uint32
|
|
; Fill = fill_char21
|
|
),
|
|
Rval1 = Rval0
|
|
;
|
|
Fill = fill_int8,
|
|
Rval1 = cast(lt_int(int_type_uint8), Rval0)
|
|
;
|
|
Fill = fill_int16,
|
|
Rval1 = cast(lt_int(int_type_uint16), Rval0)
|
|
;
|
|
Fill = fill_int32,
|
|
Rval1 = cast(lt_int(int_type_uint32), Rval0)
|
|
),
|
|
Rval = cast(lt_int(int_type_uint), Rval1).
|
|
|
|
maybe_cast_masked_off_rval(Fill, MaskedRval0, MaskedRval) :-
|
|
(
|
|
( Fill = fill_enum
|
|
; Fill = fill_char21
|
|
),
|
|
MaskedRval = MaskedRval0
|
|
;
|
|
( Fill = fill_int8, CastType = int_type_int8
|
|
; Fill = fill_uint8, CastType = int_type_uint8
|
|
; Fill = fill_int16, CastType = int_type_int16
|
|
; Fill = fill_uint16, CastType = int_type_uint16
|
|
; Fill = fill_int32, CastType = int_type_int32
|
|
; Fill = fill_uint32, CastType = int_type_uint32
|
|
),
|
|
MaskedRval = cast(lt_int(CastType), MaskedRval0)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
compute_assign_direction(ModuleInfo, ArgMode, ArgType, Dir) :-
|
|
% Any change here will require a corresponding change
|
|
% in ml_compute_assign_direction.
|
|
ArgMode = unify_modes_li_lf_ri_rf(LeftInitInst, LeftFinalInst,
|
|
RightInitInst, RightFinalInst),
|
|
init_final_insts_to_top_functor_mode(ModuleInfo,
|
|
LeftInitInst, LeftFinalInst, ArgType, LeftTopMode),
|
|
init_final_insts_to_top_functor_mode(ModuleInfo,
|
|
RightInitInst, RightFinalInst, ArgType, RightTopMode),
|
|
(
|
|
LeftTopMode = top_in,
|
|
(
|
|
RightTopMode = top_in,
|
|
% Both input: it is a test unification.
|
|
% This shouldn't happen, since mode analysis should avoid
|
|
% creating any tests in the arguments of a construction
|
|
% or deconstruction unification.
|
|
unexpected($pred, "test in arg of [de]construction")
|
|
;
|
|
RightTopMode = top_out,
|
|
% Input - output: it is an assignment to the RHS.
|
|
Dir = assign_right
|
|
;
|
|
RightTopMode = top_unused,
|
|
unexpected($pred, "some strange unify")
|
|
)
|
|
;
|
|
LeftTopMode = top_out,
|
|
(
|
|
RightTopMode = top_in,
|
|
% Output - input: it is an assignment to the LHS.
|
|
Dir = assign_left
|
|
;
|
|
( RightTopMode = top_out
|
|
; RightTopMode = top_unused
|
|
),
|
|
unexpected($pred, "some strange unify")
|
|
)
|
|
;
|
|
LeftTopMode = top_unused,
|
|
(
|
|
RightTopMode = top_unused,
|
|
% Unused - unused: the unification has no effect.
|
|
Dir = assign_unused
|
|
;
|
|
( RightTopMode = top_in
|
|
; RightTopMode = top_out
|
|
),
|
|
unexpected($pred, "some strange unify")
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module ll_backend.unify_gen_util.
|
|
%---------------------------------------------------------------------------%
|