[m-rev.] for review: pack sub-word-sized integers and dummies
Peter Wang
novalazy at gmail.com
Sat Apr 21 12:06:50 AEST 2018
On Wed, 18 Apr 2018 04:58:59 +1000 (AEST), "Zoltan Somogyi" <zoltan.somogyi at runbox.com> wrote:
> For review by anyone.
>
> I have bootchecked a pre-final-cleanup version of this diff
> 3x2 times: in asm_fast.gc, asm_fast.debug.gc.stseg, and hlc.gc,
> and in both 64 and 32 bit mode. The only failures were two tests
> in debug grades that fail even without this diff.
>
> I will repeat all six bootchecks before final commit.
>
> When it comes to testing this diff, please remember I committed
> an extensive test case intended for this about a week ago.
>
> diff --git a/compiler/du_type_layout.m b/compiler/du_type_layout.m
> index 9c10e89..805d011 100644
> --- a/compiler/du_type_layout.m
> +++ b/compiler/du_type_layout.m
> @@ -248,12 +245,71 @@ decide_type_repns(!ModuleInfo, !Specs) :-
> add_special_pred_decl_defns_for_type_maybe_lazily,
> TypeTable, !ModuleInfo).
>
> -%---------------------------------------------------------------------------%
> +:- pred setup_decide_du_params(globals::in, direct_arg_map::in,
> + decide_du_params::out) is det.
> +
> +setup_decide_du_params(Globals, DirectArgMap, Params) :-
> + % Compute Target.
> + globals.get_target(Globals, Target),
> +
...
> + % Compute ArgPackBits.
> + globals.lookup_int_option(Globals, arg_pack_bits, ArgPackBits),
>
> -are_direct_args_enabled(Globals, Target, MaybeDirectArgs) :-
> + % Compute AllowDoubleWordInts and AllowNoneForDummy.
AllowPackingDummies
> + globals.lookup_bool_option(Globals, allow_double_word_ints,
> + AllowDoubleWordInts),
> + globals.lookup_bool_option(Globals, allow_packing_ints,
> + AllowPackingInts),
> + globals.lookup_bool_option(Globals, allow_packing_dummies,
> + AllowPackingDummies),
> +
> + % Compute MaybeDirectArgs.
> (
> Target = target_c,
> globals.lookup_bool_option(Globals, record_term_sizes_as_words,
> +
> + % The memory cell for a term consists of, in order:
> + %
> + % - a word containing the remote secondary tag bits, if this ctor
> + % has a remote secondary tag;
> + %
> + % - zero or more extra arguments containing typeinfos and/or
> + % typeclass_infos added by polymorphism, if this ctor has one or
> + % more existential constraints (this number should be given by
> + % NumExtraArgWords), and
> + %
> + % - the words containing the ctor's arguments themselves.
> + %
> + % The calls to decide_complex_du_ctor_args_loop decide the representation
> + % only of the last category. FirstArgWordNum measures offset with respect
> + % to the last category only. FirstCellWordNum, which we should start
> + % recording (in a separate field) once we can calculate it correctly,
> + % would measure offset with respect to the start of the cell.
the offset
> + %
> + % TODO In the future, if NumExtraArgWords is really zero, we should pass
> + % FirstArgWordNum = 0, FirstShift = NumRemoteSecTagBits, to allow any
> + % initial sub-word-sized arguments to be packed together with the
> + % secondary tag. If *any* ctor in a du type actually does any such packing,
> + % then accessing the remote secondary tag on values of that type
> + % will require applying a mask to the first word of the cell.
> + % The simplest way to ensure finding all the places where this must be done
> + % is to change the second argument of shared_remote_tag from an int
> + % to something that corresponds either to apw_full_word (the current
> + % arrangement where the remote secondary tag takes a full word) or to
> + % apw_partial_first (the new, optimized arrangement).
> + %
> + % TODO An even more aggressive possible future optimization would apply
> + % to ctors whose arguments take up less than one word in total:
> + % these could be stored next to the primary tag. If a type has
> + % more than one such ctor, they would need to be distinguished by
> + % a local secondary tag between the primary tag and the packed arguments.
> + % Unlike the first todo above, implementing this todo will require
> + % changing our current approach of (a) first deciding the tag of a ctor,
> + % and (b) *then* deciding the representation of its arguments.
> + %
> + FirstCellWordNum = NumSecTagWords + NumExtraArgWords,
> + FirstArgWordNum = 0,
> + FirstShift = 0,
> decide_complex_du_ctor_args_loop(ModuleInfo, Params, map.init,
> - 0, CtorArgs, CtorArgRepnsBase),
> + FirstArgWordNum, FirstCellWordNum, FirstShift,
> + CtorArgs, CtorArgRepnsBase),
> decide_complex_du_ctor_args_loop(ModuleInfo, Params, ComponentTypeMap,
> - 0, CtorArgs, CtorArgRepnsPacked),
> + FirstArgWordNum, FirstCellWordNum, FirstShift,
> + CtorArgs, CtorArgRepnsPacked),
> WorthPacking = worth_arg_packing(CtorArgRepnsBase, CtorArgRepnsPacked),
> (
> WorthPacking = no,
See the comment about may_pack_arg_type below.
> -decide_complex_du_ctor_args_loop(_, _, _, _, [], []).
> +decide_complex_du_ctor_args_loop(_, _, _, _, _, _, [], []).
> decide_complex_du_ctor_args_loop(ModuleInfo, Params, ComponentTypeMap,
> - CurShift, [Arg | Args], [ArgRepn | ArgRepns]) :-
> + CurAOWordNum, CurCellWordNum, CurShift,
> + [Arg | Args], [ArgRepn | ArgRepns]) :-
> Arg = ctor_arg(ArgName, ArgType, ArgContext),
...
> + ( if may_pack_arg_type(Params, ComponentTypeMap, ArgType, Packable) then
> + (
> + Packable = packable_n_bits(NumArgBits, FillKind),
> + ArgNumBits = arg_num_bits(NumArgBits),
> + ArgMaskInt = int.pow(2, NumArgBits) - 1,
> + ArgMask = arg_mask(ArgMaskInt),
> % Try to place Arg in the current word.
> % If it does not fit, move on to the next word.
> - ( if CurShift + NumArgBits =< TargetWordBits then
> + ( if CurShift + NumArgBits =< Params ^ ddp_arg_pack_bits then
> + ArgOnlyOffset0 = arg_only_offset(CurAOWordNum),
> + CellOffset0 = cell_offset(CurCellWordNum),
> ( if CurShift = 0 then
> - ArgWidth0 = partial_word_first(ArgMask)
> + ArgPosWidth0 = apw_partial_first(ArgOnlyOffset0,
> + CellOffset0, ArgNumBits, ArgMask, FillKind)
> else
> - ArgWidth0 = partial_word_shifted(CurShift, ArgMask)
> + ArgPosWidth0 = apw_partial_shifted(ArgOnlyOffset0,
> + CellOffset0, arg_shift(CurShift), ArgNumBits,
> + ArgMask, FillKind)
> ),
> + NextAOWordNum = CurAOWordNum,
> + NextCellWordNum = CurCellWordNum,
> NextShift = CurShift + NumArgBits
> else
> - ArgWidth0 = partial_word_first(ArgMask),
> + padding_increment(CurShift, PaddingIncrement),
> + AfterPaddingAOWordNum = CurAOWordNum + PaddingIncrement,
> + AfterPaddingCellWordNum = CurCellWordNum + PaddingIncrement,
> + ArgOnlyOffset0 = arg_only_offset(AfterPaddingAOWordNum),
> + CellOffset0 = cell_offset(AfterPaddingCellWordNum),
> + ArgPosWidth0 = apw_partial_first(ArgOnlyOffset0, CellOffset0,
> + ArgNumBits, ArgMask, FillKind),
> + NextAOWordNum = AfterPaddingAOWordNum,
> + NextCellWordNum = AfterPaddingCellWordNum,
> NextShift = NumArgBits
> + )
> + ;
> + Packable = packable_dummy,
> + ( if CurShift = 0 then
> + ArgPosWidth0 = apw_none_nowhere
> + else
> + ArgOnlyOffset0 = arg_only_offset(CurAOWordNum),
> + CellOffset0 = cell_offset(CurCellWordNum),
> + ArgPosWidth0 = apw_none_shifted(ArgOnlyOffset0, CellOffset0)
> + ),
> + NextAOWordNum = CurAOWordNum,
> + NextCellWordNum = CurCellWordNum,
> + NextShift = CurShift
> ),
> decide_complex_du_ctor_args_loop(ModuleInfo, Params, ComponentTypeMap,
> - NextShift, Args, ArgRepns),
> - % If this argument starts a word, then it is a *partial* word
> - % only if (a) there is a next argument, and (b) it is packed with it.
> - % Otherwise, it is not packed.
> + NextAOWordNum, NextCellWordNum, NextShift, Args, ArgRepns),
> (
> - ArgWidth0 = partial_word_first(_),
> + ArgPosWidth0 = apw_partial_first(ArgOnlyOffset, CellOffset,
> + _, _, _),
> + % If this argument starts a word, then it is a *partial* word
> + % only if (a) there is a next argument, and (b) it is packed
> + % with it. Otherwise, it is not packed.
> ( if
> ArgRepns = [NextArgRepn | _],
> - NextArgRepn ^ car_width = partial_word_shifted(_, _)
> + NextArgPosWidth = NextArgRepn ^ car_pos_width,
> + ( NextArgPosWidth = apw_partial_shifted(_, _, _, _, _, _)
> + ; NextArgPosWidth = apw_none_shifted(_, _)
> + )
> + then
> + ArgPosWidth = ArgPosWidth0
> + else
> + ArgPosWidth = apw_full(ArgOnlyOffset, CellOffset)
> + )
> + ;
> + ArgPosWidth0 = apw_none_shifted(_, _),
> + % We represent a dummy argument as apw_none_shifted
> + % only if it is packed with other sub-word arguments both
> + % before it and after it. The "before it" part was tested above.
> + % Here we test the "after it" part.
> + ( if
> + ArgRepns = [NextArgRepn | _],
> + NextArgRepn ^ car_pos_width =
> + apw_partial_shifted(_, _, _, _, _, _)
May be followed by apw_none_shifted as well?
> then
> - ArgWidth = ArgWidth0
> + ArgPosWidth = ArgPosWidth0
> else
> - ArgWidth = full_word
> + ArgPosWidth = apw_none_nowhere
> )
> ;
> +:- pred may_pack_arg_type(decide_du_params::in, component_type_map::in,
> + mer_type::in, packable_kind::out) is semidet.
> +
> +may_pack_arg_type(Params, ComponentTypeMap, ArgType, PackableKind) :-
> + % XXX ARG_PACK Make this code dereference eqv types,
> + % subject to all types involved having the same visibility.
> + type_to_ctor(ArgType, ArgTypeCtor),
> + ( if map.search(ComponentTypeMap, ArgTypeCtor, ComponentKind) then
> + ComponentKind = packable(PackableKind),
> + (
> + PackableKind = packable_n_bits(NumArgBits, _FillKind),
> + NumArgBits < Params ^ ddp_arg_pack_bits
> + ;
> + PackableKind = packable_dummy,
> + % XXX ARG_PACK For bootstrapping.
> + Params ^ ddp_allow_packing_dummies = yes
> + )
> + else
> + ArgType = builtin_type(builtin_type_int(ArgIntType)),
> + Params ^ ddp_allow_packing_ints = yes,
> + (
> + (
> + ArgIntType = int_type_int8,
> + NumArgBits = 8,
> + FillKind = fill_int8
> + ;
> + ArgIntType = int_type_int16,
> + NumArgBits = 16,
> + FillKind = fill_int16
> + ;
> + ArgIntType = int_type_int32,
> + NumArgBits = 32,
> + NumArgBits < Params ^ ddp_arg_pack_bits,
> + FillKind = fill_int32
> + )
> + ;
> + (
> + ArgIntType = int_type_uint8,
> + NumArgBits = 8,
> + FillKind = fill_uint8
> + ;
> + ArgIntType = int_type_uint16,
> + NumArgBits = 16,
> + FillKind = fill_uint16
> + ;
> + ArgIntType = int_type_uint32,
> + NumArgBits = 32,
> + NumArgBits < Params ^ ddp_arg_pack_bits,
> + FillKind = fill_uint32
> + )
> + ),
> + PackableKind = packable_n_bits(NumArgBits, FillKind)
> + ).
Sub-word-sized integers will be packed (if the option is enabled) even
if the overall cell size would not be reduced. Is that deliberate?
(The worth_arg_packing test might not be worth keeping, that's fine.)
> @@ -1487,48 +1786,202 @@ compute_cheaper_tag_test(TypeCtor, CtorRepns, CheaperTagTest) :-
> ).
>
> %---------------------------------------------------------------------------%
> -%
> -% Predicates to create and maintain ctor_name_to_repn_maps.
> -%
>
> -:- func add_default_repn_to_ctor_arg(constructor_arg) = constructor_arg_repn.
> +:- pred inform_about_any_suboptimal_packing(decide_du_params::in,
> + sym_name::in, prog_context::in, list(constructor_arg_repn)::in,
> + list(error_spec)::in, list(error_spec)::out) is det.
>
> -add_default_repn_to_ctor_arg(ConsArg) = ConsArgRepn :-
> - ConsArg = ctor_arg(MaybeFieldName, Type, Context),
> - ConsArgRepn = ctor_arg_repn(MaybeFieldName, Type, full_word, Context).
> +inform_about_any_suboptimal_packing(Params, CtorSymName, CtorContext,
> + CtorArgRepns, !Specs) :-
> + % Find the number of words we would need to store all the sub-word-sized
> + % arguments in CtorArgRepns using the first-fit-decreasing algorithm
> + % (see the wikipedia page on "Bin_packing_problem"). If this number,
> + % NumSubWordBins, is smaller than ActualNumSubWords, then generate
> + % an informational message giving SubWordBins as a better packing order
> + % of the arguments than the one in the program.
> +
> + record_subword_args_and_count_their_words(CtorArgRepns, 0,
> + [], SubWords, 0, ActualNumSubWords),
> + list.sort(SubWords, SortedSubWords),
> + list.reverse(SortedSubWords, RevSortedSubWords),
> + BinSize = Params ^ ddp_arg_pack_bits,
> + list.foldl(insert_subword_into_first_fit_bin(BinSize), RevSortedSubWords,
> + [], SubWordBins),
> + list.length(SubWordBins, NumSubWordBins),
> +
> + worth_arg_packing_compare(ActualNumSubWords, NumSubWordBins, WorthWhile),
> + (
> + WorthWhile = no
> + ;
> + WorthWhile = yes,
> + list.length(CtorArgRepns, CtorArity),
> + CtorSymNameArity = sym_name_arity(CtorSymName, CtorArity),
> + StartPieces = [words("The arguments of the constructor"),
> + unqual_sym_name_and_arity(CtorSymNameArity),
> + words("could be packed more tightly."),
> + words("Here is one arrangement for the arguments"),
> + words("which take up less than one wor each"),
word
> + words("that would allow better packing."),
> + words("(The position of the word sized arguments"),
> + words("does not affect the effectiveness of the packing.)"), nl],
> diff --git a/compiler/foreign.m b/compiler/foreign.m
> index e79a1ba..f152abc 100644
> --- a/compiler/foreign.m
> +++ b/compiler/foreign.m
> @@ -54,6 +54,11 @@
> %
> :- func to_exported_type(module_info, mer_type) = exported_type.
>
> + % A version of to_exported_type which requires the given Mercury type
> + % to be a builtin.
> + %
I suggest:
A version of to_exported_type where the given Mercury type must be a
builtin type.
> +:- func builtin_type_to_exported_type(mer_type) = exported_type.
> +
> % Given the exported_type representation for a type, determine
> % whether or not it is a foreign type, and if yes, return the foreign
> % type's assertions.
> @@ -194,6 +199,9 @@ to_exported_type(ModuleInfo, Type) = ExportType :-
> ExportType = exported_type_mercury(Type)
> ).
>
> +builtin_type_to_exported_type(Type) = ExportType :-
> + ExportType = exported_type_mercury(Type).
> +
> diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m
> index d61cf96..5d8427c 100644
> --- a/compiler/ml_code_util.m
> +++ b/compiler/ml_code_util.m
...
> + % For the MLDS->C back-end, we need to handle constant floats,
> + % int64s and uint64s specially. Boxed floats, inst64s and uint64s
int64s
> + % normally get heap allocated, whereas for other types boxing
> + % is just a cast (casts are OK in static initializers, but calls
> + % to malloc() are not).
> diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
> index 70b0322..f866f3f 100644
> --- a/compiler/ml_unify_gen.m
> +++ b/compiler/ml_unify_gen.m
...
> +
> +:- func ml_lshift(mlds_rval, arg_shift) = mlds_rval.
>
> -ml_lshift(Rval0, Shift) = Rval :-
> +ml_lshift(Rval, Shift) = ShiftedRval :-
> + Shift = arg_shift(ShiftInt),
> + ( if Rval = ml_const(mlconst_null(_)) then
> % We may get nulls from unfilled fields. Replace them with zeroes
> % so we don't get type errors from the C compiler.
> - ( if Rval0 = ml_const(mlconst_null(_)) then
> - Rval = ml_const(mlconst_int(0))
> - else if Shift = 0 then
> - Rval = Rval0
> - else if Rval0 = ml_unop(box(Type), SubRval0) then
> - SubRval = ml_binop(unchecked_left_shift(int_type_int), SubRval0,
> - ml_const(mlconst_int(Shift))),
> - Rval = ml_unop(box(Type), SubRval)
> + ShiftedRval = ml_const(mlconst_int(0))
> + else if Rval = ml_const(mlconst_int(0)) then
> + % Shifting a zero by any amount is a noop.
> + ShiftedRval = Rval
> + else if ShiftInt = 0 then
> + % Shifting anything by zero bits is a noop.
> + ShiftedRval = Rval
> + else
> + ( if Rval = ml_unop(box(Type), SubRval) then
> + ShiftedSubRval = ml_binop(unchecked_left_shift(int_type_int),
> + SubRval, ml_const(mlconst_int(ShiftInt))),
> + ShiftedRval = ml_unop(box(Type), ShiftedSubRval)
> else
> - Rval = ml_binop(unchecked_left_shift(int_type_int), Rval0,
> - ml_const(mlconst_int(Shift)))
> + ShiftedRval = ml_binop(unchecked_left_shift(int_type_int),
> + Rval, ml_const(mlconst_int(ShiftInt)))
> + )
> ).
>
> -:- func ml_rshift(mlds_rval, int) = mlds_rval.
> +:- func ml_rshift(mlds_rval, arg_shift) = mlds_rval.
>
> -ml_rshift(Rval, Shift) =
> - ( if Shift = 0 then
> - Rval
> +ml_rshift(Rval, Shift) = ShiftedRval :-
> + Shift = arg_shift(ShiftInt),
> + ( if Rval = ml_const(mlconst_int(0)) then
> + % Shifting a zero by any amount is a noop.
> + ShiftedRval = Rval
> + else if ShiftInt = 0 then
> + % Shifting anything by zero bits is a noop.
> + ShiftedRval = Rval
> else
> - ml_binop(unchecked_right_shift(int_type_int), Rval,
> - ml_const(mlconst_int(Shift)))
> + ShiftedRval = ml_binop(unchecked_right_shift(int_type_int),
> + Rval, ml_const(mlconst_int(ShiftInt)))
> ).
ml_rshift doesn't handle a boxed value like ml_lshift; should it?
> @@ -3276,6 +3503,45 @@ ml_cons_id_to_tag(Info, ConsId, Tag) :-
> ml_gen_info_get_module_info(Info, ModuleInfo),
> Tag = cons_id_to_tag(ModuleInfo, ConsId).
>
> +:- pred is_apw_full(arg_pos_width::in) is semidet.
> +
> +is_apw_full(apw_full(_, _)).
> +
> +:- pred allocate_consecutive_ctor_arg_repns(int::in,
> + list(mer_type)::in, list(constructor_arg_repn)::out) is det.
I suggest allocate_consecutive_full_word_ctor_arg_repns.
> +
> +allocate_consecutive_ctor_arg_repns(_, [], []).
> +allocate_consecutive_ctor_arg_repns(CurOffset,
> + [Type | Types], [ArgRepn | ArgRepns]) :-
> + % Tuples and extra fields are word-sized, and have no extra type_infos
> + % and/or typeclass_infos in front of them.
This comment makes more sense near the call sites.
> + ArgRepn = ctor_arg_repn(no, Type,
> + apw_full(arg_only_offset(CurOffset), cell_offset(CurOffset)),
> + term.context_init),
> + allocate_consecutive_ctor_arg_repns(CurOffset + 1, Types, ArgRepns).
> +
> diff --git a/compiler/prog_data.m b/compiler/prog_data.m
> index cbabf70..eb27868 100644
> --- a/compiler/prog_data.m
> +++ b/compiler/prog_data.m
...
> +:- type arg_only_offset
> + ---> arg_only_offset(int).
> + % The offset of the word from the first part of the memory cell
> + % that contains arguments. In other words, the first argument word
> + % is at offset 0, even if it is preceded in the memory cell
> + % by a remote secondary tag, or by type_infos and/or
> + % typeclass_infos added by polymorphism.
Mention what values are used when arg_only_offset needs to be provided
for extra args.
> diff --git a/compiler/unify_gen.m b/compiler/unify_gen.m
> index d82dc42..547a264 100644
> --- a/compiler/unify_gen.m
> +++ b/compiler/unify_gen.m
> @@ -897,7 +989,7 @@ generate_and_pack_one_cons_word([VarWidth | VarsWidths], [ArgMode | ArgModes],
> % and its type is not a dummy type. The rval next to this is real.
> % (The reason why we don's store the rval as an argument of
don't
> % real_input_arg, making this type a synonym for the maybe type,
> - % is to avoid the memory allocation that would require;
> + % is to avoid the memory allocation that this would require;
> % construction unifications are one of the most frequent types
> % of goals.)
> + ;
> + ( RightWidth = apw_none_nowhere
> + ; RightWidth = apw_none_shifted(_, _)
> + ),
> + % The value being assign is of a dummy type, so no assignment
> + % is actually necessary.
> + Code = empty
> ).
assigned
> @@ -1364,20 +1500,35 @@ generate_sub_assign_to_field_from_var(LeftField, RightVar, Code, CI, !CLD) :-
> ])
> ;
> (
> - LeftWidth = partial_word_first(Mask),
> - Shift = 0
> + LeftWidth = apw_partial_first(_, _, _, Mask, _),
> + Shift = arg_shift(0)
> ;
> - LeftWidth = partial_word_shifted(Shift, Mask)
> + LeftWidth = apw_partial_shifted(_, _, Shift, _, Mask, _)
> ),
> + 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.
> LeftLval = field(yes(LeftPtag), LeftBaseRval,
> const(llconst_int(LeftOffset))),
> - ComplementMask = const(llconst_int(\(Mask << Shift))),
> + ComplementMask = const(llconst_int(\ (MaskInt << ShiftInt))),
> MaskOld = binop(bitwise_and(int_type_int),
> lval(LeftLval), ComplementMask),
int_type_uint?
> - ShiftNew = maybe_left_shift_rval(RightRval, Shift),
> - Combined = binop(bitwise_or(int_type_int), MaskOld, ShiftNew),
> - AssignCode = singleton(llds_instr(assign(LeftLval, Combined),
> + ShiftedRightRval = left_shift_rval(RightRval, Shift),
> + CombinedRval = or_two_rvals(MaskOld, ShiftedRightRval),
> + AssignCode = singleton(llds_instr(assign(LeftLval, CombinedRval),
> "Update part of word"))
> + ;
> + ( LeftWidth = apw_none_nowhere
> + ; LeftWidth = apw_none_shifted(_, _)
> + ),
> + % The value being assign is of a dummy type, so no assignment
assigned
> + % is actually necessary.
> + % XXX Should we try to avoid generating ProduceRightVarCode
> + % and MaterializeLeftBaseCode as well? MaterializeLeftBaseCode
> + % is probably needed by other, non-dummy fields, and
> + % ProduceRightVarCode is probably very cheap, so probably not.
> + AssignCode = empty
> ),
> Code = ProduceRightVarCode ++ MaterializeLeftBaseCode ++ AssignCode.
>
> @@ -2034,42 +2216,58 @@ int_tag_to_const_and_int_type(IntTag, Const, Type) :-
> Type = int_type_uint64
> ).
>
> -:- pred generate_ground_term_args(assoc_list(prog_var, arg_width)::in,
> +:- pred generate_ground_term_args(assoc_list(prog_var, arg_pos_width)::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 = ArgVar - ArgWidth,
> + ArgVarWidth = ArgVar - ArgPosWidth,
> map.det_remove(ArgVar, ArgTypedRval, !ActiveMap),
> (
> - ArgWidth = full_word,
> + ArgPosWidth = apw_full(_, _),
> TypedRval = ArgTypedRval,
> generate_ground_term_args(ArgVarsWidths, TypedRvals, !ActiveMap)
> ;
> - ArgWidth = double_word,
> + ArgPosWidth = apw_double(_, _, DoubleWordKind),
> % Though a standalone float might have needed to boxed,
> % it may be stored in unboxed form as a constructor argument.
Update this comment.
> ( 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)
> ;
> diff --git a/library/construct.m b/library/construct.m
> index bb50f47..30100ea 100644
> --- a/library/construct.m
> +++ b/library/construct.m
...
> +static void
> +MR_copy_memory_cell_args(MR_Word arg_list, MR_Word new_data,
> + const MR_Word ptag, const MR_DuFunctorDesc *functor_desc,
> + MR_bool has_sectag)
> +{
...
> + for (i = 0; i < arity; i++) {
> + MR_Word arg_data;
> + MR_TypeInfo arg_type_info;
> + MR_Unsigned bits_to_or;
> +
> + arg_data = MR_field(MR_UNIV_TAG, MR_list_head(arg_list),
> + MR_UNIV_OFFSET_FOR_DATA);
> + arg_type_info = (MR_TypeInfo) MR_field(MR_UNIV_TAG,
> + MR_list_head(arg_list), MR_UNIV_OFFSET_FOR_TYPEINFO);
> + if (arg_locns == NULL) {
> + MR_field(ptag, new_data, sectag01 + i) = arg_data;
> + } else {
> + const MR_DuArgLocn *locn = &arg_locns[i];
...
> +
> + case -8:
> + case -9:
> + // This is an int32 (-6) or uint32 (-9) argument.
-8
> + bits_to_or = (((MR_Unsigned) arg_data) & 0xffffffff);
> + MR_field(ptag, new_data, sectag01 + locn->MR_arg_offset)
> + |= (bits_to_or << locn->MR_arg_shift);
> + break;
> +
> + case -10:
> + // This is a dummy argument, which does not need setting.
> + break;
> +
> + default:
> + if (locn->MR_arg_bits > 0) {
> + MR_field(ptag, new_data, sectag01 + locn->MR_arg_offset)
> + |= (arg_data << locn->MR_arg_shift);
> + } else {
> + MR_fatal_error(""unknown MR_arg_bits value"");
> + }
> + break;
I think this should also handle MR_arg_bits==0.
> + }
> + }
> +
> + size += MR_term_size(arg_type_info, arg_data);
> + arg_list = MR_list_tail(arg_list);
> + }
> +
> + MR_define_size_slot(ptag, new_data, size);
> +}
> +").
> diff --git a/library/store.m b/library/store.m
> index dc6e379..2a66c9a 100644
> --- a/library/store.m
> +++ b/library/store.m
> @@ -714,6 +714,8 @@ copy_ref_value(Ref, Val) -->
> MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
> MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
> MR_define_size_slot(0, ArgRef, 1);
> + // XXX I (zs) don't think this will work for arguments
> + // that are stored unboxed in two words.
> * (MR_Word *) ArgRef = MR_arg_value(arg_ref, arg_locn);
> } else {
> ArgRef = (MR_Word) arg_ref;
> @@ -780,6 +782,8 @@ copy_ref_value(Ref, Val) -->
> MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
> MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
> MR_define_size_slot(0, ArgRef, 1);
> + // XXX I (zs) don't think this will work for arguments
> + // that are stored unboxed in two words.
> * (MR_Word *) ArgRef = MR_arg_value(arg_ref, arg_locn);
> } else if (arg_ref == &Val) {
> /*
Right, I think there are a lot more problems with that API.
Looks fine otherwise.
Peter
More information about the reviews
mailing list