diff options
Diffstat (limited to 'lib/hipe')
71 files changed, 6593 insertions, 377 deletions
diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile index a9e24f4d17..46cbc33ae2 100644 --- a/lib/hipe/Makefile +++ b/lib/hipe/Makefile @@ -22,7 +22,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ifdef HIPE_ENABLED -HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools +HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools llvm else HIPE_SUBDIRS = endif diff --git a/lib/hipe/arm/hipe_arm_assemble.erl b/lib/hipe/arm/hipe_arm_assemble.erl index 2af786994e..e9de96a927 100644 --- a/lib/hipe/arm/hipe_arm_assemble.erl +++ b/lib/hipe/arm/hipe_arm_assemble.erl @@ -44,8 +44,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -320,7 +320,7 @@ do_pseudo_li(I, MFA, ConstMap, Address, PrevImms, PendImms) -> Atom when is_atom(Atom) -> {load_atom, Atom}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -518,37 +518,6 @@ fix_pc_refs(I, InsnAddress, FunAddress, LabelMap) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -594,17 +563,6 @@ fill_spaces(N) when N > 0 -> fill_spaces(0) -> []. -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile index 506e993ff4..d13dfb33c2 100644 --- a/lib/hipe/cerl/Makefile +++ b/lib/hipe/cerl/Makefile @@ -42,8 +42,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -MODULES = cerl_cconv cerl_closurean cerl_hipeify \ - cerl_lib cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \ +MODULES = cerl_cconv cerl_closurean cerl_hipeify cerl_lib \ + cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \ cerl_typean erl_bif_types erl_types HRL_FILES= cerl_hipe_primops.hrl @@ -65,7 +65,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +inline +warn_exported_vars +warn_unused_import +warn_missing_spec# +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +inline +warn_exported_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record # ---------------------------------------------------- # Targets @@ -107,7 +107,6 @@ release_spec: opt release_docs_spec: -$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl +$(EBIN)/cerl_cconv.beam: cerl_hipe_primops.hrl $(EBIN)/cerl_hipeify.beam: cerl_hipe_primops.hrl -$(EBIN)/cerl_lambdalift.beam: cerl_hipe_primops.hrl -$(EBIN)/erl_bif_types.beam: ../icode/hipe_icode_primops.hrl +$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 22f5b8945a..9a3873f46d 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -63,7 +63,8 @@ seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, type/1, values_es/1, var_name/1, - map_es/1, map_pair_key/1, map_pair_val/1, map_pair_op/1 + c_map/1, map_arg/1, map_es/1, is_c_map_empty/1, + c_map_pair/2, map_pair_key/1, map_pair_val/1, map_pair_op/1 ]). -define(PAPER, 76). @@ -489,7 +490,13 @@ lay_literal(Node, Ctxt) -> %% `lay_cons' will check for strings. lay_cons(Node, Ctxt); V when is_tuple(V) -> - lay_tuple(Node, Ctxt) + lay_tuple(Node, Ctxt); + M when is_map(M), map_size(M) =:= 0 -> + text("~{}~"); + M when is_map(M) -> + lay_map(c_map([c_map_pair(abstract(K),abstract(V)) + || {K,V} <- maps:to_list(M)]), + Ctxt) end. lay_var(Node, Ctxt) -> @@ -596,10 +603,17 @@ lay_tuple(Node, Ctxt) -> floating(text("}")))). lay_map(Node, Ctxt) -> + Arg = map_arg(Node), + After = case is_c_map_empty(Arg) of + true -> floating(text("}~")); + false -> + beside(floating(text(" | ")), + beside(lay(Arg,Ctxt), + floating(text("}~")))) + end, beside(floating(text("~{")), - beside(par(seq(map_es(Node), floating(text(",")), - Ctxt, fun lay/2)), - floating(text("}~")))). + beside(par(seq(map_es(Node), floating(text(",")), Ctxt, fun lay/2)), + After)). lay_map_pair(Node, Ctxt) -> K = map_pair_key(Node), diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 1c1c10d9b0..2645056be1 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -29,9 +29,9 @@ -define(NO_UNUSED, true). --export([module/2]). +-export([module/1, module/2]). -ifndef(NO_UNUSED). --export([function/3, function/4, module/1]). +-export([function/3, function/4]). -endif. %% Added in an attempt to suppress message by Dialyzer, but I run into @@ -102,36 +102,32 @@ %% Record definitions --record(ctxt, {final = false :: boolean(), - effect = false, - fail = [], % [] or fail-to label - class = expr, % expr | guard - line = 0, % current line number - 'receive' % undefined | #receive{} - }). - -record('receive', {loop}). -record(cerl_to_icode__var, {name}). -record('fun', {label, vars}). +-record(ctxt, {final = false :: boolean(), + effect = false :: boolean(), + fail = [], % [] or fail-to label + class = expr :: 'expr' | 'guard', + line = 0 :: erl_scan:line(), % current line number + 'receive' :: 'undefined' | #'receive'{} + }). %% --------------------------------------------------------------------- %% Code - -%% @spec module(Module::cerl()) -> [icode()] +%% @spec module(Module::cerl()) -> [{mfa(), icode()}] %% @equiv module(Module, []) --ifndef(NO_UNUSED). +-spec module(cerl:c_module()) -> [{mfa(), hipe_icode:icode()}]. + module(E) -> module(E, []). --endif. -%% @clear - -%% @spec module(Module::cerl(), Options::[term()]) -> [icode()] +%% @spec module(Module::cerl(), Options::[term()]) -> [{mfa(), icode()}] %% -%% cerl() = cerl:cerl() +%% cerl() = cerl:c_module() %% icode() = hipe_icode:icode() %% %% @doc Transforms a Core Erlang module to linear HiPE Icode. The result @@ -149,7 +145,7 @@ module(E) -> %% @see function/4 %% @see cerl_hipeify:transform/1 -%% -spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}]. +-spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}]. module(E, Options) -> module_1(cerl_hipeify:transform(E, Options), Options). @@ -163,8 +159,8 @@ module_1(E, Options) -> throw(error) end, S0 = init(M), - S1 = s__set_pmatch(proplists:get_value(pmatch, Options), S0), - S2 = s__set_bitlevel_binaries(proplists:get_value( + S1 = s__set_pmatch(proplists:get_value(pmatch, Options), S0), + S2 = s__set_bitlevel_binaries(proplists:get_value( bitlevel_binaries, Options), S1), {Icode, _} = lists:mapfoldl(fun function_definition/2, S2, cerl:module_defs(E)), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 0512d4bc3c..a460f16272 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1073,14 +1073,14 @@ type(hipe_bifs, fun_to_address, 1, Xs, Opaques) -> %% type(hipe_bifs, get_emu_address, 1, Xs, Opaques) -> %% strict(hipe_bifs, get_emu_address, 1, Xs, %% fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, get_fe, 2, Xs, Opaques) -> + strict(hipe_bifs, get_fe, 2, Xs, fun (_) -> t_integer() end, Opaques); type(hipe_bifs, get_rts_param, 1, Xs, Opaques) -> strict(hipe_bifs, get_rts_param, 1, Xs, fun (_) -> t_sup(t_integer(), t_nil()) end, Opaques); type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, Opaques) -> strict(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, fun (_) -> t_nil() end, Opaques); -type(hipe_bifs, make_fe, 3, Xs, Opaques) -> - strict(hipe_bifs, make_fe, 3, Xs, fun (_) -> t_integer() end, Opaques); %% type(hipe_bifs, make_native_stub, 2, Xs, Opaques) -> %% strict(hipe_bifs, make_native_stub, 2, Xs, %% fun (_) -> t_integer() end, Opaques); % address @@ -1116,6 +1116,9 @@ type(hipe_bifs, set_funinfo_native_address, 3, Xs, Opaques) -> type(hipe_bifs, set_native_address, 3, Xs, Opaques) -> strict(hipe_bifs, set_native_address, 3, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, set_native_address_in_fe, 2, Xs, Opaques) -> + strict(hipe_bifs, set_native_address_in_fe, 2, Xs, + fun (_) -> t_atom('true') end, Opaques); type(hipe_bifs, system_crc, 1, Xs, Opaques) -> strict(hipe_bifs, system_crc, 1, Xs, fun (_) -> t_crc32() end, Opaques); type(hipe_bifs, term_to_word, 1, Xs, Opaques) -> @@ -2451,12 +2454,12 @@ arg_types(hipe_bifs, fun_to_address, 1) -> [t_mfa()]; %% arg_types(hipe_bifs, get_emu_address, 1) -> %% [t_mfa()]; +arg_types(hipe_bifs, get_fe, 2) -> + [t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])]; arg_types(hipe_bifs, get_rts_param, 1) -> [t_fixnum()]; arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1) -> [t_list(t_mfa())]; -arg_types(hipe_bifs, make_fe, 3) -> - [t_integer(), t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])]; %% arg_types(hipe_bifs, make_native_stub, 2) -> %% [t_integer(), t_arity()]; arg_types(hipe_bifs, mark_referred_from, 1) -> @@ -2485,6 +2488,8 @@ arg_types(hipe_bifs, set_funinfo_native_address, 3) -> arg_types(hipe_bifs, set_native_address, 3); arg_types(hipe_bifs, set_native_address, 3) -> [t_mfa(), t_integer(), t_boolean()]; +arg_types(hipe_bifs, set_native_address_in_fe, 2) -> + [t_integer(), t_integer()]; arg_types(hipe_bifs, system_crc, 1) -> [t_crc32()]; arg_types(hipe_bifs, term_to_word, 1) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 32390045e3..67661130a5 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -126,6 +126,8 @@ t_is_instance/2, t_is_integer/1, t_is_integer/2, t_is_list/1, + t_is_map/1, + t_is_map/2, t_is_matchstate/1, t_is_nil/1, t_is_nil/2, t_is_non_neg_integer/1, @@ -148,6 +150,8 @@ t_list/1, t_list_elements/1, t_list_elements/2, t_list_termination/1, + t_map/0, + t_map/1, t_matchstate/0, t_matchstate/2, t_matchstate_present/1, @@ -205,14 +209,11 @@ type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, + subst_all_remote/2, lift_list_to_pos_empty/1, is_opaque_type/2, is_erl_type/1, - atom_to_string/1, - - t_is_map/2, - t_map/1, - t_map/0 + atom_to_string/1 ]). %%-define(DO_ERL_TYPES_TEST, true). @@ -498,9 +499,9 @@ t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; t_contains_opaque(?int_set(_Set), _Opaques) -> false; t_contains_opaque(?list(Type, Tail, _), Opaques) -> t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); -t_contains_opaque(?map(Pairs), Opaques) -> - list_contains_opaque([V||{_,V}<-Pairs], Opaques) orelse - list_contains_opaque([K||{K,_}<-Pairs], Opaques); +t_contains_opaque(?map(_) = Map, Opaques) -> + list_contains_opaque(map_values(Map), Opaques) orelse + list_contains_opaque(map_keys(Map), Opaques); t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; t_contains_opaque(?nil, _Opaques) -> false; t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; @@ -614,7 +615,7 @@ t_decorate_with_opaque(T1, T2, Opaques) -> end end. -decorate(?none=Type, _, _Opaques) -> Type; +decorate(Type, ?none, _Opaques) -> Type; decorate(?function(Domain, Range), ?function(D, R), Opaques) -> ?function(decorate(Domain, D, Opaques), decorate(Range, R, Opaques)); decorate(?list(Types, Tail, Size), ?list(Ts, Tl, _Sz), Opaques) -> @@ -680,6 +681,7 @@ union_decorate(U1, U2, Opaques) -> List = [A,B,F,I,L,N,T,M,Map], DecList = [Dec || E <- List, + not t_is_none(E), not t_is_none(Dec = decorate(E, Opaque, Opaques))], t_sup([Union|DecList]). @@ -1728,11 +1730,16 @@ lift_list_to_pos_empty(?list(Content, Termination, _)) -> t_map() -> ?map([]). --spec t_map([{erl_type(),erl_type()}]) -> erl_type(). +-spec t_map([{erl_type(), erl_type()}]) -> erl_type(). t_map(_) -> ?map([]). +-spec t_is_map(erl_type()) -> boolean(). + +t_is_map(Type) -> + t_is_map(Type, 'universe'). + -spec t_is_map(erl_type(), opaques()) -> boolean(). t_is_map(Type, Opaques) -> @@ -1741,7 +1748,6 @@ t_is_map(Type, Opaques) -> is_map1(?map(_)) -> true; is_map1(_) -> false. - %%----------------------------------------------------------------------------- %% Tuples %% @@ -2089,6 +2095,8 @@ t_has_var(?tuple(Elements, _, _)) -> t_has_var_list(Elements); t_has_var(?tuple_set(_) = T) -> t_has_var_list(t_tuple_subtypes(T)); +t_has_var(?map(_)= Map) -> + t_has_var_list(map_keys(Map)) orelse t_has_var_list(map_values(Map)); t_has_var(?opaque(Set)) -> %% Assume variables in 'args' are also present i 'struct' t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]); @@ -2116,21 +2124,28 @@ t_collect_vars(?function(Domain, Range), Acc) -> t_collect_vars(?list(Contents, Termination, _), Acc) -> ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, [])); t_collect_vars(?product(Types), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple(?any, ?any, ?any), Acc) -> Acc; t_collect_vars(?tuple(Types, _, _), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple_set(_) = TS, Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, - t_tuple_subtypes(TS)); + t_collect_vars_list(t_tuple_subtypes(TS), Acc); +t_collect_vars(?map(_) = Map, Acc0) -> + Acc = t_collect_vars_list(map_keys(Map), Acc0), + t_collect_vars_list(map_values(Map), Acc); t_collect_vars(?opaque(Set), Acc) -> %% Assume variables in 'args' are also present i 'struct' - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, - [O#opaque.struct || O <- set_to_list(Set)]); + t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc); +t_collect_vars(?union(List), Acc) -> + t_collect_vars_list(List, Acc); t_collect_vars(_, Acc) -> Acc. +t_collect_vars_list([T|Ts], Acc0) -> + Acc = t_collect_vars(T, Acc0), + t_collect_vars_list(Ts, Acc); +t_collect_vars_list([], Acc) -> Acc. %%============================================================================= %% @@ -2153,6 +2168,7 @@ t_from_term(T) when is_function(T) -> {arity, Arity} = erlang:fun_info(T, arity), t_fun(Arity, t_any()); t_from_term(T) when is_integer(T) -> t_integer(T); +t_from_term(T) when is_map(T) -> t_map(); t_from_term(T) when is_pid(T) -> t_pid(); t_from_term(T) when is_port(T) -> t_port(); t_from_term(T) when is_reference(T) -> t_reference(); @@ -2555,7 +2571,7 @@ force_union(T = ?function(_, _)) -> ?function_union(T); force_union(T = ?identifier(_)) -> ?identifier_union(T); force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); -force_union(T = ?number(_,_)) -> ?number_union(T); +force_union(T = ?number(_, _)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); force_union(T = ?remote(_)) -> ?remote_union(T); force_union(T = ?map(_)) -> ?map_union(T); @@ -2970,16 +2986,19 @@ inf_union(U1, U2, Opaques) -> List = [A,B,F,I,L,N,T,M,Map], inf_union_collect(List, Opaque, InfFun, [], []) end, - O1 = OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), - O2 = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), - Union = inf_union(U1, U2, 0, [], Opaques), - t_sup([O1, O2, Union]). + {O1, ThrowList1} = + OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), + {O2, ThrowList2} + = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), + {Union, ThrowList3} = inf_union(U1, U2, 0, [], [], Opaques), + ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3), + case t_sup([O1, O2, Union]) of + ?none when ThrowList =/= [] -> throw(hd(ThrowList)); + Sup -> Sup + end. inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) -> - case t_sup(InfList) of - ?none when ThrowList =/= [] -> throw(hd(lists:flatten(ThrowList))); - Sup -> Sup - end; + {t_sup(InfList), lists:usort(ThrowList)}; inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) -> inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList); inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) -> @@ -2990,19 +3009,21 @@ inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) -> inf_union_collect(L, Opaque, InfFun, InfList, [N|ThrowList]) end. -inf_union([?none|Left1], [?none|Left2], N, Acc, Opaques) -> - inf_union(Left1, Left2, N, [?none|Acc], Opaques); -inf_union([T1|Left1], [T2|Left2], N, Acc, Opaques) -> - case t_inf(T1, T2, Opaques) of - ?none -> inf_union(Left1, Left2, N, [?none|Acc], Opaques); - T -> inf_union(Left1, Left2, N+1, [T|Acc], Opaques) +inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) -> + inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques); +inf_union([T1|Left1], [T2|Left2], N, Acc, ThrowList, Opaques) -> + try t_inf(T1, T2, Opaques) of + ?none -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques); + T -> inf_union(Left1, Left2, N+1, [T|Acc], ThrowList, Opaques) + catch throw:N when is_integer(N) -> + inf_union(Left1, Left2, N, [?none|Acc], [N|ThrowList], Opaques) end; -inf_union([], [], N, Acc, _Opaques) -> - if N =:= 0 -> ?none; +inf_union([], [], N, Acc, ThrowList, _Opaques) -> + if N =:= 0 -> {?none, ThrowList}; N =:= 1 -> [Type] = [T || T <- Acc, T =/= ?none], - Type; - N >= 2 -> ?union(lists:reverse(Acc)) + {Type, ThrowList}; + N >= 2 -> {?union(lists:reverse(Acc)), ThrowList} end. inf_bitstr(U1, B1, U2, B2) -> @@ -3076,6 +3097,9 @@ t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> t_tuple([t_subst_dict(E, Dict) || E <- Elements]); t_subst_dict(?tuple_set(_) = TS, Dict) -> t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); +t_subst_dict(?map(Pairs), Dict) -> + ?map([{t_subst_dict(K, Dict), t_subst_dict(V, Dict)} || + {K, V} <- Pairs]); t_subst_dict(?opaque(Es), Dict) -> List = [Opaque#opaque{args = [t_subst_dict(Arg, Dict) || Arg <- Args], struct = t_subst_dict(S, Dict)} || @@ -3125,6 +3149,9 @@ t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); t_subst_aux(?tuple_set(_) = TS, VarMap) -> t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(?map(Pairs), VarMap) -> + ?map([{t_subst_aux(K, VarMap), t_subst_aux(V, VarMap)} || + {K, V} <- Pairs]); t_subst_aux(?opaque(Es), VarMap) -> List = [Opaque#opaque{args = [t_subst_aux(Arg, VarMap) || Arg <- Args], struct = t_subst_aux(S, VarMap)} || @@ -3135,6 +3162,18 @@ t_subst_aux(?union(List), VarMap) -> t_subst_aux(T, _VarMap) -> T. +-spec subst_all_remote(erl_type(), erl_type()) -> erl_type(). + +subst_all_remote(Type0, Substitute) -> + Map = + fun(Type) -> + case erl_types:t_is_remote(Type) of + true -> Substitute; + false -> Type + end + end, + erl_types:t_map(Map, Type0). + %%----------------------------------------------------------------------------- %% Unification %% @@ -3560,6 +3599,8 @@ t_subtract(?product(Elements1) = T1, ?product(Elements2)) -> _ -> T1 end end; +t_subtract(?map(_) = T, _) -> % XXX: very crude; will probably need refinement + T; t_subtract(?product(P1), _) -> ?product(P1); t_subtract(T, ?product(_)) -> @@ -3700,7 +3741,7 @@ t_unopaque(T) -> t_unopaque(?opaque(_) = T, Opaques) -> case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of true -> t_unopaque(t_opaque_structure(T), Opaques); - false -> T % XXX: needs revision for parametric opaque data types + false -> T end; t_unopaque(?list(ElemT, Termination, Sz), Opaques) -> ?list(t_unopaque(ElemT, Opaques), t_unopaque(Termination, Opaques), Sz); @@ -3720,11 +3761,12 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), + UMap = t_unopaque(Map, Opaques), {OF,UO} = case t_unopaque(O, Opaques) of ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,Map])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,UMap])|UO]); t_unopaque(T, _) -> T. @@ -4231,8 +4273,8 @@ t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_list(T), R}; -t_from_form({type, _L, map, _}, _TypeNames, _RecDict, _VarDict) -> - {t_map([]), []}; +t_from_form({type, _L, map, _}, TypeNames, RecDict, VarDict) -> + builtin_type(map, t_map([]), TypeNames, RecDict, VarDict); t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> {t_mfa(), []}; t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4445,7 +4487,9 @@ get_mod_record([{FieldName, DeclType}|Left1], [{FieldName, ModType}|Left2], Acc) -> ModTypeNoVars = subst_all_vars_to_any(ModType), case - t_is_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType) + contains_remote(ModTypeNoVars) + orelse contains_remote(DeclType) + orelse t_is_subtype(ModTypeNoVars, DeclType) of false -> {error, FieldName}; true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc]) @@ -4459,6 +4503,10 @@ get_mod_record(DeclFields, [], Acc) -> get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> {error, FieldName2}. +contains_remote(Type) -> + TypeNoRemote = subst_all_remote(Type, t_none()), + not t_is_equal(Type, TypeNoRemote). + fields_from_form([], _TypeNames, _RecDict, _VarDict) -> {[], []}; fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, @@ -4695,6 +4743,12 @@ is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true; is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true; is_same_type_name2(_, _, _, _, _, _) -> false. +map_keys(?map(Pairs)) -> + [K || {K, _} <- Pairs]. + +map_values(?map(Pairs)) -> + [V || {_, V} <- Pairs]. + %% ----------------------------------- %% Set %% diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index e0b1622d19..c7faf733c7 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -30,6 +30,124 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.10.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix compilation with 'no_remove_comments' (Thanks to + Johannes Weißl)</p> + <p> + Own Id: OTP-11564</p> + </item> + <item> + <p> + Application upgrade (appup) files are corrected for the + following applications: </p> + <p> + <c>asn1, common_test, compiler, crypto, debugger, + dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, + inets, observer, odbc, os_mon, otp_mibs, parsetools, + percept, public_key, reltool, runtime_tools, ssh, + syntax_tools, test_server, tools, typer, webtool, wx, + xmerl</c></p> + <p> + A new test utility for testing appup files is added to + test_server. This is now used by most applications in + OTP.</p> + <p> + (Thanks to Tobias Schlager)</p> + <p> + Own Id: OTP-11744</p> + </item> + <item> + <p> + There is now a test suite for the Hipe application</p> + <p> + Own Id: OTP-11748</p> + </item> + <item> + <p> + Support for a LLVM backend has been added in HiPE</p> + <p> + Own Id: OTP-11801</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> The pre-defined types <c>array/0</c>, <c>dict/0</c>, + <c>digraph/0</c>, <c>gb_set/0</c>, <c>gb_tree/0</c>, + <c>queue/0</c>, <c>set/0</c>, and <c>tid/0</c> have been + deprecated. They will be removed in Erlang/OTP 18.0. </p> + <p> Instead the types <c>array:array/0</c>, + <c>dict:dict/0</c>, <c>digraph:graph/0</c>, + <c>gb_set:set/0</c>, <c>gb_tree:tree/0</c>, + <c>queue:queue/0</c>, <c>sets:set/0</c>, and + <c>ets:tid/0</c> can be used. (Note: it has always been + necessary to use <c>ets:tid/0</c>.) </p> <p> It is + allowed in Erlang/OTP 17.0 to locally re-define the types + <c>array/0</c>, <c>dict/0</c>, and so on. </p> <p> New + types <c>array:array/1</c>, <c>dict:dict/2</c>, + <c>gb_sets:set/1</c>, <c>gb_trees:tree/2</c>, + <c>queue:queue/1</c>, and <c>sets:set/1</c> have been + added. </p> <p> A compiler option, + <c>nowarn_deprecated_type</c>, has been introduced. By + including the attribute </p> <c> + -compile(nowarn_deprecated_type).</c> <p> in an Erlang + source file, warnings about deprecated types can be + avoided in Erlang/OTP 17.0. </p> <p> The option can also + be given as a compiler flag: </p> <c> erlc + +nowarn_deprecated_type file.erl</c> + <p> + Own Id: OTP-10342</p> + </item> + <item> + <p> + EEP43: New data type - Maps</p> + <p> + With Maps you may for instance: <taglist> <item><c>M0 = + #{ a => 1, b => 2}, % create + associations</c></item> <item><c>M1 = M0#{ a := 10 }, % + update values</c></item> <item><c>M2 = M1#{ "hi" => + "hello"}, % add new associations</c></item> <item><c>#{ + "hi" := V1, a := V2, b := V3} = M2. % match keys with + values</c></item> </taglist></p> + <p> + For information on how to use Maps please see the + <seealso marker="doc/reference_manual:maps">Reference + Manual</seealso>.</p> + <p> + The current implementation is without the following + features: <taglist> <item>No variable keys</item> + <item>No single value access</item> <item>No map + comprehensions</item> </taglist></p> + <p> + Note that Maps is <em>experimental</em> during OTP 17.0.</p> + <p> + Own Id: OTP-11616</p> + </item> + <item> + <p> Parameterized opaque types have been introduced. </p> + <p> + Own Id: OTP-11625</p> + </item> + <item> + <p> + Add support for the compilation of the is_map/1 and + map_size/1 guards to native code.</p> + <p> + Own Id: OTP-11831</p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.10.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 81249c958e..4691662f9f 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -509,6 +509,10 @@ trans_fun([{test,test_arity,{f,Lbl},[Reg,N]}|Instructions], Env) -> I = hipe_icode:mk_type([trans_arg(Reg)],{tuple,N}, hipe_icode:label_name(True),map_label(Lbl)), [I,True | trans_fun(Instructions,Env)]; +%%--- is_map --- +trans_fun([{test,is_map,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(map,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; %%-------------------------------------------------------------------- %%--- select_val --- trans_fun([{select_val,Reg,{f,Lbl},{list,Cases}}|Instructions], Env) -> @@ -1121,6 +1125,49 @@ trans_fun([{trim,N,NY}|Instructions], Env) -> trans_fun([{line,_}|Instructions], Env) -> trans_fun(Instructions,Env); %%-------------------------------------------------------------------- +%% Map instructions added in Spring 2014 (17.0). +%%-------------------------------------------------------------------- +trans_fun([{test,has_map_fields,{f,Lbl},Map,{list,Keys}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + %% We assume that hipe_icode:mk_call has no side-effects, and reuse + %% the help function of get_map_elements below, discarding the value + %% assignment instruction list. + {TestInstructions, _GetInstructions, Env2} = + trans_map_query(MapVar, map_label(Lbl), Env1, + lists:flatten([[K, {r, 0}] || K <- Keys])), + [MapMove, TestInstructions | trans_fun(Instructions, Env2)]; +trans_fun([{get_map_elements,{f,Lbl},Map,{list,KVPs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + {TestInstructions, GetInstructions, Env2} = + trans_map_query(MapVar, map_label(Lbl), Env1, KVPs), + [MapMove, TestInstructions, GetInstructions | trans_fun(Instructions, Env2)]; +%%--- put_map_assoc --- +trans_fun([{put_map_assoc,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + TempMapVar = mk_var(new), + TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar), + {PutInstructions, Env2} + = case Lbl > 0 of + true -> + gen_put_map_instrs(exists, assoc, TempMapVar, Dst, Lbl, Pairs, Env1); + false -> + gen_put_map_instrs(new, assoc, TempMapVar, Dst, new, Pairs, Env1) + end, + [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)]; +%%--- put_map_exact --- +trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + TempMapVar = mk_var(new), + TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar), + {PutInstructions, Env2} + = case Lbl > 0 of + true -> + gen_put_map_instrs(exists, exact, TempMapVar, Dst, Lbl, Pairs, Env1); + false -> + gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1) + end, + [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)]; +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1500,6 +1547,102 @@ trans_type_test2(function2, Lbl, Arg, Arity, Env) -> hipe_icode:label_name(True), map_label(Lbl)), {[Move1,Move2,I,True],Env2}. +%% +%% Handles the get_map_elements instruction and the has_map_fields +%% test instruction. +%% +trans_map_query(_MapVar, _FailLabel, Env, []) -> + {[], [], Env}; +trans_map_query(MapVar, FailLabel, Env, [Key,Val|KVPs]) -> + {Move,KeyVar,Env1} = mk_move_and_var(Key,Env), + PassLabel = mk_label(new), + BoolVar = hipe_icode:mk_new_var(), + ValVar = mk_var(Val), + IsKeyCall = hipe_icode:mk_call([BoolVar], maps, is_key, [KeyVar, MapVar], + remote), + TrueTest = hipe_icode:mk_if('=:=', [BoolVar, hipe_icode:mk_const(true)], + hipe_icode:label_name(PassLabel), FailLabel), + GetCall = hipe_icode:mk_call([ValVar], maps, get, [KeyVar, MapVar], remote), + {TestList, GetList, Env2} = trans_map_query(MapVar, FailLabel, Env1, KVPs), + {[Move, IsKeyCall, TrueTest, PassLabel|TestList], [GetCall|GetList], Env2}. + +%% +%% Generates a fail label if necessary when translating put_map_* instructions. +%% +gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) -> + TrueLabel = mk_label(new), + IsMapCode = hipe_icode:mk_type([TempMapVar], map, + hipe_icode:label_name(TrueLabel), map_label(FailLbl)), + DstMapVar = mk_var(Dst), + {ReturnLbl, PutInstructions, Env1} + = case Op of + assoc -> + trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []); + exact -> + trans_put_map_exact(TempMapVar, DstMapVar, + map_label(FailLbl), Pairs, Env, []) + end, + {[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1}; +gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) -> + TrueLabel = mk_label(new), + FailLbl = mk_label(new), + IsMapCode = hipe_icode:mk_type([TempMapVar], map, + hipe_icode:label_name(TrueLabel), + hipe_icode:label_name(FailLbl)), + DstMapVar = mk_var(Dst), + {ReturnLbl, PutInstructions, Env1} + = case Op of + assoc -> + trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []); + exact -> + trans_put_map_exact(TempMapVar, DstMapVar, + hipe_icode:label_name(FailLbl), Pairs, Env, []) + end, + Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error), + {[IsMapCode, TrueLabel, PutInstructions, FailLbl, Fail, ReturnLbl], Env1}. + +%%----------------------------------------------------------------------- +%% This function generates the instructions needed to insert several +%% (Key, Value) pairs into an existing map, each recursive call inserts +%% one (Key, Value) pair. +%%----------------------------------------------------------------------- +trans_put_map_assoc(MapVar, DestMapVar, [], Env, Acc) -> + MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar), + ReturnLbl = mk_label(new), + GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)), + {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env}; +trans_put_map_assoc(MapVar, DestMapVar, [Key, Value | Rest], Env, Acc) -> + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + BifCall = hipe_icode:mk_call([MapVar], maps, put, + [KeyVar, ValVar, MapVar], remote), + trans_put_map_assoc(MapVar, DestMapVar, Rest, Env2, + [BifCall, MoveVal, MoveKey | Acc]). + +%%----------------------------------------------------------------------- +%% This function generates the instructions needed to update several +%% (Key, Value) pairs in an existing map, each recursive call inserts +%% one (Key, Value) pair. +%%----------------------------------------------------------------------- +trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) -> + MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar), + ReturnLbl = mk_label(new), + GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)), + {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env}; +trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) -> + SuccLbl = mk_label(new), + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + IsKey = hipe_icode:mk_new_var(), + BifCallIsKey = hipe_icode:mk_call([IsKey], maps, is_key, + [KeyVar, MapVar], remote), + IsKeyTest = hipe_icode:mk_if('=:=', [IsKey, hipe_icode:mk_const(true)], + hipe_icode:label_name(SuccLbl), FLbl), + BifCallPut = hipe_icode:mk_call([MapVar], maps, put, + [KeyVar, ValVar, MapVar], remote), + Acc1 = [BifCallPut, SuccLbl, IsKeyTest, BifCallIsKey, MoveVal, MoveKey | Acc], + trans_put_map_exact(MapVar, DestMapVar, FLbl, Rest, Env2, Acc1). + %%----------------------------------------------------------------------- %% trans_puts(Code, Environment) -> %% {Movs, Code, Vars, NewEnv} diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 0e651a351c..7b3d087e2d 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -503,7 +503,6 @@ enter_args_update/2, enter_type/1, is_enter/1, - mk_return/1, %% mk_return(Vars) %% mk_fail/1, %% mk_fail(Args) class = exit @@ -606,6 +605,12 @@ -export([highest_var/1, highest_label/1]). +%% +%% Exported types +%% + +-export_type([icode/0]). + %%--------------------------------------------------------------------- %% %% Icode @@ -614,7 +619,7 @@ -spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], {non_neg_integer(),non_neg_integer()}, - {icode_lbl(),icode_lbl()}) -> #icode{}. + {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> #icode{'fun'=Fun, params=Params, code=Code, is_closure=IsClosure, @@ -1434,8 +1439,8 @@ subst1([_|Pairs], I) -> subst1(Pairs, I). %% %% @doc Returns the successors of an Icode instruction. %% In CFG form only branch instructions have successors, -%% but in linear form other instructions like e.g. moves and -%% others might be the last instruction of some basic block. +%% but in linear form other instructions like e.g. moves +%% might be the last instruction of some basic block. %% -spec successors(icode_instr()) -> [icode_lbl()]. diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 060493e61e..46c04beb40 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -61,8 +61,8 @@ | 'op_exact_eqeq_2' | 'suspend_msg_timeout'. -type icode_type_test() :: 'atom' | 'bignum' | 'binary' | 'bitstr' | 'boolean' - | 'cons' | 'fixnum' | 'float' - | 'function' | 'function2' | 'integer' | 'list' | 'nil' + | 'cons' | 'fixnum' | 'float' | 'function' + | 'function2' | 'integer' | 'list' | 'map' | 'nil' | 'number' | 'pid' | 'port' | 'reference' | 'tuple' | {'atom', atom()} | {'integer', integer()} | {'record', atom(), non_neg_integer()} @@ -108,7 +108,6 @@ length :: non_neg_integer(), cases :: [icode_switch_case()]}). - -record(icode_type, {test :: icode_type_test(), args :: [icode_term_arg()], true_label :: icode_lbl(), @@ -178,5 +177,6 @@ var_range :: {non_neg_integer(), non_neg_integer()}, label_range :: {icode_lbl(), icode_lbl()}, info = [] :: icode_info()}). +-type icode() :: #icode{}. %%--------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_fp.erl b/lib/hipe/icode/hipe_icode_fp.erl index c0cd9bd2d1..38b3881a77 100644 --- a/lib/hipe/icode/hipe_icode_fp.erl +++ b/lib/hipe/icode/hipe_icode_fp.erl @@ -424,7 +424,7 @@ redirect_phis([I|Is] = Code, OldFrom, NewFrom, Acc) -> NewI = hipe_icode:phi_redirect_pred(I, OldFrom, NewFrom), redirect_phis(Is, OldFrom, NewFrom, [NewI|Acc]); _ -> - lists:reverse(Acc) ++ Code + lists:reverse(Acc, Code) end; redirect_phis([], _OldFrom, _NewFrom, Acc) -> lists:reverse(Acc). diff --git a/lib/hipe/icode/hipe_icode_mulret.erl b/lib/hipe/icode/hipe_icode_mulret.erl index 2402bad42c..99522f6430 100644 --- a/lib/hipe/icode/hipe_icode_mulret.erl +++ b/lib/hipe/icode/hipe_icode_mulret.erl @@ -1166,9 +1166,9 @@ printCallList([]) -> io:format("~n"). %% removeUnElems([#icode_call{'fun'={unsafe_element,_}, args=Var}|List], Var, Res) -> %% removeUnElems(List, Var, Res); %% removeUnElems([I=#icode_move{dst=Var}|List], [Var], Res) -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% removeUnElems([I=#icode_call{dstlist=Var}|List], Var, Res) -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% removeUnElems([I|List], Var, Res) -> %% removeUnElems(List, Var, [I|Res]); %% removeUnElems([], _, Res) -> lists:reverse(Res). @@ -1187,7 +1187,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1195,7 +1195,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1203,7 +1203,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1248,16 +1248,16 @@ printCallList([]) -> io:format("~n"). %% modifyCode([I|Code], Var, Res) -> %% case scanInstr(I, Var) of %% {move, Arity, VarLst} -> -%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res) ++ Code], +%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res, Code)], %% {Arity, lists:reverse(Code2)}; %% {mktuple, Arity, VarLst} -> -%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res) ++ Code], +%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res, Code)], %% {Arity, lists:reverse(Code2)}; %% other -> %% modifyCode(Code, Var, [I|Res]) %% end; %% modifyCode([], Var, Res) -> -%% {1, lists:reverse(Res) ++ [#icode_return{vars=Var}]}. +%% {1, lists:reverse(Res, [#icode_return{vars=Var}]}. %% scanInstr(#icode_call{dstlist=Var, 'fun'=mktuple, args=Lst}, Var) -> %% {mktuple, length(Lst), Lst}; diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl index 65876b83ea..ebeb5e2c10 100644 --- a/lib/hipe/icode/hipe_icode_type.erl +++ b/lib/hipe/icode/hipe_icode_type.erl @@ -84,15 +84,15 @@ t_fun/0, t_fun/1, t_fun/2, t_fun_args/1, t_fun_arity/1, t_inf/2, t_inf_lists/2, t_integer/0, t_integer/1, t_is_atom/1, t_is_any/1, - t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1, t_is_boolean/1, - t_is_fixnum/1, t_is_cons/1, + t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1, + t_is_boolean/1, t_is_fixnum/1, t_is_cons/1, t_is_map/1, t_is_maybe_improper_list/1, t_is_equal/2, t_is_float/1, t_is_fun/1, t_is_integer/1, t_is_non_neg_integer/1, t_is_number/1, t_is_matchstate/1, - t_is_nil/1, t_is_none/1, t_is_port/1, t_is_pid/1, + t_is_none/1, t_is_port/1, t_is_pid/1, t_is_reference/1, t_is_subtype/2, t_is_tuple/1, t_limit/2, t_matchstate_present/1, t_matchstate/0, - t_matchstate_slots/1, t_maybe_improper_list/0, + t_matchstate_slots/1, t_maybe_improper_list/0, t_map/0, t_nil/0, t_none/0, t_number/0, t_number/1, t_number_vals/1, t_pid/0, t_port/0, t_reference/0, t_subtract/2, t_sup/2, t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_sizes/1]). @@ -213,7 +213,7 @@ analyse_blocks(Work, State, MFA) -> {NewState, NewLabels} = try analyse_block(Label, Info, State) catch throw:none_type -> - %% io:format("received none type at label: ~p~n",[Label]), + %% io:format("received none type at label: ~p~n", [Label]), {State,[]} end, NewWork2 = add_work(NewWork, NewLabels), @@ -265,7 +265,7 @@ analyse_insn(I, Info, LookupFun) -> do_move(I, Info); #icode_call{} -> NewInfo = do_call(I, Info, LookupFun), - %%io:format("Analysing Call: ~w~n~w~n", [I,NewInfo]), + %% io:format("Analysing Call: ~w~n~w~n", [I, NewInfo]), update_call_arguments(I, NewInfo); #icode_phi{} -> Type = t_limit(join_list(hipe_icode:args(I), Info), ?TYPE_DEPTH), @@ -788,16 +788,16 @@ test_record(Atom, Size, Var, VarInfo, TrueLab, FalseLab, Info) -> end. test_type(Test, Type) -> - %%io:format("Test is: ~w\n", [Test]), - %%io:format("Type is: ~s\n", [format_type(Type)]), + %% io:format("Test is: ~w\n", [Test]), + %% io:format("Type is: ~s\n", [format_type(Type)]), Ans = case t_is_any(Type) of true -> maybe; false -> TrueTest = true_branch_info(Test), Inf = t_inf(TrueTest, Type), - %%io:format("TrueTest is: ~s\n", [format_type(TrueTest)]), - %%io:format("Inf is: ~s\n", [format_type(Inf)]), + %% io:format("TrueTest is: ~s\n", [format_type(TrueTest)]), + %% io:format("Inf is: ~s\n", [format_type(Inf)]), case t_is_equal(Type, Inf) of true -> not t_is_none(Type); @@ -895,11 +895,12 @@ test_type0(boolean, T) -> t_is_boolean(T); test_type0(list, T) -> t_is_maybe_improper_list(T); -test_type0(cons, T) -> - t_is_cons(T); -test_type0(nil, T) -> - t_is_nil(T). - +%% test_type0(cons, T) -> +%% t_is_cons(T); +%% test_type0(nil, T) -> +%% t_is_nil(T). +test_type0(map, T) -> + t_is_map(T). true_branch_info(integer) -> t_integer(); @@ -931,22 +932,24 @@ true_branch_info(reference) -> t_reference(); true_branch_info(function) -> t_fun(); -true_branch_info(cons) -> - t_cons(); -true_branch_info(nil) -> - t_nil(); +%% true_branch_info(cons) -> +%% t_cons(); +%% true_branch_info(nil) -> +%% t_nil(); true_branch_info(boolean) -> t_boolean(); +true_branch_info(map) -> + t_map(); true_branch_info(T) -> - exit({?MODULE,unknown_typetest,T}). + exit({?MODULE, unknown_typetest, T}). %% _________________________________________________________________ %% %% Remove the redundant type tests. If a test is removed, the trace -%% that isn't taken is explicitly removed from the CFG to simpilify +%% that isn't taken is explicitly removed from the CFG to simplify %% the handling of Phi nodes. If a Phi node is left and at least one -%% branch into it has disappeared, the SSA propagation pass can't +%% branch into it has disappeared, the SSA propagation pass cannot %% handle it. %% %% If the CFG has changed at the end of this pass, the analysis is diff --git a/lib/hipe/llvm/Makefile b/lib/hipe/llvm/Makefile new file mode 100644 index 0000000000..92f378924a --- /dev/null +++ b/lib/hipe/llvm/Makefile @@ -0,0 +1,109 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2014. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +ifndef EBIN +EBIN = ../ebin +endif + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(HIPE_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +ifdef HIPE_ENABLED +HIPE_MODULES = hipe_rtl_to_llvm \ + hipe_llvm \ + elf_format \ + hipe_llvm_main \ + hipe_llvm_merge \ + hipe_llvm_liveness +else +HIPE_MODULES = +endif + +MODULES = $(HIPE_MODULES) + +HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl \ + hipe_llvm_arch.hrl +ERL_FILES= $(MODULES:%=%.erl) +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# APP_FILE= +# App_SRC= $(APP_FILE).src +# APP_TARGET= $(EBIN)/$(APP_FILE) +# +# APPUP_FILE= +# APPUP_SRC= $(APPUP_FILE).src +# APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS: Please keep +inline below +# ---------------------------------------------------- + +include ../native.mk + +ERL_COMPILE_FLAGS += +inline #+warn_missing_spec + +# if in 32 bit backend define BIT32 symbol +ARCH = $(shell echo $(TARGET) | sed 's/^\(x86_64\)-.*/64bit/') +ifneq ($(ARCH), 64bit) +ERL_COMPILE_FLAGS += -DBIT32 +endif + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +docs: + +clean: + rm -f $(TARGET_FILES) + rm -f core erl_crash.dump + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/llvm + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/llvm + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: diff --git a/lib/hipe/llvm/elf32_format.hrl b/lib/hipe/llvm/elf32_format.hrl new file mode 100644 index 0000000000..af1d95bf5b --- /dev/null +++ b/lib/hipe/llvm/elf32_format.hrl @@ -0,0 +1,59 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-32 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://www.sco.com/developers/gabi/latest/contents.html]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-32 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 4). +-define(ELF_OFF_SIZE, 4). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, ?ELF_WORD_SIZE). % for compatibility +-define(ELF_SXWORD_SIZE, ?ELF_WORD_SIZE). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-32 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary (needed because +%% of the different offsets in 32 and 64 bit formats). +-define(ST_NAME_OFFSET, 0). +-define(ST_VALUE_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). +-define(ST_INFO_OFFSET, (?ST_SIZE_OFFSET + ?ST_SIZE_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 8) ). +-define(ELF_R_TYPE(I), (I band 16#ff) ). +-define(ELF_R_INFO(S, T), ((S bsl 8) + (T band 16#ff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf64_format.hrl b/lib/hipe/llvm/elf64_format.hrl new file mode 100644 index 0000000000..794746ffdc --- /dev/null +++ b/lib/hipe/llvm/elf64_format.hrl @@ -0,0 +1,58 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-64 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://downloads.openwatcom.org/ftp/devel/docs/elf-64-gen.pdf]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-64 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 8). +-define(ELF_OFF_SIZE, 8). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, 8). +-define(ELF_SXWORD_SIZE, 8). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-64 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary +-define(ST_NAME_OFFSET, 0). +-define(ST_INFO_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). +-define(ST_VALUE_OFFSET, (?ST_SHNDX_OFFSET + ?ST_SHNDX_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 32) ). +-define(ELF_R_TYPE(I), (I band 16#ffffffff) ). +-define(ELF_R_INFO(S, T), ((S bsl 32) + (T band 16#ffffffff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf_format.erl b/lib/hipe/llvm/elf_format.erl new file mode 100644 index 0000000000..260da9b5e6 --- /dev/null +++ b/lib/hipe/llvm/elf_format.erl @@ -0,0 +1,790 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]>, +%%% Kostis Sagonas <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This module contains functions for extracting various pieces of +%%% information from an ELF formated Object file. To fully understand +%%% the ELF format and the use of these functions please read +%%% "[http://www.linuxjournal.com/article/1060?page=0,0]" carefully. + +-module(elf_format). + +-export([get_tab_entries/1, + %% Relocations + get_rodata_relocs/1, + get_text_relocs/1, + extract_rela/2, + get_rela_addends/1, + %% Note + extract_note/2, + %% Executable code + extract_text/1, + %% GCC Exception Table + get_exn_handlers/1, + %% Misc. + set_architecture_flag/1, + is64bit/0 + ]). + +-include("elf_format.hrl"). + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-type elf() :: binary(). + +-type lp() :: non_neg_integer(). % landing pad +-type num() :: non_neg_integer(). +-type index() :: non_neg_integer(). +-type offset() :: non_neg_integer(). +-type size() :: non_neg_integer(). +-type start() :: non_neg_integer(). + +-type info() :: index(). +-type nameoff() :: offset(). +-type valueoff() :: offset(). + +-type name() :: string(). +-type name_size() :: {name(), size()}. +-type name_sizes() :: [name_size()]. + +%%------------------------------------------------------------------------------ +%% Abstract Data Types and Accessors for ELF Structures. +%%------------------------------------------------------------------------------ + +%% File header +-record(elf_ehdr, {ident, % ELF identification + type, % Object file type + machine, % Machine Type + version, % Object file version + entry, % Entry point address + phoff, % Program header offset + shoff :: offset(), % Section header offset + flags, % Processor-specific flags + ehsize :: size(), % ELF header size + phentsize :: size(), % Size of program header entry + phnum :: num(), % Number of program header entries + shentsize :: size(), % Size of section header entry + shnum :: num(), % Number of section header entries + shstrndx :: index() % Section name string table index + }). +-type elf_ehdr() :: #elf_ehdr{}. + +-record(elf_ehdr_ident, {class, % File class + data, % Data encoding + version, % File version + osabi, % OS/ABI identification + abiversion, % ABI version + pad, % Start of padding bytes + nident % Size of e_ident[] + }). +%% -type elf_ehdr_ident() :: #elf_ehdr_ident{}. + +%% Section header entries +-record(elf_shdr, {name, % Section name + type, % Section type + flags, % Section attributes + addr, % Virtual address in memory + offset :: offset(), % Offset in file + size :: size(), % Size of section + link, % Link to other section + info, % Miscellaneous information + addralign, % Address align boundary + entsize % Size of entries, if section has table + }). +%% -type elf_shdr() :: #elf_shdr{}. + +%% Symbol table entries +-record(elf_sym, {name :: nameoff(), % Symbol name + info, % Type and Binding attributes + other, % Reserved + shndx, % Section table index + value :: valueoff(), % Symbol value + size :: size() % Size of object + }). +-type elf_sym() :: #elf_sym{}. + +%% Relocations +-record(elf_rel, {r_offset :: offset(), % Address of reference + r_info :: info() % Symbol index and type of relocation + }). +-type elf_rel() :: #elf_rel{}. + +-record(elf_rela, {r_offset :: offset(), % Address of reference + r_info :: info(), % Symbol index and type of relocation + r_addend :: offset() % Constant part of expression + }). +-type elf_rela() :: #elf_rela{}. + +%% %% Program header table +%% -record(elf_phdr, {type, % Type of segment +%% flags, % Segment attributes +%% offset, % Offset in file +%% vaddr, % Virtual address in memory +%% paddr, % Reserved +%% filesz, % Size of segment in file +%% memsz, % Size of segment in memory +%% align % Alignment of segment +%% }). + +%% %% GCC exception table +%% -record(elf_gccexntab, {lpbenc, % Landing pad base encoding +%% lpbase, % Landing pad base +%% ttenc, % Type table encoding +%% ttoff, % Type table offset +%% csenc, % Call-site table encoding +%% cstabsize, % Call-site table size +%% cstab :: cstab() % Call-site table +%% }). +%% -type elf_gccexntab() :: #elf_gccexntab{}. + +-record(elf_gccexntab_callsite, {start :: start(), % Call-site start + size :: size(), % Call-site size + lp :: lp(), % Call-site landing pad + % (exception handler) + onaction % On action (e.g. cleanup) + }). +%% -type elf_gccexntab_callsite() :: #elf_gccexntab_callsite{}. + +%%------------------------------------------------------------------------------ +%% Accessor Functions +%%------------------------------------------------------------------------------ + +%% File header +%% -spec mk_ehdr(...) -> elf_ehrd(). +mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, Ehsize, + Phentsize, Phnum, Shentsize, Shnum, Shstrndx) -> + #elf_ehdr{ident = Ident, type = Type, machine = Machine, version = Version, + entry = Entry, phoff = Phoff, shoff = Shoff, flags = Flags, + ehsize = Ehsize, phentsize = Phentsize, phnum = Phnum, + shentsize = Shentsize, shnum = Shnum, shstrndx = Shstrndx}. + +%% -spec ehdr_shoff(elf_ehdr()) -> offset(). +%% ehdr_shoff(#elf_ehdr{shoff = Offset}) -> Offset. +%% +%% -spec ehdr_shentsize(elf_ehdr()) -> size(). +%% ehdr_shentsize(#elf_ehdr{shentsize = Size}) -> Size. +%% +%% -spec ehdr_shnum(elf_ehdr()) -> num(). +%% ehdr_shnum(#elf_ehdr{shnum = Num}) -> Num. +%% +%% -spec ehdr_shstrndx(elf_ehdr()) -> index(). +%% ehdr_shstrndx(#elf_ehdr{shstrndx = Index}) -> Index. + + +%%-spec mk_ehdr_ident(...) -> elf_ehdr_ident(). +mk_ehdr_ident(Class, Data, Version, OsABI, AbiVersion, Pad, Nident) -> + #elf_ehdr_ident{class = Class, data = Data, version = Version, osabi = OsABI, + abiversion = AbiVersion, pad = Pad, nident = Nident}. + +%%%------------------------- +%%% Section header entries +%%%------------------------- +mk_shdr(Name, Type, Flags, Addr, Offset, Size, Link, Info, AddrAlign, EntSize) -> + #elf_shdr{name = Name, type = Type, flags = Flags, addr = Addr, + offset = Offset, size = Size, link = Link, info = Info, + addralign = AddrAlign, entsize = EntSize}. + +%% -spec shdr_offset(elf_shdr()) -> offset(). +%% shdr_offset(#elf_shdr{offset = Offset}) -> Offset. +%% +%% -spec shdr_size(elf_shdr()) -> size(). +%% shdr_size(#elf_shdr{size = Size}) -> Size. + +%%%------------------------- +%%% Symbol Table Entries +%%%------------------------- +mk_sym(Name, Info, Other, Shndx, Value, Size) -> + #elf_sym{name = Name, info = Info, other = Other, + shndx = Shndx, value = Value, size = Size}. + +-spec sym_name(elf_sym()) -> nameoff(). +sym_name(#elf_sym{name = Name}) -> Name. + +%% -spec sym_value(elf_sym()) -> valueoff(). +%% sym_value(#elf_sym{value = Value}) -> Value. +%% +%% -spec sym_size(elf_sym()) -> size(). +%% sym_size(#elf_sym{size = Size}) -> Size. + +%%%------------------------- +%%% Relocations +%%%------------------------- +-spec mk_rel(offset(), info()) -> elf_rel(). +mk_rel(Offset, Info) -> + #elf_rel{r_offset = Offset, r_info = Info}. + +%% The following two functions capitalize on the fact that the two kinds of +%% relocation records (for 32- and 64-bit architectures have similar structure. + +-spec r_offset(elf_rel() | elf_rela()) -> offset(). +r_offset(#elf_rel{r_offset = Offset}) -> Offset; +r_offset(#elf_rela{r_offset = Offset}) -> Offset. + +-spec r_info(elf_rel() | elf_rela()) -> info(). +r_info(#elf_rel{r_info = Info}) -> Info; +r_info(#elf_rela{r_info = Info}) -> Info. + +-spec mk_rela(offset(), info(), offset()) -> elf_rela(). +mk_rela(Offset, Info, Addend) -> + #elf_rela{r_offset = Offset, r_info = Info, r_addend = Addend}. + +-spec rela_addend(elf_rela()) -> offset(). +rela_addend(#elf_rela{r_addend = Addend}) -> Addend. + +%% %%%------------------------- +%% %%% GCC exception table +%% %%%------------------------- +%% -type cstab() :: [elf_gccexntab_callsite()]. +%% +%% mk_gccexntab(LPbenc, LPbase, TTenc, TToff, CSenc, CStabsize, CStab) -> +%% #elf_gccexntab{lpbenc = LPbenc, lpbase = LPbase, ttenc = TTenc, +%% ttoff = TToff, csenc = CSenc, cstabsize = CStabsize, +%% cstab = CStab}. +%% +%% -spec gccexntab_cstab(elf_gccexntab()) -> cstab(). +%% gccexntab_cstab(#elf_gccexntab{cstab = CSTab}) -> CSTab. + +mk_gccexntab_callsite(Start, Size, LP, Action) -> + #elf_gccexntab_callsite{start = Start, size=Size, lp=LP, onaction=Action}. + +%% -spec gccexntab_callsite_start(elf_gccexntab_callsite()) -> start(). +%% gccexntab_callsite_start(#elf_gccexntab_callsite{start = Start}) -> Start. +%% +%% -spec gccexntab_callsite_size(elf_gccexntab_callsite()) -> size(). +%% gccexntab_callsite_size(#elf_gccexntab_callsite{size = Size}) -> Size. +%% +%% -spec gccexntab_callsite_lp(elf_gccexntab_callsite()) -> lp(). +%% gccexntab_callsite_lp(#elf_gccexntab_callsite{lp = LP}) -> LP. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate the ELF File Header +%%------------------------------------------------------------------------------ + +%% @doc Extracts the File Header from an ELF formatted object file. Also sets +%% the ELF class variable in the process dictionary (used by many functions +%% in this and hipe_llvm_main modules). +-spec extract_header(elf()) -> elf_ehdr(). +extract_header(Elf) -> + Ehdr_bin = get_binary_segment(Elf, 0, ?ELF_EHDR_SIZE), + << %% Structural pattern matching on fields. + Ident_bin:?E_IDENT_SIZE/binary, + Type:?bits(?E_TYPE_SIZE)/integer-little, + Machine:?bits(?E_MACHINE_SIZE)/integer-little, + Version:?bits(?E_VERSION_SIZE)/integer-little, + Entry:?bits(?E_ENTRY_SIZE)/integer-little, + Phoff:?bits(?E_PHOFF_SIZE)/integer-little, + Shoff:?bits(?E_SHOFF_SIZE)/integer-little, + Flags:?bits(?E_FLAGS_SIZE)/integer-little, + Ehsize:?bits(?E_EHSIZE_SIZE)/integer-little, + Phentsize:?bits(?E_PHENTSIZE_SIZE)/integer-little, + Phnum:?bits(?E_PHNUM_SIZE)/integer-little, + Shentsize:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shnum:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shstrndx:?bits(?E_SHSTRNDX_SIZE)/integer-little + >> = Ehdr_bin, + <<16#7f, $E, $L, $F, Class, Data, Version, Osabi, Abiversion, + Pad:6/binary, Nident + >> = Ident_bin, + Ident = mk_ehdr_ident(Class, Data, Version, Osabi, + Abiversion, Pad, Nident), + mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, + Ehsize, Phentsize, Phnum, Shentsize, Shnum, Shstrndx). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Section Header Entries +%%------------------------------------------------------------------------------ + +%% @doc Extracts the Section Header Table from an ELF formated Object File. +extract_shdrtab(Elf) -> + %% Extract File Header to get info about Section Header Offset (in bytes), + %% Entry Size (in bytes) and Number of entries + #elf_ehdr{shoff = ShOff, shentsize = ShEntsize, shnum = ShNum} = + extract_header(Elf), + %% Get actual Section header table (binary) + ShdrBin = get_binary_segment(Elf, ShOff, ShNum * ShEntsize), + get_shdrtab_entries(ShdrBin, []). + +get_shdrtab_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_shdrtab_entries(ShdrBin, Acc) -> + <<%% Structural pattern matching on fields. + Name:?bits(?SH_NAME_SIZE)/integer-little, + Type:?bits(?SH_TYPE_SIZE)/integer-little, + Flags:?bits(?SH_FLAGS_SIZE)/integer-little, + Addr:?bits(?SH_ADDR_SIZE)/integer-little, + Offset:?bits(?SH_OFFSET_SIZE)/integer-little, + Size:?bits(?SH_SIZE_SIZE)/integer-little, + Link:?bits(?SH_LINK_SIZE)/integer-little, + Info:?bits(?SH_INFO_SIZE)/integer-little, + Addralign:?bits(?SH_ADDRALIGN_SIZE)/integer-little, + Entsize:?bits(?SH_ENTSIZE_SIZE)/integer-little, + MoreShdrE/binary + >> = ShdrBin, + ShdrE = mk_shdr(Name, Type, Flags, Addr, Offset, + Size, Link, Info, Addralign, Entsize), + get_shdrtab_entries(MoreShdrE, [ShdrE | Acc]). + +%% @doc Extracts a specific Entry of a Section Header Table. This function +%% takes as argument the Section Header Table (`SHdrTab') and the entry's +%% serial number (`EntryNum') and returns the entry (`shdr'). +get_shdrtab_entry(SHdrTab, EntryNum) -> + lists:nth(EntryNum + 1, SHdrTab). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Section Header String Table +%%------------------------------------------------------------------------------ + +%% @doc Extracts the Section Header String Table. This section is not a known +%% ELF Object File section. It is just a "hidden" table storing the +%% names of all sections that exist in current object file. +-spec extract_shstrtab(elf()) -> [name()]. +extract_shstrtab(Elf) -> + %% Extract Section Name String Table Index + #elf_ehdr{shstrndx = ShStrNdx} = extract_header(Elf), + ShHdrTab = extract_shdrtab(Elf), + %% Extract Section header entry and get actual Section-header String Table + #elf_shdr{offset = ShStrOffset, size = ShStrSize} = + get_shdrtab_entry(ShHdrTab, ShStrNdx), + case get_binary_segment(Elf, ShStrOffset, ShStrSize) of + <<>> -> %% Segment empty + []; + ShStrTab -> %% Convert to string table + [Name || {Name, _Size} <- get_names(ShStrTab)] + end. + +%%------------------------------------------------------------------------------ + +-spec get_tab_entries(elf()) -> [{name(), valueoff(), size()}]. +get_tab_entries(Elf) -> + SymTab = extract_symtab(Elf), + Ts = [{Name, Value, Size div ?ELF_XWORD_SIZE} + || #elf_sym{name = Name, value = Value, size = Size} <- SymTab, + Name =/= 0], + {NameIndices, ValueOffs, Sizes} = lists:unzip3(Ts), + %% Find the names of the symbols. + %% Get string table entries ([{Name, Offset in strtab section}]). Keep only + %% relevant entries: + StrTab = extract_strtab(Elf), + Relevant = [get_strtab_entry(StrTab, Off) || Off <- NameIndices], + %% Zip back to {Name, ValueOff, Size} + lists:zip3(Relevant, ValueOffs, Sizes). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Symbol Table +%%------------------------------------------------------------------------------ + +%% @doc Function that extracts Symbol Table from an ELF Object file. +extract_symtab(Elf) -> + Symtab_bin = extract_segment_by_name(Elf, ?SYMTAB), + get_symtab_entries(Symtab_bin, []). + +get_symtab_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_symtab_entries(Symtab_bin, Acc) -> + <<SymE_bin:?ELF_SYM_SIZE/binary, MoreSymE/binary>> = Symtab_bin, + case is64bit() of + true -> + <<%% Structural pattern matching on fields. + Name:?bits(?ST_NAME_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little + >> = SymE_bin; + false -> + << %% Same fields in different order: + Name:?bits(?ST_NAME_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little + >> = SymE_bin + end, + SymE = mk_sym(Name, Info, Other, Shndx, Value, Size), + get_symtab_entries(MoreSymE, [SymE | Acc]). + +%% @doc Extracts a specific entry from the Symbol Table (as binary). +%% This function takes as arguments the Symbol Table (`SymTab') +%% and the entry's serial number and returns that entry (`sym'). +get_symtab_entry(SymTab, EntryNum) -> + lists:nth(EntryNum + 1, SymTab). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate String Table +%%------------------------------------------------------------------------------ + +%% @doc Extracts String Table from an ELF formated Object File. +-spec extract_strtab(elf()) -> [{string(), offset()}]. +extract_strtab(Elf) -> + Strtab_bin = extract_segment_by_name(Elf, ?STRTAB), + NamesSizes = get_names(Strtab_bin), + make_offsets(NamesSizes). + +%% @doc Returns the name of the symbol at the given offset. The string table +%% contains entries of the form {Name, Offset}. If no such offset exists +%% returns the empty string (`""'). +%% XXX: There might be a bug here because of the "compact" saving the ELF +%% format uses: e.g. only stores ".rela.text" for ".rela.text" and ".text". +get_strtab_entry(Strtab, Offset) -> + case lists:keyfind(Offset, 2, Strtab) of + {Name, Offset} -> Name; + false -> "" + end. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Relocations +%%------------------------------------------------------------------------------ + +%% @doc This function gets as argument an ELF binary file and returns a list +%% with all .rela.rodata labels (i.e. constants and literals in code) +%% or an empty list if no ".rela.rodata" section exists in code. +-spec get_rodata_relocs(elf()) -> [offset()]. +get_rodata_relocs(Elf) -> + case is64bit() of + true -> + %% Only care about the addends (== offsets): + get_rela_addends(extract_rela(Elf, ?RODATA)); + false -> + %% Find offsets hardcoded in ".rodata" entry + %%XXX: Treat all 0s as padding and skip them! + [SkipPadding || SkipPadding <- extract_rodata(Elf), SkipPadding =/= 0] + end. + +-spec get_rela_addends([elf_rela()]) -> [offset()]. +get_rela_addends(RelaEntries) -> + [rela_addend(E) || E <- RelaEntries]. + +%% @doc Extract a list of the form `[{SymbolName, Offset}]' with all relocatable +%% symbols and their offsets in the code from the ".text" section. +-spec get_text_relocs(elf()) -> [{name(), offset()}]. +get_text_relocs(Elf) -> + %% Only care about the symbol table index and the offset: + NameOffsetTemp = [{?ELF_R_SYM(r_info(E)), r_offset(E)} + || E <- extract_rela(Elf, ?TEXT)], + {NameIndices, ActualOffsets} = lists:unzip(NameOffsetTemp), + %% Find the names of the symbols: + %% + %% Get those symbol table entries that are related to Text relocs: + Symtab = extract_symtab(Elf), + SymtabEs = [get_symtab_entry(Symtab, Index) || Index <- NameIndices], + %XXX: not zero-indexed! + %% Symbol table entries contain the offset of the name of the symbol in + %% String Table: + SymtabEs2 = [sym_name(E) || E <- SymtabEs], %XXX: Do we need to sort SymtabE? + %% Get string table entries ([{Name, Offset in strtab section}]). Keep only + %% relevant entries: + Strtab = extract_strtab(Elf), + Relevant = [get_strtab_entry(Strtab, Off) || Off <- SymtabEs2], + %% Zip back with actual offsets: + lists:zip(Relevant, ActualOffsets). + +%% @doc Extract the Relocations segment for section `Name' (that is passed +%% as second argument) from an ELF formated Object file binary. +-spec extract_rela(elf(), name()) -> [elf_rel() | elf_rela()]. +extract_rela(Elf, Name) -> + SegName = + case is64bit() of + true -> ?RELA(Name); % ELF-64 uses ".rela" + false -> ?REL(Name) % ...while ELF-32 uses ".rel" + end, + Rela_bin = extract_segment_by_name(Elf, SegName), + get_rela_entries(Rela_bin, []). + +get_rela_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_rela_entries(Bin, Acc) -> + E = case is64bit() of + true -> + <<%% Structural pattern matching on fields of a Rela Entry. + Offset:?bits(?R_OFFSET_SIZE)/integer-little, + Info:?bits(?R_INFO_SIZE)/integer-little, + Addend:?bits(?R_ADDEND_SIZE)/integer-little, + Rest/binary + >> = Bin, + mk_rela(Offset, Info, Addend); + false -> + <<%% Structural pattern matching on fields of a Rel Entry. + Offset:?bits(?R_OFFSET_SIZE)/integer-little, + Info:?bits(?R_INFO_SIZE)/integer-little, + Rest/binary + >> = Bin, + mk_rel(Offset, Info) + end, + get_rela_entries(Rest, [E | Acc]). + +%% %% @doc Extract the `EntryNum' (serial number) Relocation Entry. +%% get_rela_entry(Rela, EntryNum) -> +%% lists:nth(EntryNum + 1, Rela). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Executable Code segment +%%------------------------------------------------------------------------------ + +%% @doc This function gets as arguments an ELF formated binary file and +%% returns the Executable Code (".text" segment) or an empty binary if it +%% is not found. +-spec extract_text(elf()) -> binary(). +extract_text(Elf) -> + extract_segment_by_name(Elf, ?TEXT). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Note Section +%%------------------------------------------------------------------------------ + +%% @doc Extract specific Note Section from an ELF Object file. The function +%% takes as first argument the object file (`Elf') and the `Name' of the +%% wanted Note Section (<b>without</b> the ".note" prefix!). It returns +%% the specified binary segment or an empty binary if no such section +%% exists. +-spec extract_note(elf(), string()) -> binary(). +extract_note(Elf, Name) -> + extract_segment_by_name(Elf, ?NOTE(Name)). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate GCC Exception Table segment +%%------------------------------------------------------------------------------ + +%% A description for the C++ exception table formats can be found at Exception +%% Handling Tables (http://www.codesourcery.com/cxx-abi/exceptions.pdf). + +%% A list with `{Start, End, HandlerOffset}' for all call sites in the code +-spec get_exn_handlers(elf()) -> [{start(), start(), lp()}]. +get_exn_handlers(Elf) -> + CallSites = extract_gccexntab_callsites(Elf), + [{Start, Start + Size, LP} + || #elf_gccexntab_callsite{start = Start, size = Size, lp = LP} <- CallSites]. + +%% @doc This function gets as argument an ELF binary file and returns +%% the table (list) of call sites which is stored in GCC +%% Exception Table (".gcc_except_table") section. +%% It returns an empty list if the Exception Table is not found. +%% XXX: Assumes there is *no* Action Record Table. +extract_gccexntab_callsites(Elf) -> + case extract_segment_by_name(Elf, ?GCC_EXN_TAB) of + <<>> -> + []; + ExnTab -> + %% First byte of LSDA is Landing Pad base encoding. + <<LBenc:8, More/binary>> = ExnTab, + %% Second byte is the Landing Pad base (if its encoding is not + %% DW_EH_PE_omit) (optional). + {_LPBase, LSDACont} = + case LBenc =:= ?DW_EH_PE_omit of + true -> % No landing pad base byte. (-1 denotes that) + {-1, More}; + false -> % Landing pad base. + <<Base:8, More2/binary>> = More, + {Base, More2} + end, + %% Next byte of LSDA is the encoding of the Type Table. + <<TTenc:8, More3/binary>> = LSDACont, + %% Next byte is the Types Table offset encoded in U-LEB128 (optional). + {_TTOff, LSDACont2} = + case TTenc =:= ?DW_EH_PE_omit of + true -> % There is no Types Table pointer. (-1 denotes that) + {-1, More3}; + false -> % The byte offset from this field to the start of the Types + % Table used for exception matching. + leb128_decode(More3) + end, + %% Next byte of LSDA is the encoding of the fields in the Call-site Table. + <<_CSenc:8, More4/binary>> = LSDACont2, + %% Sixth byte is the size (in bytes) of the Call-site Table encoded in + %% U-LEB128. + {_CSTabSize, CSTab} = leb128_decode(More4), + %% Extract all call site information + get_gccexntab_callsites(CSTab, []) + end. + +get_gccexntab_callsites(<<>>, Acc) -> + lists:reverse(Acc); +get_gccexntab_callsites(CSTab, Acc) -> + %% We are only interested in the Landing Pad of every entry. + <<Start:32/integer-little, Size:32/integer-little, + LP:32/integer-little, OnAction:8, More/binary + >> = CSTab, + GccCS = mk_gccexntab_callsite(Start, Size, LP, OnAction), + get_gccexntab_callsites(More, [GccCS | Acc]). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Read-only Data (.rodata) +%%------------------------------------------------------------------------------ +extract_rodata(Elf) -> + Rodata_bin = extract_segment_by_name(Elf, ?RODATA), + get_rodata_entries(Rodata_bin, []). + +get_rodata_entries(<<>>, Acc) -> + lists:reverse(Acc); +get_rodata_entries(Rodata_bin, Acc) -> + <<Num:?bits(?ELF_ADDR_SIZE)/integer-little, More/binary>> = Rodata_bin, + get_rodata_entries(More, [Num | Acc]). + +%%------------------------------------------------------------------------------ +%% Helper functions +%%------------------------------------------------------------------------------ + +%% @doc Returns the binary segment starting at `Offset' with length `Size' +%% (bytes) from a binary file. If `Offset' is bigger than the byte size of +%% the binary, an empty binary (`<<>>') is returned. +-spec get_binary_segment(binary(), offset(), size()) -> binary(). +get_binary_segment(Bin, Offset, _Size) when Offset > byte_size(Bin) -> + <<>>; +get_binary_segment(Bin, Offset, Size) -> + <<_Hdr:Offset/binary, BinSeg:Size/binary, _More/binary>> = Bin, + BinSeg. + +%% @doc This function gets as arguments an ELF formated binary object and +%% a string with the segments' name and returns the specified segment or +%% an empty binary (`<<>>') if there exists no segment with that name. +%% There are handy macros defined in elf_format.hrl for all Standard +%% Section Names. +-spec extract_segment_by_name(elf(), string()) -> binary(). +extract_segment_by_name(Elf, SectionName) -> + %% Extract Section Header Table and Section Header String Table from binary + SHdrTable = extract_shdrtab(Elf), + Names = extract_shstrtab(Elf), + %% Zip to a list of (Name,ShdrE) + [_Zero | ShdrEs] = lists:keysort(2, SHdrTable), % Skip first entry (zeros). + L = lists:zip(Names, ShdrEs), + %% Find Section Header Table entry by name + case lists:keyfind(SectionName, 1, L) of + {SectionName, ShdrE} -> %% Note: Same name. + #elf_shdr{offset = Offset, size = Size} = ShdrE, + get_binary_segment(Elf, Offset, Size); + false -> %% Not found. + <<>> + end. + +%% @doc Extracts a list of strings with (zero-separated) names from a binary. +%% Returns tuples of `{Name, Size}'. +%% XXX: Skip trailing 0. +-spec get_names(<<_:8,_:_*8>>) -> name_sizes(). +get_names(<<0, Bin/binary>>) -> + NamesSizes = get_names(Bin, []), + fix_names(NamesSizes, []). + +get_names(<<>>, Acc) -> + lists:reverse(Acc); +get_names(Bin, Acc) -> + {Name, MoreNames} = bin_get_string(Bin), + get_names(MoreNames, [{Name, length(Name)} | Acc]). + +%% @doc Fix names: +%% e.g. If ".rela.text" exists, ".text" does not. Same goes for +%% ".rel.text". In that way, the Section Header String Table is more +%% compact. Add ".text" just *before* the corresponding rela-field, +%% etc. +-spec fix_names(name_sizes(), name_sizes()) -> name_sizes(). +fix_names([], Acc) -> + lists:reverse(Acc); +fix_names([{Name, Size}=T | Names], Acc) -> + case is64bit() of + true -> + case string:str(Name, ".rela") =:= 1 of + true -> %% Name starts with ".rela": + Section = string:substr(Name, 6), + fix_names(Names, [{Section, Size - 5} + | [T | Acc]]); % XXX: Is order ok? (".text" + % always before ".rela.text") + false -> %% Name does not start with ".rela": + fix_names(Names, [T | Acc]) + end; + false -> + case string:str(Name, ".rel") =:= 1 of + true -> %% Name starts with ".rel": + Section = string:substr(Name, 5), + fix_names(Names, [{Section, Size - 4} + | [T | Acc]]); % XXX: Is order ok? (".text" + % always before ".rela.text") + false -> %% Name does not start with ".rel": + fix_names(Names, [T | Acc]) + end + end. + + +%% @doc A function that byte-reverses a binary. This might be needed because of +%% little (fucking!) endianess. +-spec bin_reverse(binary()) -> binary(). +bin_reverse(Bin) when is_binary(Bin) -> + bin_reverse(Bin, <<>>). + +-spec bin_reverse(binary(), binary()) -> binary(). +bin_reverse(<<>>, Acc) -> + Acc; +bin_reverse(<<Head, More/binary>>, Acc) -> + bin_reverse(More, <<Head, Acc/binary>>). + +%% @doc A function that extracts a null-terminated string from a binary. It +%% returns the found string along with the rest of the binary. +-spec bin_get_string(binary()) -> {string(), binary()}. +bin_get_string(Bin) -> + bin_get_string(Bin, <<>>). + +bin_get_string(<<>>, BinAcc) -> + Bin = bin_reverse(BinAcc), % little endian! + {binary_to_list(Bin), <<>>}; +bin_get_string(<<0, MoreBin/binary>>, BinAcc) -> + Bin = bin_reverse(BinAcc), % little endian! + {binary_to_list(Bin), MoreBin}; +bin_get_string(<<Letter, Tail/binary>>, BinAcc) -> + bin_get_string(Tail, <<Letter, BinAcc/binary>>). + +%% @doc +make_offsets(NamesSizes) -> + {Names, Sizes} = lists:unzip(NamesSizes), + Offsets = make_offsets_from_sizes(Sizes, 1, []), + lists:zip(Names, Offsets). + +make_offsets_from_sizes([], _, Acc) -> + lists:reverse(Acc); +make_offsets_from_sizes([Size | Sizes], Cur, Acc) -> + make_offsets_from_sizes(Sizes, Size+Cur+1, [Cur | Acc]). % For the "."! + +%% @doc Little-Endian Base 128 (LEB128) Decoder +%% This function extracts the <b>first</b> LEB128-encoded integer in a +%% binary and returns that integer along with the remaining binary. This is +%% done because a LEB128 number has variable bit-size and that is a way of +%% extracting only one number in a binary and continuing parsing the binary +%% for other kind of data (e.g. different encoding). +%% FIXME: Only decodes unsigned data! +-spec leb128_decode(binary()) -> {integer(), binary()}. +leb128_decode(LebNum) -> + leb128_decode(LebNum, 0, <<>>). + +-spec leb128_decode(binary(), integer(), binary()) -> {integer(), binary()}. +leb128_decode(LebNum, NoOfBits, Acc) -> + <<Sentinel:1/bits, NextBundle:7/bits, MoreLebNums/bits>> = LebNum, + case Sentinel of + <<1:1>> -> % more bytes to follow + leb128_decode(MoreLebNums, NoOfBits+7, <<NextBundle:7/bits, Acc/bits>>); + <<0:1>> -> % byte bundle stop + Size = NoOfBits+7, + <<Num:Size/integer>> = <<NextBundle:7/bits, Acc/bits>>, + {Num, MoreLebNums} + end. + +%% @doc Extract ELF Class from ELF header and export symbol to process +%% dictionary. +-spec set_architecture_flag(elf()) -> 'ok'. +set_architecture_flag(Elf) -> + %% Extract information about ELF Class from ELF Header + <<16#7f, $E, $L, $F, EI_Class, _MoreHeader/binary>> + = get_binary_segment(Elf, 0, ?ELF_EHDR_SIZE), + put(elf_class, EI_Class), + ok. + +%% @doc Read from object file header if the file class is ELF32 or ELF64. +-spec is64bit() -> boolean(). +is64bit() -> + case get(elf_class) of + ?ELFCLASS64 -> true; + ?ELFCLASS32 -> false + end. diff --git a/lib/hipe/llvm/elf_format.hrl b/lib/hipe/llvm/elf_format.hrl new file mode 100644 index 0000000000..78592e6e2a --- /dev/null +++ b/lib/hipe/llvm/elf_format.hrl @@ -0,0 +1,488 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%------------------------------------------------------------------------------ +%% +%% ELF Header File +%% +%%------------------------------------------------------------------------------ + +-ifdef(BIT32). +-include("elf32_format.hrl"). % ELF32-specific definitions. +-else. +-include("elf64_format.hrl"). % ELF64-specific definitions. +-endif. + +%%------------------------------------------------------------------------------ +%% ELF Data Types (in bytes) +%%------------------------------------------------------------------------------ +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF File Header +%%------------------------------------------------------------------------------ +-define(ELF_EHDR_SIZE, (?E_IDENT_SIZE + ?E_TYPE_SIZE + ?E_MACHINE_SIZE + +?E_VERSION_SIZE + ?E_ENTRY_SIZE + ?E_PHOFF_SIZE + +?E_SHOFF_SIZE + ?E_FLAGS_SIZE + ?E_EHSIZE_SIZE + +?E_PHENTSIZE_SIZE + ?E_PHNUM_SIZE + ?E_SHENTSIZE_SIZE + +?E_SHNUM_SIZE + ?E_SHSTRNDX_SIZE) ). + +-define(E_IDENT_SIZE, (16 * ?ELF_UNSIGNED_CHAR_SIZE) ). +-define(E_TYPE_SIZE, ?ELF_HALF_SIZE). +-define(E_MACHINE_SIZE, ?ELF_HALF_SIZE). +-define(E_VERSION_SIZE, ?ELF_WORD_SIZE). +-define(E_ENTRY_SIZE, ?ELF_ADDR_SIZE). +-define(E_PHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_SHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(E_EHSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_SHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHSTRNDX_SIZE, ?ELF_HALF_SIZE). + +%% Useful arithmetics for computing byte offsets for various File Header +%% entries from a File Header (erlang) binary +-define(E_IDENT_OFFSET, 0). +-define(E_TYPE_OFFSET, (?E_IDENT_OFFSET + ?E_IDENT_SIZE) ). +-define(E_MACHINE_OFFSET, (?E_TYPE_OFFSET + ?E_TYPE_SIZE) ). +-define(E_VERSION_OFFSET, (?E_MACHINE_OFFSET + ?E_MACHINE_SIZE) ). +-define(E_ENTRY_OFFSET, (?E_VERSION_OFFSET + ?E_VERSION_SIZE) ). +-define(E_PHOFF_OFFSET, (?E_ENTRY_OFFSET + ?E_ENTRY_SIZE) ). +-define(E_SHOFF_OFFSET, (?E_PHOFF_OFFSET + ?E_PHOFF_SIZE) ). +-define(E_FLAGS_OFFSET, (?E_SHOFF_OFFSET + ?E_SHOFF_SIZE) ). +-define(E_EHSIZE_OFFSET, (?E_FLAGS_OFFSET + ?E_FLAGS_SIZE) ). +-define(E_PHENTSIZE_OFFSET, (?E_EHSIZE_OFFSET + ?E_EHSIZE_SIZE) ). +-define(E_PHNUM_OFFSET, (?E_PHENTSIZE_OFFSET + ?E_PHENTSIZE_SIZE) ). +-define(E_SHENTSIZE_OFFSET, (?E_PHNUM_OFFSET + ?E_PHNUM_SIZE) ). +-define(E_SHNUM_OFFSET, (?E_SHENTSIZE_OFFSET + ?E_SHENTSIZE_SIZE) ). +-define(E_SHSTRNDX_OFFSET, (?E_SHNUM_OFFSET + ?E_SHNUM_SIZE) ). + +%% Name aliases of File Header fields information used in get_header_field +%% function of elf64_format module. +-define(E_IDENT, {?E_IDENT_OFFSET, ?E_IDENT_SIZE}). +-define(E_TYPE, {?E_TYPE_OFFSET, ?E_TYPE_SIZE}). +-define(E_MACHINE, {?E_MACHINE_OFFSET, ?E_MACHINE_SIZE}). +-define(E_VERSION, {?E_VERSION_OFFSET, ?E_VERSION_SIZE}) +-define(E_ENTRY, {?E_ENTRY_OFFSET, ?E_ENTRY_SIZE}). +-define(E_PHOFF, {?E_PHOFF_OFFSET, ?E_PHOFF_SIZE}). +-define(E_SHOFF, {?E_SHOFF_OFFSET, ?E_SHOFF_SIZE}). +-define(E_FLAGS, {?E_FLAGS_OFFSET, ?E_FLAGS_SIZE}). +-define(E_EHSIZE, {?E_EHSIZE_OFFSET, ?E_EHSIZE_SIZE}). +-define(E_PHENTSIZE, {?E_PHENTSIZE_OFFSET, ?E_PHENTSIZE_SIZE}). +-define(E_PHNUM, {?E_PHNUM_OFFSET, ?E_PHNUM_SIZE}). +-define(E_SHENTSIZE, {?E_SHENTSIZE_OFFSET, ?E_SHENTSIZE_SIZE}). +-define(E_SHNUM, {?E_SHNUM_OFFSET, ?E_SHNUM_SIZE}). +-define(E_SHSTRNDX, {?E_SHSTRNDX_OFFSET, ?E_SHSTRNDX_SIZE}). + +%% ELF Identification (e_ident) +-define(EI_MAG0, 0). +-define(EI_MAG1, 1). +-define(EI_MAG2, 2). +-define(EI_MAG3, 3). +-define(EI_CLASS, 4). +-define(EI_DATA, 5). +-define(EI_VERSION, 6). +-define(EI_OSABI, 7). +-define(EI_ABIVERSION, 8). +-define(EI_PAD, 9). +-define(EI_NIDENT, 16). + +%% Object File Classes (e_ident[EI_CLASS]) +-define(ELFCLASSNONE, 0). +-define(ELFCLASS32, 1). +-define(ELFCLASS64, 2). + +%% Data Encodings (e_ident[EI_DATA]) +-define(ELFDATA2LSB, 1). +-define(ELFDATA2MSB, 2). + +%% Operating System and ABI Identifiers (e_ident[EI_OSABI]) +-define(ELFOSABI_SYSV, 0). +-define(ELFOSABI_HPUX, 1). +-define(ELFOSABI_STANDALONE, 255). + +%% Object File Types (e_type) +-define(ET_NONE, 0). +-define(ET_REL, 1). +-define(ET_EXEC, 2). +-define(ET_DYN, 3). +-define(ET_CORE, 4). +-define(ET_LOOS, 16#FE00). +-define(ET_HIOS, 16#FEFF). +-define(ET_LOPROC, 16#FF00). +-define(ET_HIPROC, 16#FFFF). + +%%------------------------------------------------------------------------------ +%% ELF Section Header +%%------------------------------------------------------------------------------ +-define(ELF_SHDRENTRY_SIZE, (?SH_NAME_SIZE + ?SH_TYPE_SIZE + ?SH_FLAGS_SIZE + +?SH_ADDR_SIZE + ?SH_OFFSET_SIZE + ?SH_SIZE_SIZE + +?SH_LINK_SIZE + ?SH_INFO_SIZE + +?SH_ADDRALIGN_SIZE + ?SH_ENTSIZE_SIZE) ). + +-define(SH_NAME_SIZE, ?ELF_WORD_SIZE). +-define(SH_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(SH_FLAGS_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ADDR_SIZE, ?ELF_ADDR_SIZE). +-define(SH_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(SH_SIZE_SIZE, ?ELF_XWORD_SIZE). +-define(SH_LINK_SIZE, ?ELF_WORD_SIZE). +-define(SH_INFO_SIZE, ?ELF_WORD_SIZE). +-define(SH_ADDRALIGN_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ENTSIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Useful arithmetics for computing byte offsets for various fields from a +%% Section Header Entry (erlang) binary +-define(SH_NAME_OFFSET, 0). +-define(SH_TYPE_OFFSET, (?SH_NAME_OFFSET + ?SH_NAME_SIZE) ). +-define(SH_FLAGS_OFFSET, (?SH_TYPE_OFFSET + ?SH_TYPE_SIZE) ). +-define(SH_ADDR_OFFSET, (?SH_FLAGS_OFFSET + ?SH_FLAGS_SIZE) ). +-define(SH_OFFSET_OFFSET, (?SH_ADDR_OFFSET + ?SH_ADDR_SIZE) ). +-define(SH_SIZE_OFFSET, (?SH_OFFSET_OFFSET + ?SH_OFFSET_SIZE) ). +-define(SH_LINK_OFFSET, (?SH_SIZE_OFFSET + ?SH_SIZE_SIZE) ). +-define(SH_INFO_OFFSET, (?SH_LINK_OFFSET + ?SH_LINK_SIZE) ). +-define(SH_ADDRALIGN_OFFSET, (?SH_INFO_OFFSET + ?SH_INFO_SIZE) ). +-define(SH_ENTSIZE_OFFSET, (?SH_ADDRALIGN_OFFSET + ?SH_ADDRALIGN_SIZE) ). + +%% Name aliases of Section Header Table entry information used in +%% get_shdrtab_entry function of elf64_format module. +-define(SH_NAME, {?SH_NAME_OFFSET, ?SH_NAME_SIZE}). +-define(SH_TYPE, {?SH_TYPE_OFFSET, ?SH_TYPE_SIZE}). +-define(SH_FLAGS, {?SH_FLAGS_OFFSET, ?SH_FLAGS_SIZE}). +-define(SH_ADDR, {?SH_ADDR_OFFSET, ?SH_ADDR_SIZE}). +-define(SH_OFFSET, {?SH_OFFSET_OFFSET, ?SH_OFFSET_SIZE}). +-define(SH_SIZE, {?SH_SIZE_OFFSET, ?SH_SIZE_SIZE}). +-define(SH_LINK, {?SH_LINK_OFFSET, ?SH_LINK_SIZE}). +-define(SH_INFO, {?SH_INFO_OFFSET, ?SH_INFO_SIZE}). +-define(SH_ADDRALIGN, {?SH_ADDRALIGN_OFFSET, ?SH_ADDRALIGN_SIZE}). +-define(SH_ENTSIZE, {?SH_ENTSIZE_OFFSET, ?SH_ENTSIZE_SIZE}). + +%% Section Indices +-define(SHN_UNDEF, 0). +-define(SHN_LOPROC, 16#FF00). +-define(SHN_HIPROC, 16#FF1F). +-define(SHN_LOOS, 16#FF20). +-define(SHN_HIOS, 16#FF3F). +-define(SHN_ABS, 16#FFF1). +-define(SHN_COMMON, 16#FFF2). + +%% Section Types (sh_type) +-define(SHT_NULL, 0). +-define(SHT_PROGBITS, 1). +-define(SHT_SYMTAB, 2). +-define(SHT_STRTAB, 3). +-define(SHT_RELA, 4). +-define(SHT_HASH, 5). +-define(SHT_DYNAMIC, 6). +-define(SHT_NOTE, 7). +-define(SHT_NOBITS, 8). +-define(SHT_REL, 9). +-define(SHT_SHLIB, 10). +-define(SHT_DYNSYM, 11). +-define(SHT_LOOS, 16#60000000). +-define(SHT_HIOS, 16#6FFFFFFF). +-define(SHT_LOPROC, 16#70000000). +-define(SHT_HIPROC, 16#7FFFFFFF). + +%% Section Attributes (sh_flags) +-define(SHF_WRITE, 16#1). +-define(SHF_ALLOC, 16#2). +-define(SHF_EXECINSTR, 16#4). +-define(SHF_MASKOS, 16#0F000000). +-define(SHF_MASKPROC, 16#F0000000). + +%% +%% Standard Section names for Code and Data +%% +-define(BSS, ".bss"). +-define(DATA, ".data"). +-define(INTERP, ".interp"). +-define(RODATA, ".rodata"). +-define(TEXT, ".text"). +%% Other Standard Section names +-define(COMMENT, ".comment"). +-define(DYNAMIC, ".dynamic"). +-define(DYNSTR, ".dynstr"). +-define(GOT, ".got"). +-define(HASH, ".hash"). +-define(NOTE(Name), (".note" ++ Name)). +-define(PLT, ".plt"). +-define(REL(Name), (".rel" ++ Name) ). +-define(RELA(Name), (".rela" ++ Name) ). +-define(SHSTRTAB, ".shstrtab"). +-define(STRTAB, ".strtab"). +-define(SYMTAB, ".symtab"). +-define(GCC_EXN_TAB, ".gcc_except_table"). + +%%------------------------------------------------------------------------------ +%% ELF Symbol Table Entries +%%------------------------------------------------------------------------------ +-define(ELF_SYM_SIZE, (?ST_NAME_SIZE + ?ST_INFO_SIZE + ?ST_OTHER_SIZE + +?ST_SHNDX_SIZE + ?ST_VALUE_SIZE + ?ST_SIZE_SIZE) ). + +-define(ST_NAME_SIZE, ?ELF_WORD_SIZE). +-define(ST_INFO_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_OTHER_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_SHNDX_SIZE, ?ELF_HALF_SIZE). +-define(ST_VALUE_SIZE, ?ELF_ADDR_SIZE). +-define(ST_SIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Precomputed offset for Symbol Table entries in SymTab binary +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for Symbol Table entry information +-define(ST_NAME, {?ST_NAME_OFFSET, ?ST_NAME_SIZE}). +-define(ST_INFO, {?ST_INFO_OFFSET, ?ST_INFO_SIZE}). +-define(ST_OTHER, {?ST_OTHER_OFFSET, ?ST_OTHER_SIZE}). +-define(ST_SHNDX, {?ST_SHNDX_OFFSET, ?ST_SHNDX_SIZE}). +-define(ST_VALUE, {?ST_VALUE_OFFSET, ?ST_VALUE_SIZE}). +-define(ST_SIZE, {?ST_SIZE_OFFSET, ?ST_SIZE_SIZE}). + +%% Macros to extract information from st_type +-define(ELF_ST_BIND(I), (I bsr 4) ). +-define(ELF_ST_TYPE(I), (I band 16#f) ). +-define(ELF_ST_INFO(B,T), (B bsl 4 + T band 16#f) ). + +%% Symbol Bindings +-define(STB_LOCAL, 0). +-define(STB_GLOBAL, 1). +-define(STB_WEAK, 2). +-define(STB_LOOS, 10). +-define(STB_HIOS, 12). +-define(STB_LOPROC, 13). +-define(STB_HIPROC, 15). + +%% Symbol Types +-define(STT_NOTYPE, 0). +-define(STT_OBJECT, 1). +-define(STT_FUNC, 2). +-define(STT_SECTION, 3). +-define(STT_FILE, 4). +-define(STT_LOOS, 10). +-define(STT_HIOS, 12). +-define(STT_LOPROC, 13). +-define(STT_HIPROC, 15). + +%%------------------------------------------------------------------------------ +%% ELF Relocation Entries +%%------------------------------------------------------------------------------ +-define(ELF_REL_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE) ). +-define(ELF_RELA_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE + ?R_ADDEND_SIZE) ). + +-define(R_OFFSET_SIZE, ?ELF_ADDR_SIZE). +-define(R_INFO_SIZE, ?ELF_XWORD_SIZE). +-define(R_ADDEND_SIZE, ?ELF_SXWORD_SIZE). + +%% Arithmetics for computing byte offsets in a Relocation entry binary +-define(R_OFFSET_OFFSET, 0). +-define(R_INFO_OFFSET, (?R_OFFSET_OFFSET + ?R_OFFSET_SIZE) ). +-define(R_ADDEND_OFFSET, (?R_INFO_OFFSET + ?R_INFO_SIZE) ). + +%% Name aliases for Relocation field information +-define(R_OFFSET, {?R_OFFSET_OFFSET, ?R_OFFSET_SIZE}). +-define(R_INFO, {?R_INFO_OFFSET, ?R_INFO_SIZE}). +-define(R_ADDEND, {?R_ADDEND_OFFSET, ?R_ADDEND_SIZE}). + +%% Useful macros to extract information from r_info field +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF Program Header Table +%%------------------------------------------------------------------------------ +-define(ELF_PHDR_SIZE, (?P_TYPE_SIZE + ?P_FLAGS_SIZE + ?P_OFFSET_SIZE + +?P_VADDR_SIZE + ?P_PADDR_SIZE + ?P_FILESZ_SIZE + +?P_MEMSZ_SIZE + ?P_ALIGN_SIZE) ). + +-define(P_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(P_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(P_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(P_VADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_PADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_FILESZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_MEMSZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_ALIGN_SIZE, ?ELF_XWORD_SIZE). + +%% Offsets of various fields in a Program Header Table entry binary. +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for each Program Header Table entry field information. +-define(P_TYPE, {?P_TYPE_OFFSET, ?P_TYPE_SIZE} ). +-define(P_FLAGS, {?P_FLAGS_OFFSET, ?P_FLAGS_SIZE} ). +-define(P_OFFSET, {?P_OFFSET_OFFSET, ?P_OFFSET_SIZE} ). +-define(P_VADDR, {?P_VADDR_OFFSET, ?P_VADDR_SIZE} ). +-define(P_PADDR, {?P_PADDR_OFFSET, ?P_PADDR_SIZE} ). +-define(P_FILESZ, {?P_FILESZ_OFFSET, ?P_FILESZ_SIZE} ). +-define(P_MEMSZ, {?P_MEMSZ_OFFSET, ?P_MEMSZ_SIZE} ). +-define(P_ALIGN, {?P_ALIGN_OFFSET, ?P_ALIGN_SIZE} ). + +%% Segment Types (p_type) +-define(PT_NULL, 0). +-define(PT_LOAD, 1). +-define(PT_DYNAMIC, 2). +-define(PT_INTERP, 3). +-define(PT_NOTE, 4). +-define(PT_SHLIB, 5). +-define(PT_PHDR, 6). +-define(PT_LOOS, 16#60000000). +-define(PT_HIOS, 16#6FFFFFFF). +-define(PT_LOPROC, 16#70000000). +-define(PT_HIPROC, 16#7FFFFFFF). + +%% Segment Attributes (p_flags) +-define(PF_X, 16#1). +-define(PF_W, 16#2). +-define(PF_R, 16#4). +-define(PF_MASKOS, 16#00FF0000). +-define(PF_MASKPROC, 16#FF000000). + +%%------------------------------------------------------------------------------ +%% ELF Dynamic Table +%%------------------------------------------------------------------------------ +-define(ELF_DYN_SIZE, (?D_TAG_SIZE + ?D_VAL_PTR_SIZE) ). + +-define(D_TAG_SIZE, ?ELF_SXWORD_SIZE). +-define(D_VAL_PTR_SIZE, ?ELF_ADDR_SIZE). + +%% Offsets of each field in Dynamic Table entry in binary +-define(D_TAG_OFFSET, 0). +-define(D_VAL_PTR_OFFSET, (?D_TAG_OFFSET + ?D_TAG_SIZE)). + +%% Name aliases for each field of a Dynamic Table entry information +-define(D_TAG, {?D_TAG_OFFSET, ?D_TAG_SIZE} ). +-define(D_VAL_PTR, {?D_VAL_PTR_OFFSET, ?D_VAL_PTR_SIZE} ). + +%% Dynamic Table Entries +-define(DT_NULL, 0). +-define(DT_NEEDED, 1). +-define(DT_PLTRELSZ, 2). +-define(DT_PLTGOT, 3). +-define(DT_HASH, 4). +-define(DT_STRTAB, 5). +-define(DT_SYMTAB, 6). +-define(DT_RELA, 7). +-define(DT_RELASZ, 8). +-define(DT_RELAENT, 9). +-define(DT_STRSZ, 10). +-define(DT_SYMENT, 11). +-define(DT_INIT, 12). +-define(DT_FINI, 13). +-define(DT_SONAME, 14). +-define(DT_RPATH, 15). +-define(DT_SYMBOLIC, 16). +-define(DT_REL, 17). +-define(DT_RELSZ, 18). +-define(DT_RELENT, 19). +-define(DT_PLTREL, 20). +-define(DT_DEBUG, 21). +-define(DT_TEXTREL, 22). +-define(DT_JMPREL, 23). +-define(DT_BIND_NOW, 24). +-define(DT_INIT_ARRAY, 25). +-define(DT_FINI_ARRAY, 26). +-define(DT_INIT_ARRAYSZ, 27). +-define(DT_FINI_ARRAYSZ, 28). +-define(DT_LOOS, 16#60000000). +-define(DT_HIOS, 16#6FFFFFFF). +-define(DT_LOPROC, 16#700000000). +-define(DT_HIPROC, 16#7FFFFFFFF). + +%%------------------------------------------------------------------------------ +%% ELF GCC Exception Table +%%------------------------------------------------------------------------------ + +%% The DWARF Exception Header Encoding is used to describe the type of data used +%% in the .eh_frame_hdr (and .gcc_except_table) section. The upper 4 bits +%% indicate how the value is to be applied. The lower 4 bits indicate the format +%% of the data. + +%% DWARF Exception Header value format +-define(DW_EH_PE_omit, 16#ff). % No value is present. +-define(DW_EH_PE_uleb128, 16#01). % Unsigned value encoded using LEB128. +-define(DW_EH_PE_udata2, 16#02). % A 2 bytes unsigned value. +-define(DW_EH_PE_udata4, 16#03). % A 4 bytes unsigned value. +-define(DW_EH_PE_udata8, 16#04). % An 8 bytes unsigned value. +-define(DW_EH_PE_sleb128, 16#09). % Signed value encoded using LEB128. +-define(DW_EH_PE_sdata2, 16#0a). % A 2 bytes signed value. +-define(DW_EH_PE_sdata4, 16#0b). % A 4 bytes signed value. +-define(DW_EH_PE_sdata8, 16#0c). % An 8 bytes signed value. + +%% DWARF Exception Header application +-define(DW_EH_PE_absptr, 16#00). % Value is used with no modification. +-define(DW_EH_PE_pcrel, 16#10). % Value is relative to the current PC. +-define(DW_EH_PE_datarel, 16#30). % Value is relative to the beginning of the + % section. + +%%------------------------------------------------------------------------------ +%% ELF Read-only data (constants, literlas etc.) +%%------------------------------------------------------------------------------ +-define(RO_ENTRY_SIZE, 8). + +%%------------------------------------------------------------------------------ +%% Custom Note section: ".note.gc" for Erlang GC +%%------------------------------------------------------------------------------ + +%% The structure of this section is the following: +%% +%% .short <n> # number of safe points in code +%% +%% .long .L<label1> # safe point address | +%% .long .L<label2> # safe point address |-> safe point addrs +%% ..... | +%% .long .L<label3> # safe point address | +%% +%% .short <n> # stack frame size (in words) |-> fixed-size part +%% .short <n> # stack arity | +%% .short <n> # number of live roots that follow | +%% +%% .short <n> # live root's stack index | +%% ..... |-> live root indices +%% .short <n> # >> | + +%% The name of the custom Note Section +-define(NOTE_ERLGC_NAME, ".gc"). + +%% The first word of a Note Section for Erlang GC (".note.gc") is always the +%% number of safepoints in code. +-define(SP_COUNT, {?SP_COUNT_OFFSET, ?SP_COUNT_SIZE}). +-define(SP_COUNT_SIZE, ?ELF_HALF_SIZE). +-define(SP_COUNT_OFFSET, 0). %(always the first entry in sdesc) + +%% The fixed-size part of a safe point (SP) entry consists of 4 words: the SP +%% address (offset in code), the stack frame size of the function (where the SP +%% is located), the stack arity of the function (the registered values are *not* +%% counted), the number of live roots in the specific SP. +-define(SP_FIXED, {?SP_FIXED_OFF, ?SP_FIXED_SIZE}). +-define(SP_FIXED_OFF, 0). +%%XXX: Exclude SP_ADDR_SIZE from SP_FIXED_SIZE in lew of new GC layout +-define(SP_FIXED_SIZE, (?SP_STKFRAME_SIZE + ?SP_STKARITY_SIZE + + ?SP_LIVEROOTCNT_SIZE)). + +-define(SP_ADDR_SIZE, ?ELF_WORD_SIZE). +-define(SP_STKFRAME_SIZE, ?ELF_HALF_SIZE). +-define(SP_STKARITY_SIZE, ?ELF_HALF_SIZE). +-define(SP_LIVEROOTCNT_SIZE, ?ELF_HALF_SIZE). + +%%XXX: SP_STKFRAME is the first piece of information in the new GC layout +-define(SP_STKFRAME_OFFSET, 0). +-define(SP_STKARITY_OFFSET, (?SP_STKFRAME_OFFSET + ?SP_STKFRAME_SIZE) ). +-define(SP_LIVEROOTCNT_OFFSET, (?SP_STKARITY_OFFSET + ?SP_STKARITY_SIZE) ). + +%% Name aliases for safepoint fields. +-define(SP_STKFRAME, {?SP_STKFRAME_OFFSET, ?SP_STKFRAME_SIZE}). +-define(SP_STKARITY, {?SP_STKARITY_OFFSET, ?SP_STKARITY_SIZE}). +-define(SP_LIVEROOTCNT, {?SP_LIVEROOTCNT_OFFSET, ?SP_LIVEROOTCNT_SIZE}). + +%% After the fixed-size part a variable-size part exists. This part holds the +%% stack frame index of every live root in the specific SP. +-define(LR_STKINDEX_SIZE, ?ELF_HALF_SIZE). + +%%------------------------------------------------------------------------------ +%% Misc. +%%------------------------------------------------------------------------------ +-define(bits(Bytes), ((Bytes) bsl 3)). diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl new file mode 100644 index 0000000000..5e33731a2b --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -0,0 +1,1131 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_llvm). + +-export([ + mk_ret/1, + ret_ret_list/1, + + mk_br/1, + br_dst/1, + + mk_br_cond/3, + mk_br_cond/4, + br_cond_cond/1, + br_cond_true_label/1, + br_cond_false_label/1, + br_cond_meta/1, + + mk_indirectbr/3, + indirectbr_type/1, + indirectbr_address/1, + indirectbr_label_list/1, + + mk_switch/4, + switch_type/1, + switch_value/1, + switch_default_label/1, + switch_value_label_list/1, + + mk_invoke/9, + invoke_dst/1, + invoke_cconv/1, + invoke_ret_attrs/1, + invoke_type/1, + invoke_fnptrval/1, + invoke_arglist/1, + invoke_fn_attrs/1, + invoke_to_label/1, + invoke_unwind_label/1, + + mk_operation/6, + operation_dst/1, + operation_op/1, + operation_type/1, + operation_src1/1, + operation_src2/1, + operation_options/1, + + mk_extractvalue/5, + extractvalue_dst/1, + extractvalue_type/1, + extractvalue_val/1, + extractvalue_idx/1, + extractvalue_idxs/1, + + mk_insertvalue/7, + insertvalue_dst/1, + insertvalue_val_type/1, + insertvalue_val/1, + insertvalue_elem_type/1, + insertvalue_elem/1, + insertvalue_idx/1, + insertvalue_idxs/1, + + mk_alloca/4, + alloca_dst/1, + alloca_type/1, + alloca_num/1, + alloca_align/1, + + mk_load/6, + load_dst/1, + load_p_type/1, + load_pointer/1, + load_alignment/1, + load_nontemporal/1, + load_volatile/1, + + mk_store/7, + store_type/1, + store_value/1, + store_p_type/1, + store_pointer/1, + store_alignment/1, + store_nontemporal/1, + store_volatile/1, + + mk_getelementptr/5, + getelementptr_dst/1, + getelementptr_p_type/1, + getelementptr_value/1, + getelementptr_typed_idxs/1, + getelementptr_inbounds/1, + + mk_conversion/5, + conversion_dst/1, + conversion_op/1, + conversion_src_type/1, + conversion_src/1, + conversion_dst_type/1, + + mk_sitofp/4, + sitofp_dst/1, + sitofp_src_type/1, + sitofp_src/1, + sitofp_dst_type/1, + + mk_ptrtoint/4, + ptrtoint_dst/1, + ptrtoint_src_type/1, + ptrtoint_src/1, + ptrtoint_dst_type/1, + + mk_inttoptr/4, + inttoptr_dst/1, + inttoptr_src_type/1, + inttoptr_src/1, + inttoptr_dst_type/1, + + mk_icmp/5, + icmp_dst/1, + icmp_cond/1, + icmp_type/1, + icmp_src1/1, + icmp_src2/1, + + mk_fcmp/5, + fcmp_dst/1, + fcmp_cond/1, + fcmp_type/1, + fcmp_src1/1, + fcmp_src2/1, + + mk_phi/3, + phi_dst/1, + phi_type/1, + phi_value_label_list/1, + + mk_select/6, + select_dst/1, + select_cond/1, + select_typ1/1, + select_val1/1, + select_typ2/1, + select_val2/1, + + mk_call/8, + call_dst/1, + call_is_tail/1, + call_cconv/1, + call_ret_attrs/1, + call_type/1, + call_fnptrval/1, + call_arglist/1, + call_fn_attrs/1, + + mk_fun_def/10, + fun_def_linkage/1, + fun_def_visibility/1, + fun_def_cconv/1, + fun_def_ret_attrs/1, + fun_def_type/1, + fun_def_name/1, + fun_def_arglist/1, + fun_def_fn_attrs/1, + fun_def_align/1, + fun_def_body/1, + + mk_fun_decl/8, + fun_decl_linkage/1, + fun_decl_visibility/1, + fun_decl_cconv/1, + fun_decl_ret_attrs/1, + fun_decl_type/1, + fun_decl_name/1, + fun_decl_arglist/1, + fun_decl_align/1, + + mk_landingpad/0, + + mk_comment/1, + comment_text/1, + + mk_label/1, + label_label/1, + is_label/1, + + mk_const_decl/4, + const_decl_dst/1, + const_decl_decl_type/1, + const_decl_type/1, + const_decl_value/1, + + mk_asm/1, + asm_instruction/1, + + mk_adj_stack/3, + adj_stack_offset/1, + adj_stack_register/1, + adj_stack_type/1, + + mk_branch_meta/3, + branch_meta_id/1, + branch_meta_true_weight/1, + branch_meta_false_weight/1 + ]). + +-export([ + mk_void/0, + + mk_label_type/0, + + mk_int/1, + int_width/1, + + mk_double/0, + + mk_pointer/1, + pointer_type/1, + + mk_array/2, + array_size/1, + array_type/1, + + mk_vector/2, + vector_size/1, + vector_type/1, + + mk_struct/1, + struct_type_list/1, + + mk_fun/2, + function_ret_type/1, + function_arg_type_list/1 + ]). + +-export([pp_ins_list/2, pp_ins/2]). + + +%%----------------------------------------------------------------------------- +%% Abstract Data Types for LLVM Assembly. +%%----------------------------------------------------------------------------- + +%% Terminator Instructions +-record(llvm_ret, {ret_list=[]}). +-type llvm_ret() :: #llvm_ret{}. + +-record(llvm_br, {dst}). +-type llvm_br() :: #llvm_br{}. + +-record(llvm_br_cond, {'cond', true_label, false_label, meta=[]}). +-type llvm_br_cond() :: #llvm_br_cond{}. + +-record(llvm_indirectbr, {type, address, label_list}). +-type llvm_indirectbr() :: #llvm_indirectbr{}. + +-record(llvm_switch, {type, value, default_label, value_label_list=[]}). +-type llvm_switch() :: #llvm_switch{}. + +-record(llvm_invoke, {dst, cconv=[], ret_attrs=[], type, fnptrval, arglist=[], + fn_attrs=[], to_label, unwind_label}). +-type llvm_invoke() :: #llvm_invoke{}. + +%% Binary Operations +-record(llvm_operation, {dst, op, type, src1, src2, options=[]}). +-type llvm_operation() :: #llvm_operation{}. + +%% Aggregate Operations +-record(llvm_extractvalue, {dst, type, val, idx, idxs=[]}). +-type llvm_extractvalue() :: #llvm_extractvalue{}. + +-record(llvm_insertvalue, {dst, val_type, val, elem_type, elem, idx, idxs=[]}). +-type llvm_insertvalue() :: #llvm_insertvalue{}. + +%% Memory Access and Addressing Operations +-record(llvm_alloca, {dst, type, num=[], align=[]}). +-type llvm_alloca() :: #llvm_alloca{}. + +-record(llvm_load, {dst, p_type, pointer, alignment=[], nontemporal=[], + volatile=false}). +-type llvm_load() :: #llvm_load{}. + +-record(llvm_store, {type, value, p_type, pointer, alignment=[], + nontemporal=[], volatile=false}). +-type llvm_store() :: #llvm_store{}. + +-record(llvm_getelementptr, {dst, p_type, value, typed_idxs, inbounds}). +-type llvm_getelementptr() :: #llvm_getelementptr{}. + +%% Conversion Operations +-record(llvm_conversion, {dst, op, src_type, src, dst_type}). +-type llvm_conversion() :: #llvm_conversion{}. + +-record(llvm_sitofp, {dst, src_type, src, dst_type}). +-type llvm_sitofp() :: #llvm_sitofp{}. + +-record(llvm_ptrtoint, {dst, src_type, src, dst_type}). +-type llvm_ptrtoint() :: #llvm_ptrtoint{}. + +-record(llvm_inttoptr, {dst, src_type, src, dst_type}). +-type llvm_inttoptr() :: #llvm_inttoptr{}. + +%% Other Operations +-record(llvm_icmp, {dst, 'cond', type, src1, src2}). +-type llvm_icmp() :: #llvm_icmp{}. + +-record(llvm_fcmp, {dst, 'cond', type, src1, src2}). +-type llvm_fcmp() :: #llvm_fcmp{}. + +-record(llvm_phi, {dst, type, value_label_list}). +-type llvm_phi() :: #llvm_phi{}. + +-record(llvm_select, {dst, 'cond', typ1, val1, typ2, val2}). +-type llvm_select() :: #llvm_select{}. + +-record(llvm_call, {dst=[], is_tail = false, cconv = [], ret_attrs = [], type, + fnptrval, arglist = [], fn_attrs = []}). +-type llvm_call() :: #llvm_call{}. + +-record(llvm_fun_def, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], fn_attrs=[], align=[], body=[]}). +-type llvm_fun_def() :: #llvm_fun_def{}. + +-record(llvm_fun_decl, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], align=[]}). +-type llvm_fun_decl() :: #llvm_fun_decl{}. + +-record(llvm_landingpad, {}). +-type llvm_landingpad() :: #llvm_landingpad{}. + +-record(llvm_comment, {text}). +-type llvm_comment() :: #llvm_comment{}. + +-record(llvm_label, {label}). +-type llvm_label() :: #llvm_label{}. + +-record(llvm_const_decl, {dst, decl_type, type, value}). +-type llvm_const_decl() :: #llvm_const_decl{}. + +-record(llvm_asm, {instruction}). +-type llvm_asm() :: #llvm_asm{}. + +-record(llvm_adj_stack, {offset, 'register', type}). +-type llvm_adj_stack() :: #llvm_adj_stack{}. + +-record(llvm_branch_meta, {id, true_weight, false_weight}). +-type llvm_branch_meta() :: #llvm_branch_meta{}. + +%% A type for any LLVM instruction +-type llvm_instr() :: llvm_ret() | llvm_br() | llvm_br_cond() + | llvm_indirectbr() | llvm_switch() | llvm_invoke() + | llvm_operation() | llvm_extractvalue() + | llvm_insertvalue() | llvm_alloca() | llvm_load() + | llvm_store() | llvm_getelementptr() | llvm_conversion() + | llvm_sitofp() | llvm_ptrtoint() | llvm_inttoptr() + | llvm_icmp() | llvm_fcmp() | llvm_phi() | llvm_select() + | llvm_call() | llvm_fun_def() | llvm_fun_decl() + | llvm_landingpad() | llvm_comment() | llvm_label() + | llvm_const_decl() | llvm_asm() | llvm_adj_stack() + | llvm_branch_meta(). + +%% Types +-record(llvm_void, {}). +%-type llvm_void() :: #llvm_void{}. + +-record(llvm_label_type, {}). +%-type llvm_label_type() :: #llvm_label_type{}. + +-record(llvm_int, {width}). +%-type llvm_int() :: #llvm_int{}. + +-record(llvm_float, {}). +%-type llvm_float() :: #llvm_float{}. + +-record(llvm_double, {}). +%-type llvm_double() :: #llvm_double{}. + +-record(llvm_fp80, {}). +%-type llvm_fp80() :: #llvm_fp80{}. + +-record(llvm_fp128, {}). +%-type llvm_fp128() :: #llvm_fp128{}. + +-record(llvm_ppc_fp128, {}). +%-type llvm_ppc_fp128() :: #llvm_ppc_fp128{}. + +-record(llvm_pointer, {type}). +%-type llvm_pointer() :: #llvm_pointer{}. + +-record(llvm_vector, {'size', type}). +%-type llvm_vector() :: #llvm_vector{}. + +-record(llvm_struct, {type_list}). +%-type llvm_struct() :: #llvm_struct{}. + +-record(llvm_array, {'size', type}). +%-type llvm_array() :: #llvm_array{}. + +-record(llvm_fun, {ret_type, arg_type_list}). +%-type llvm_fun() :: #llvm_fun{}. + +%%----------------------------------------------------------------------------- +%% Accessor Functions +%%----------------------------------------------------------------------------- + +%% ret +mk_ret(Ret_list) -> #llvm_ret{ret_list=Ret_list}. +ret_ret_list(#llvm_ret{ret_list=Ret_list}) -> Ret_list. + +%% br +mk_br(Dst) -> #llvm_br{dst=Dst}. +br_dst(#llvm_br{dst=Dst}) -> Dst. + +%% br_cond +mk_br_cond(Cond, True_label, False_label) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label}. +mk_br_cond(Cond, True_label, False_label, Metadata) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label, + meta=Metadata}. +br_cond_cond(#llvm_br_cond{'cond'=Cond}) -> Cond. +br_cond_true_label(#llvm_br_cond{true_label=True_label}) -> True_label. +br_cond_false_label(#llvm_br_cond{false_label=False_label}) -> + False_label. +br_cond_meta(#llvm_br_cond{meta=Metadata}) -> Metadata. + +%% indirectbr +mk_indirectbr(Type, Address, Label_list) -> #llvm_indirectbr{type=Type, address=Address, label_list=Label_list}. +indirectbr_type(#llvm_indirectbr{type=Type}) -> Type. +indirectbr_address(#llvm_indirectbr{address=Address}) -> Address. +indirectbr_label_list(#llvm_indirectbr{label_list=Label_list}) -> Label_list. + +%% invoke +mk_invoke(Dst, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs, To_label, Unwind_label) -> + #llvm_invoke{dst=Dst, cconv=Cconv, ret_attrs=Ret_attrs, type=Type, + fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs, to_label=To_label, + unwind_label=Unwind_label}. +invoke_dst(#llvm_invoke{dst=Dst}) -> Dst. +invoke_cconv(#llvm_invoke{cconv=Cconv}) -> Cconv. +invoke_ret_attrs(#llvm_invoke{ret_attrs=Ret_attrs}) -> Ret_attrs. +invoke_type(#llvm_invoke{type=Type}) -> Type. +invoke_fnptrval(#llvm_invoke{fnptrval=Fnptrval}) -> Fnptrval. +invoke_arglist(#llvm_invoke{arglist=Arglist}) -> Arglist. +invoke_fn_attrs(#llvm_invoke{fn_attrs=Fn_attrs}) -> Fn_attrs. +invoke_to_label(#llvm_invoke{to_label=To_label}) -> To_label. +invoke_unwind_label(#llvm_invoke{unwind_label=Unwind_label}) -> Unwind_label. + +%% switch +mk_switch(Type, Value, Default_label, Value_label_list) -> + #llvm_switch{type=Type, value=Value, default_label=Default_label, + value_label_list=Value_label_list}. +switch_type(#llvm_switch{type=Type}) -> Type. +switch_value(#llvm_switch{value=Value}) -> Value. +switch_default_label(#llvm_switch{default_label=Default_label}) -> + Default_label. +switch_value_label_list(#llvm_switch{value_label_list=Value_label_list}) -> + Value_label_list. + +%% operation +mk_operation(Dst, Op, Type, Src1, Src2, Options) -> + #llvm_operation{dst=Dst, op=Op, type=Type, src1=Src1, src2=Src2, + options=Options}. +operation_dst(#llvm_operation{dst=Dst}) -> Dst. +operation_op(#llvm_operation{op=Op}) -> Op. +operation_type(#llvm_operation{type=Type}) -> Type. +operation_src1(#llvm_operation{src1=Src1}) -> Src1. +operation_src2(#llvm_operation{src2=Src2}) -> Src2. +operation_options(#llvm_operation{options=Options}) -> Options. + +%% extractvalue +mk_extractvalue(Dst, Type, Val, Idx, Idxs) -> + #llvm_extractvalue{dst=Dst,type=Type,val=Val,idx=Idx,idxs=Idxs}. +extractvalue_dst(#llvm_extractvalue{dst=Dst}) -> Dst. +extractvalue_type(#llvm_extractvalue{type=Type}) -> Type. +extractvalue_val(#llvm_extractvalue{val=Val}) -> Val. +extractvalue_idx(#llvm_extractvalue{idx=Idx}) -> Idx. +extractvalue_idxs(#llvm_extractvalue{idxs=Idxs}) -> Idxs. + +%% insertvalue +mk_insertvalue(Dst, Val_type, Val, Elem_type, Elem, Idx, Idxs) -> + #llvm_insertvalue{dst=Dst, val_type=Val_type, val=Val, elem_type=Elem_type, + elem=Elem, idx=Idx, idxs=Idxs}. +insertvalue_dst(#llvm_insertvalue{dst=Dst}) -> Dst. +insertvalue_val_type(#llvm_insertvalue{val_type=Val_type}) -> Val_type. +insertvalue_val(#llvm_insertvalue{val=Val}) -> Val. +insertvalue_elem_type(#llvm_insertvalue{elem_type=Elem_type}) -> Elem_type. +insertvalue_elem(#llvm_insertvalue{elem=Elem}) -> Elem. +insertvalue_idx(#llvm_insertvalue{idx=Idx}) -> Idx. +insertvalue_idxs(#llvm_insertvalue{idxs=Idxs}) -> Idxs. + +%% alloca +mk_alloca(Dst, Type, Num, Align) -> + #llvm_alloca{dst=Dst, type=Type, num=Num, align=Align}. +alloca_dst(#llvm_alloca{dst=Dst}) -> Dst. +alloca_type(#llvm_alloca{type=Type}) -> Type. +alloca_num(#llvm_alloca{num=Num}) -> Num. +alloca_align(#llvm_alloca{align=Align}) -> Align. + +%% load +mk_load(Dst, Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_load{dst=Dst, p_type=Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +load_dst(#llvm_load{dst=Dst}) -> Dst. +load_p_type(#llvm_load{p_type=Type}) -> Type. +load_pointer(#llvm_load{pointer=Pointer}) -> Pointer. +load_alignment(#llvm_load{alignment=Alignment}) -> Alignment. +load_nontemporal(#llvm_load{nontemporal=Nontemporal}) -> Nontemporal. +load_volatile(#llvm_load{volatile=Volatile}) -> Volatile. + +%% store +mk_store(Type, Value, P_Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_store{type=Type, value=Value, p_type=P_Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +store_type(#llvm_store{type=Type}) -> Type. +store_value(#llvm_store{value=Value}) -> Value. +store_p_type(#llvm_store{p_type=P_Type}) -> P_Type. +store_pointer(#llvm_store{pointer=Pointer}) -> Pointer. +store_alignment(#llvm_store{alignment=Alignment}) -> Alignment. +store_nontemporal(#llvm_store{nontemporal=Nontemporal}) -> Nontemporal. +store_volatile(#llvm_store{volatile=Volatile}) -> Volatile. + +%% getelementptr +mk_getelementptr(Dst, P_Type, Value, Typed_Idxs, Inbounds) -> + #llvm_getelementptr{dst=Dst,p_type=P_Type, value=Value, + typed_idxs=Typed_Idxs, inbounds=Inbounds}. +getelementptr_dst(#llvm_getelementptr{dst=Dst}) -> Dst. +getelementptr_p_type(#llvm_getelementptr{p_type=P_Type}) -> P_Type. +getelementptr_value(#llvm_getelementptr{value=Value}) -> Value. +getelementptr_typed_idxs(#llvm_getelementptr{typed_idxs=Typed_Idxs}) -> Typed_Idxs. +getelementptr_inbounds(#llvm_getelementptr{inbounds=Inbounds}) -> Inbounds. + +%% conversion +mk_conversion(Dst, Op, Src_type, Src, Dst_type) -> + #llvm_conversion{dst=Dst, op=Op, src_type=Src_type, src=Src, dst_type=Dst_type}. +conversion_dst(#llvm_conversion{dst=Dst}) -> Dst. +conversion_op(#llvm_conversion{op=Op}) -> Op. +conversion_src_type(#llvm_conversion{src_type=Src_type}) -> Src_type. +conversion_src(#llvm_conversion{src=Src}) -> Src. +conversion_dst_type(#llvm_conversion{dst_type=Dst_type}) -> Dst_type. + +%% sitofp +mk_sitofp(Dst, Src_type, Src, Dst_type) -> + #llvm_sitofp{dst=Dst, src_type=Src_type, src=Src, dst_type=Dst_type}. +sitofp_dst(#llvm_sitofp{dst=Dst}) -> Dst. +sitofp_src_type(#llvm_sitofp{src_type=Src_type}) -> Src_type. +sitofp_src(#llvm_sitofp{src=Src}) -> Src. +sitofp_dst_type(#llvm_sitofp{dst_type=Dst_type}) -> Dst_type. + +%% ptrtoint +mk_ptrtoint(Dst, Src_Type, Src, Dst_Type) -> + #llvm_ptrtoint{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +ptrtoint_dst(#llvm_ptrtoint{dst=Dst}) -> Dst. +ptrtoint_src_type(#llvm_ptrtoint{src_type=Src_Type}) -> Src_Type. +ptrtoint_src(#llvm_ptrtoint{src=Src}) -> Src. +ptrtoint_dst_type(#llvm_ptrtoint{dst_type=Dst_Type}) -> Dst_Type . + +%% inttoptr +mk_inttoptr(Dst, Src_Type, Src, Dst_Type) -> + #llvm_inttoptr{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +inttoptr_dst(#llvm_inttoptr{dst=Dst}) -> Dst. +inttoptr_src_type(#llvm_inttoptr{src_type=Src_Type}) -> Src_Type. +inttoptr_src(#llvm_inttoptr{src=Src}) -> Src. +inttoptr_dst_type(#llvm_inttoptr{dst_type=Dst_Type}) -> Dst_Type . + +%% icmp +mk_icmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_icmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +icmp_dst(#llvm_icmp{dst=Dst}) -> Dst. +icmp_cond(#llvm_icmp{'cond'=Cond}) -> Cond. +icmp_type(#llvm_icmp{type=Type}) -> Type. +icmp_src1(#llvm_icmp{src1=Src1}) -> Src1. +icmp_src2(#llvm_icmp{src2=Src2}) -> Src2. + +%% fcmp +mk_fcmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_fcmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +fcmp_dst(#llvm_fcmp{dst=Dst}) -> Dst. +fcmp_cond(#llvm_fcmp{'cond'=Cond}) -> Cond. +fcmp_type(#llvm_fcmp{type=Type}) -> Type. +fcmp_src1(#llvm_fcmp{src1=Src1}) -> Src1. +fcmp_src2(#llvm_fcmp{src2=Src2}) -> Src2. + +%% phi +mk_phi(Dst, Type, Value_label_list) -> + #llvm_phi{dst=Dst, type=Type,value_label_list=Value_label_list}. +phi_dst(#llvm_phi{dst=Dst}) -> Dst. +phi_type(#llvm_phi{type=Type}) -> Type. +phi_value_label_list(#llvm_phi{value_label_list=Value_label_list}) -> + Value_label_list. + +%% select +mk_select(Dst, Cond, Typ1, Val1, Typ2, Val2) -> + #llvm_select{dst=Dst, 'cond'=Cond, typ1=Typ1, val1=Val1, typ2=Typ2, val2=Val2}. +select_dst(#llvm_select{dst=Dst}) -> Dst. +select_cond(#llvm_select{'cond'=Cond}) -> Cond. +select_typ1(#llvm_select{typ1=Typ1}) -> Typ1. +select_val1(#llvm_select{val1=Val1}) -> Val1. +select_typ2(#llvm_select{typ2=Typ2}) -> Typ2. +select_val2(#llvm_select{val2=Val2}) -> Val2. + +%% call +mk_call(Dst, Is_tail, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs) -> + #llvm_call{dst=Dst, is_tail=Is_tail, cconv=Cconv, ret_attrs=Ret_attrs, + type=Type, fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs}. +call_dst(#llvm_call{dst=Dst}) -> Dst. +call_is_tail(#llvm_call{is_tail=Is_tail}) -> Is_tail. +call_cconv(#llvm_call{cconv=Cconv}) -> Cconv. +call_ret_attrs(#llvm_call{ret_attrs=Ret_attrs}) -> Ret_attrs. +call_type(#llvm_call{type=Type}) -> Type. +call_fnptrval(#llvm_call{fnptrval=Fnptrval}) -> Fnptrval. +call_arglist(#llvm_call{arglist=Arglist}) -> Arglist. +call_fn_attrs(#llvm_call{fn_attrs=Fn_attrs}) -> Fn_attrs. + +%% fun_def +mk_fun_def(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, + Fn_attrs, Align, Body) -> + #llvm_fun_def{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + fn_attrs=Fn_attrs, + align=Align, + body=Body + }. + +fun_def_linkage(#llvm_fun_def{linkage=Linkage}) -> Linkage. +fun_def_visibility(#llvm_fun_def{visibility=Visibility}) -> Visibility. +fun_def_cconv(#llvm_fun_def{cconv=Cconv}) -> Cconv . +fun_def_ret_attrs(#llvm_fun_def{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_def_type(#llvm_fun_def{type=Type}) -> Type. +fun_def_name(#llvm_fun_def{'name'=Name}) -> Name. +fun_def_arglist(#llvm_fun_def{arglist=Arglist}) -> Arglist. +fun_def_fn_attrs(#llvm_fun_def{fn_attrs=Fn_attrs}) -> Fn_attrs. +fun_def_align(#llvm_fun_def{align=Align}) -> Align. +fun_def_body(#llvm_fun_def{body=Body}) -> Body. + +%% fun_decl +mk_fun_decl(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, Align)-> + #llvm_fun_decl{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + align=Align + }. + +fun_decl_linkage(#llvm_fun_decl{linkage=Linkage}) -> Linkage. +fun_decl_visibility(#llvm_fun_decl{visibility=Visibility}) -> Visibility. +fun_decl_cconv(#llvm_fun_decl{cconv=Cconv}) -> Cconv . +fun_decl_ret_attrs(#llvm_fun_decl{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_decl_type(#llvm_fun_decl{type=Type}) -> Type. +fun_decl_name(#llvm_fun_decl{'name'=Name}) -> Name. +fun_decl_arglist(#llvm_fun_decl{arglist=Arglist}) -> Arglist. +fun_decl_align(#llvm_fun_decl{align=Align}) -> Align. + +%% landingpad +mk_landingpad() -> #llvm_landingpad{}. + +%% comment +mk_comment(Text) -> #llvm_comment{text=Text}. +comment_text(#llvm_comment{text=Text}) -> Text. + +%% label +mk_label(Label) -> #llvm_label{label=Label}. +label_label(#llvm_label{label=Label}) -> Label. + +-spec is_label(llvm_instr()) -> boolean(). +is_label(#llvm_label{}) -> true; +is_label(#llvm_ret{}) -> false; +is_label(#llvm_br{}) -> false; +is_label(#llvm_br_cond{}) -> false; +is_label(#llvm_indirectbr{}) -> false; +is_label(#llvm_switch{}) -> false; +is_label(#llvm_invoke{}) -> false; +is_label(#llvm_operation{}) -> false; +is_label(#llvm_extractvalue{}) -> false; +is_label(#llvm_insertvalue{}) -> false; +is_label(#llvm_alloca{}) -> false; +is_label(#llvm_load{}) -> false; +is_label(#llvm_store{}) -> false; +is_label(#llvm_getelementptr{}) -> false; +is_label(#llvm_conversion{}) -> false; +is_label(#llvm_sitofp{}) -> false; +is_label(#llvm_ptrtoint{}) -> false; +is_label(#llvm_inttoptr{}) -> false; +is_label(#llvm_icmp{}) -> false; +is_label(#llvm_fcmp{}) -> false; +is_label(#llvm_phi{}) -> false; +is_label(#llvm_select{}) -> false; +is_label(#llvm_call{}) -> false; +is_label(#llvm_fun_def{}) -> false; +is_label(#llvm_fun_decl{}) -> false; +is_label(#llvm_landingpad{}) -> false; +is_label(#llvm_comment{}) -> false; +is_label(#llvm_const_decl{}) -> false; +is_label(#llvm_asm{}) -> false; +is_label(#llvm_adj_stack{}) -> false; +is_label(#llvm_branch_meta{}) -> false. + +%% const_decl +mk_const_decl(Dst, Decl_type, Type, Value) -> + #llvm_const_decl{dst=Dst, decl_type=Decl_type, type=Type, value=Value}. +const_decl_dst(#llvm_const_decl{dst=Dst}) -> Dst. +const_decl_decl_type(#llvm_const_decl{decl_type=Decl_type}) -> Decl_type. +const_decl_type(#llvm_const_decl{type=Type}) -> Type. +const_decl_value(#llvm_const_decl{value=Value}) -> Value. + +%% asm +mk_asm(Instruction) -> #llvm_asm{instruction=Instruction}. +asm_instruction(#llvm_asm{instruction=Instruction}) -> Instruction. + +%% adj_stack +mk_adj_stack(Offset, Register, Type) -> + #llvm_adj_stack{offset=Offset, 'register'=Register, type=Type}. +adj_stack_offset(#llvm_adj_stack{offset=Offset}) -> Offset. +adj_stack_register(#llvm_adj_stack{'register'=Register}) -> Register. +adj_stack_type(#llvm_adj_stack{type=Type}) -> Type. + +%% branch meta-data +mk_branch_meta(Id, True_weight, False_weight) -> + #llvm_branch_meta{id=Id, true_weight=True_weight, false_weight=False_weight}. +branch_meta_id(#llvm_branch_meta{id=Id}) -> Id. +branch_meta_true_weight(#llvm_branch_meta{true_weight=True_weight}) -> + True_weight. +branch_meta_false_weight(#llvm_branch_meta{false_weight=False_weight}) -> + False_weight. + +%% types +mk_void() -> #llvm_void{}. + +mk_label_type() -> #llvm_label_type{}. + +mk_int(Width) -> #llvm_int{width=Width}. +int_width(#llvm_int{width=Width}) -> Width. + +mk_double() -> #llvm_double{}. + +mk_pointer(Type) -> #llvm_pointer{type=Type}. +pointer_type(#llvm_pointer{type=Type}) -> Type. + +mk_array(Size, Type) -> #llvm_array{'size'=Size, type=Type}. +array_size(#llvm_array{'size'=Size}) -> Size. +array_type(#llvm_array{type=Type}) -> Type. + +mk_vector(Size, Type) -> #llvm_vector{'size'=Size, type=Type}. +vector_size(#llvm_vector{'size'=Size}) -> Size. +vector_type(#llvm_vector{type=Type}) -> Type. + +mk_struct(Type_list) -> #llvm_struct{type_list=Type_list}. +struct_type_list(#llvm_struct{type_list=Type_list}) -> Type_list. + +mk_fun(Ret_type, Arg_type_list) -> + #llvm_fun{ret_type=Ret_type, arg_type_list=Arg_type_list}. +function_ret_type(#llvm_fun{ret_type=Ret_type}) -> Ret_type. +function_arg_type_list(#llvm_fun{arg_type_list=Arg_type_list}) -> + Arg_type_list. + +%%---------------------------------------------------------------------------- +%% Pretty-printer Functions +%%---------------------------------------------------------------------------- + +%% @doc Pretty-print a list of LLVM instructions to a Device. +pp_ins_list(_Dev, []) -> ok; +pp_ins_list(Dev, [I|Is]) -> + pp_ins(Dev, I), + pp_ins_list(Dev, Is). + +pp_ins(Dev, I) -> + case indent(I) of + true -> write(Dev, " "); + false -> ok + end, + case I of + #llvm_ret{} -> + write(Dev, "ret "), + case ret_ret_list(I) of + [] -> write(Dev, "void"); + List -> pp_args(Dev, List) + end, + write(Dev, "\n"); + #llvm_br{} -> + write(Dev, ["br label ", br_dst(I), "\n"]); + #llvm_switch{} -> + write(Dev, "switch "), + pp_type(Dev, switch_type(I)), + write(Dev, [" ", switch_value(I), ", label ", switch_default_label(I), + " \n [\n"]), + pp_switch_value_label_list(Dev, switch_type(I), + switch_value_label_list(I)), + write(Dev, " ]\n"); + #llvm_invoke{} -> + write(Dev, [invoke_dst(I), " = invoke ", invoke_cconv(I), " "]), + pp_options(Dev, invoke_ret_attrs(I)), + pp_type(Dev, invoke_type(I)), + write(Dev, [" ", invoke_fnptrval(I), "("]), + pp_args(Dev, invoke_arglist(I)), + write(Dev, ") "), + pp_options(Dev, invoke_fn_attrs(I)), + write(Dev, [" to label ", invoke_to_label(I)," unwind label ", + invoke_unwind_label(I), " \n"]); + #llvm_br_cond{} -> + write(Dev, ["br i1 ", br_cond_cond(I), ", label ", br_cond_true_label(I), + ", label ", br_cond_false_label(I)]), + case br_cond_meta(I) of + [] -> ok; + Metadata -> + write(Dev, [", !prof !", Metadata]) + end, + write(Dev, "\n"); + #llvm_indirectbr{} -> + write(Dev, "indirectbr "), + pp_type(Dev, indirectbr_type(I)), + write(Dev, [" ", indirectbr_address(I), ", [ "]), + pp_args(Dev, indirectbr_label_list(I)), + write(Dev, " ]\n"); + #llvm_operation{} -> + write(Dev, [operation_dst(I), " = ", atom_to_list(operation_op(I)), " "]), + case op_has_options(operation_op(I)) of + true -> pp_options(Dev, operation_options(I)); + false -> ok + end, + pp_type(Dev, operation_type(I)), + write(Dev, [" ", operation_src1(I), ", ", operation_src2(I), "\n"]); + #llvm_extractvalue{} -> + write(Dev, [extractvalue_dst(I), " = extractvalue "]), + pp_type(Dev, extractvalue_type(I)), + %% TODO Print idxs + write(Dev, [" ", extractvalue_val(I), ", ", extractvalue_idx(I), "\n"]); + #llvm_insertvalue{} -> + write(Dev, [insertvalue_dst(I), " = insertvalue "]), + pp_type(Dev, insertvalue_val_type(I)), + write(Dev, [" ", insertvalue_val(I), ", "]), + pp_type(Dev, insertvalue_elem_type(I)), + %%TODO Print idxs + write(Dev, [" ", insertvalue_elem(I), ", ", insertvalue_idx(I), "\n"]); + #llvm_alloca{} -> + write(Dev, [alloca_dst(I), " = alloca "]), + pp_type(Dev, alloca_type(I)), + case alloca_num(I) of + [] -> ok; + Num -> + write(Dev, ", "), + pp_type(Dev, alloca_type(I)), + write(Dev, [" ", Num, " "]) + end, + case alloca_align(I) of + [] -> ok; + Align -> write(Dev, [",align ", Align]) + end, + write(Dev, "\n"); + #llvm_load{} -> + write(Dev, [load_dst(I), " = "]), + write(Dev, "load "), + case load_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_type(Dev, load_p_type(I)), + write(Dev, [" ", load_pointer(I), " "]), + case load_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case load_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_store{} -> + write(Dev, "store "), + case store_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_type(Dev, store_type(I)), + write(Dev, [" ", store_value(I), ", "]), + pp_type(Dev, store_p_type(I)), + write(Dev, [" ", store_pointer(I), " "]), + case store_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case store_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_getelementptr{} -> + write(Dev, [getelementptr_dst(I), " = getelementptr "]), + case getelementptr_inbounds(I) of + true -> write(Dev, "inbounds "); + false -> ok + end, + pp_type(Dev, getelementptr_p_type(I)), + write(Dev, [" ", getelementptr_value(I)]), + pp_typed_idxs(Dev, getelementptr_typed_idxs(I)), + write(Dev, "\n"); + #llvm_conversion{} -> + write(Dev, [conversion_dst(I), " = ", atom_to_list(conversion_op(I)), " "]), + pp_type(Dev, conversion_src_type(I)), + write(Dev, [" ", conversion_src(I), " to "]), + pp_type(Dev, conversion_dst_type(I)), + write(Dev, "\n"); + #llvm_icmp{} -> + write(Dev, [icmp_dst(I), " = icmp ", atom_to_list(icmp_cond(I)), " "]), + pp_type(Dev, icmp_type(I)), + write(Dev, [" ", icmp_src1(I), ", ", icmp_src2(I), "\n"]); + #llvm_fcmp{} -> + write(Dev, [fcmp_dst(I), " = fcmp ", atom_to_list(fcmp_cond(I)), " "]), + pp_type(Dev, fcmp_type(I)), + write(Dev, [" ", fcmp_src1(I), ", ", fcmp_src2(I), "\n"]); + #llvm_phi{} -> + write(Dev, [phi_dst(I), " = phi "]), + pp_type(Dev, phi_type(I)), + pp_phi_value_labels(Dev, phi_value_label_list(I)), + write(Dev, "\n"); + #llvm_select{} -> + write(Dev, [select_dst(I), " = select i1 ", select_cond(I), ", "]), + pp_type(Dev, select_typ1(I)), + write(Dev, [" ", select_val1(I), ", "]), + pp_type(Dev, select_typ2(I)), + write(Dev, [" ", select_val2(I), "\n"]); + #llvm_call{} -> + case call_dst(I) of + [] -> ok; + Dst -> write(Dev, [Dst, " = "]) + end, + case call_is_tail(I) of + true -> write(Dev, "tail "); + false -> ok + end, + write(Dev, ["call ", call_cconv(I), " "]), + pp_options(Dev, call_ret_attrs(I)), + pp_type(Dev, call_type(I)), + write(Dev, [" ", call_fnptrval(I), "("]), + pp_args(Dev, call_arglist(I)), + write(Dev, ") "), + pp_options(Dev, call_fn_attrs(I)), + write(Dev, "\n"); + #llvm_fun_def{} -> + write(Dev, "define "), + pp_options(Dev, fun_def_linkage(I)), + pp_options(Dev, fun_def_visibility(I)), + case fun_def_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_def_ret_attrs(I)), + write(Dev, " "), + pp_type(Dev, fun_def_type(I)), + write(Dev, [" @", fun_def_name(I), "("]), + pp_args(Dev, fun_def_arglist(I)), + write(Dev, ") "), + pp_options(Dev, fun_def_fn_attrs(I)), + case fun_def_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "{\n"), + pp_ins_list(Dev, fun_def_body(I)), + write(Dev, "}\n"); + #llvm_fun_decl{} -> + write(Dev, "declare "), + pp_options(Dev, fun_decl_linkage(I)), + pp_options(Dev, fun_decl_visibility(I)), + case fun_decl_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_decl_ret_attrs(I)), + pp_type(Dev, fun_decl_type(I)), + write(Dev, [" ", fun_decl_name(I), "("]), + pp_type_list(Dev, fun_decl_arglist(I)), + write(Dev, ") "), + case fun_decl_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "\n"); + #llvm_comment{} -> + write(Dev, ["; ", atom_to_list(comment_text(I)), "\n"]); + #llvm_label{} -> + write(Dev, [label_label(I), ":\n"]); + #llvm_const_decl{} -> + write(Dev, [const_decl_dst(I), " = ", const_decl_decl_type(I), " "]), + pp_type(Dev, const_decl_type(I)), + write(Dev, [" ", const_decl_value(I), "\n"]); + #llvm_landingpad{} -> + write(Dev, "landingpad { i8*, i32 } personality i32 (i32, i64, i8*,i8*)* + @__gcc_personality_v0 cleanup\n"); + #llvm_asm{} -> + write(Dev, [asm_instruction(I), "\n"]); + #llvm_adj_stack{} -> + write(Dev, ["call void asm sideeffect \"sub $0, ", + adj_stack_register(I), "\", \"r\"("]), + pp_type(Dev, adj_stack_type(I)), + write(Dev, [" ", adj_stack_offset(I),")\n"]); + #llvm_branch_meta{} -> + write(Dev, ["!", branch_meta_id(I), " = metadata !{metadata !\"branch_weights\", + i32 ", branch_meta_true_weight(I), ", i32 ", + branch_meta_false_weight(I), "}\n"]); + Other -> + exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}}) + end. + +%% @doc Pretty-print a list of types +pp_type_list(_Dev, []) -> ok; +pp_type_list(Dev, [T]) -> + pp_type(Dev, T); +pp_type_list(Dev, [T|Ts]) -> + pp_type(Dev, T), + write(Dev, ", "), + pp_type_list(Dev, Ts). + +pp_type(Dev, Type) -> + case Type of + #llvm_void{} -> + write(Dev, "void"); + #llvm_label_type{} -> + write(Dev, "label"); + %% Integer + #llvm_int{} -> + write(Dev, ["i", integer_to_list(int_width(Type))]); + %% Float + #llvm_float{} -> + write(Dev, "float"); + #llvm_double{} -> + write(Dev, "double"); + #llvm_fp80{} -> + write(Dev, "x86_fp80"); + #llvm_fp128{} -> + write(Dev, "fp128"); + #llvm_ppc_fp128{} -> + write(Dev, "ppc_fp128"); + %% Pointer + #llvm_pointer{} -> + pp_type(Dev, pointer_type(Type)), + write(Dev, "*"); + %% Function + #llvm_fun{} -> + pp_type(Dev, function_ret_type(Type)), + write(Dev, " ("), + pp_type_list(Dev, function_arg_type_list(Type)), + write(Dev, ")"); + %% Aggregate + #llvm_array{} -> + write(Dev, ["[", integer_to_list(array_size(Type)), " x "]), + pp_type(Dev, array_type(Type)), + write(Dev, "]"); + #llvm_struct{} -> + write(Dev, "{"), + pp_type_list(Dev, struct_type_list(Type)), + write(Dev, "}"); + #llvm_vector{} -> + write(Dev, ["{", integer_to_list(vector_size(Type)), " x "]), + pp_type(Dev, vector_type(Type)), + write(Dev, "}") + end. + +%% @doc Pretty-print a list of typed arguments +pp_args(_Dev, []) -> ok; +pp_args(Dev, [{Type, Arg} | []]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg]); +pp_args(Dev, [{Type, Arg} | Args]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg, ", "]), + pp_args(Dev, Args). + +%% @doc Pretty-print a list of options +pp_options(_Dev, []) -> ok; +pp_options(Dev, [O|Os]) -> + write(Dev, [atom_to_list(O), " "]), + pp_options(Dev, Os). + +%% @doc Pretty-print a list of phi value-labels +pp_phi_value_labels(_Dev, []) -> ok; +pp_phi_value_labels(Dev, [{Value, Label}|[]]) -> + write(Dev, ["[ ", Value, ", ", Label, " ]"]); +pp_phi_value_labels(Dev,[{Value, Label}|VL]) -> + write(Dev, ["[ ", Value, ", ", Label, " ], "]), + pp_phi_value_labels(Dev, VL). + +%% @doc Pretty-print a list of typed indexes +pp_typed_idxs(_Dev, []) -> ok; +pp_typed_idxs(Dev, [{Type, Id} | Tids]) -> + write(Dev, ", "), + pp_type(Dev, Type), + write(Dev, [" ", Id]), + pp_typed_idxs(Dev, Tids). + +%% @doc Pretty-print a switch label list +pp_switch_value_label_list(_Dev, _Type, []) -> ok; +pp_switch_value_label_list(Dev, Type, [{Value, Label} | VLs]) -> + write(Dev, " "), + pp_type(Dev, Type), + write(Dev, [" ", Value, ", label ", Label, "\n"]), + pp_switch_value_label_list(Dev, Type, VLs). + +%%---------------------------------------------------------------------------- +%% Auxiliary Functions +%%---------------------------------------------------------------------------- + +%% @doc Returns if an instruction needs to be intended +indent(I) -> + case I of + #llvm_label{} -> false; + #llvm_fun_def{} -> false; + #llvm_fun_decl{} -> false; + #llvm_const_decl{} -> false; + #llvm_branch_meta{} -> false; + _ -> true + end. + +op_has_options(Op) -> + case Op of + 'and' -> false; + 'or' -> false; + 'xor' -> false; + _ -> true + end. + +%% @doc Abstracts actual writing to file operations +write(Dev, Msg) -> + ok = file:write(Dev, Msg). diff --git a/lib/hipe/llvm/hipe_llvm_arch.hrl b/lib/hipe/llvm/hipe_llvm_arch.hrl new file mode 100644 index 0000000000..689a5a52ea --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_arch.hrl @@ -0,0 +1,11 @@ +-ifdef(BIT32). +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 3). +-define(ARCH_REGISTERS, hipe_x86_registers). +-define(FLOAT_OFFSET, 2). +-else. +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 4). +-define(ARCH_REGISTERS, hipe_amd64_registers). +-define(FLOAT_OFFSET, 6). +-endif. diff --git a/lib/hipe/llvm/hipe_llvm_liveness.erl b/lib/hipe/llvm/hipe_llvm_liveness.erl new file mode 100644 index 0000000000..d1c90ed4c9 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_liveness.erl @@ -0,0 +1,112 @@ +-module(hipe_llvm_liveness). + +-export([analyze/1]). + +%% @doc Find gc roots and explicitly mark when they go out of scope, based +%% on the liveness analyzis performed by the hipe_rtl_liveness:analyze/1. +analyze(RtlCfg) -> + Liveness = hipe_rtl_liveness:analyze(RtlCfg), + Roots = find_roots(RtlCfg, Liveness), + %% erlang:display(Roots), + NewRtlCfg = mark_dead_roots(RtlCfg, Liveness, Roots), + {NewRtlCfg, Roots}. + +%% @doc Determine which are the GC Roots.Possible roots are all +%% RTL variables (rtl_var). However, since safe points are function calls, we +%% consider as possible GC roots only RTL variables that are live around +%% function calls. +find_roots(Cfg, Liveness) -> + Labels = hipe_rtl_cfg:postorder(Cfg), + Roots = find_roots_bb(Labels, Cfg, Liveness, []), + lists:usort(lists:flatten(Roots)). + +find_roots_bb([], _Cfg, _Liveness, RootAcc) -> + RootAcc; +find_roots_bb([L|Ls], Cfg, Liveness, RootAcc) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveIn = ordsets:from_list(strip(hipe_rtl_liveness:livein(Liveness, L))), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + Roots = do_find_roots_bb(BlockCode, L, LiveOut, LiveIn, []), + find_roots_bb(Ls, Cfg, Liveness, Roots++RootAcc). + +%% For each call inside a BB the GC roots are those RTL variables that +%% are live before and after the call. +%% --> Live Before Call: These are the RTL variables that belong to the +%% LiveIn list or are initialized inside the BB before the call +%% --> Live After Call: These are the RTL variables that belong to the +%% LiveOut list or are used after the call inside the BB (they die +%% inside the BB and so do not belong to the LiveOut list) +do_find_roots_bb([], _Label, _LiveOut, _LiveBefore, RootAcc) -> + RootAcc; +do_find_roots_bb([I|Is], L, LiveOut, LiveBefore, RootAcc) -> + case hipe_rtl:is_call(I) of + true -> + %% Used inside the BB after the call + UsedAfterCall_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfterCall = ordsets:from_list(UsedAfterCall_), + LiveAfter = ordsets:union(UsedAfterCall, LiveOut), + %% The Actual Roots + Roots = ordsets:intersection(LiveBefore, LiveAfter), + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, [Roots|RootAcc]); + false -> + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, RootAcc) + end. + +%% @doc This function is responsible for marking when GC Roots, which can be +%% only RTL variables go out of scope (dead). This pass is needed for the LLVM +%% back end because the LLVM framework forces us to explicit mark when gc roots +%% are no longer live. +mark_dead_roots(CFG, Liveness, Roots) -> + Labels = hipe_rtl_cfg:postorder(CFG), + mark_dead_bb(Labels, CFG, Liveness, Roots). + +mark_dead_bb([], Cfg, _Liveness, _Roots) -> + Cfg; +mark_dead_bb([L|Ls], Cfg, Liveness, Roots) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + NewBlockCode = do_mark_dead_bb(BlockCode, LiveOut, Roots, []), + %% Update the CFG + NewBB = hipe_bb:code_update(Block, NewBlockCode), + NewCFG = hipe_rtl_cfg:bb_add(Cfg, L, NewBB), + mark_dead_bb(Ls, NewCFG, Liveness, Roots). + +do_mark_dead_bb([], _LiveOut, _Roots, NewBlockCode) -> + lists:reverse(NewBlockCode); +do_mark_dead_bb([I|Is], LiveOut ,Roots, NewBlockCode) -> + Uses = ordsets:from_list(strip(hipe_rtl:uses(I))), + %% GC roots that are used in this instruction + RootsUsed = ordsets:intersection(Roots, Uses), + UsedAfter_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfter = ordsets:from_list(UsedAfter_), + %% GC roots that are live after this instruction + LiveAfter = ordsets:union(LiveOut, UsedAfter), + %% GC roots that their last use is in this instruction + DeadRoots = ordsets:subtract(RootsUsed, LiveAfter), + %% Recreate the RTL variable from the corresponding Index + OldVars = [hipe_rtl:mk_var(V1) || V1 <- DeadRoots], + %% Mark the RTL variable as DEAD (last use) + NewVars = [kill_var(V2) || V2 <- OldVars], + %% Create a list with the substitution of the old vars with the new + %% ones which are marked with the dead keyword + Subtitution = lists:zip(OldVars, NewVars), + NewI = case Subtitution of + [] -> I; + _ -> hipe_rtl:subst_uses_llvm(Subtitution, I) + end, + do_mark_dead_bb(Is, LiveOut, Roots, [NewI|NewBlockCode]). + +%% Update the liveness of a var,in order to mark that this is the last use. +kill_var(Var) -> hipe_rtl:var_liveness_update(Var, dead). + +%% We are only interested for rtl_vars, since only rtl_vars are possible gc +%% roots. +strip(L) -> [Y || {rtl_var, Y, _} <- L]. diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl new file mode 100644 index 0000000000..0e50c9539b --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -0,0 +1,506 @@ +%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_main). + +-export([rtl_to_native/4]). + +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("hipe_llvm_arch.hrl"). +-include("elf_format.hrl"). + +%% @doc Translation of RTL to a loadable object. This function takes the RTL +%% code and calls hipe_rtl_to_llvm:translate/2 to translate the RTL code to +%% LLVM code. After this, LLVM asm is printed to a file and the LLVM tool +%% chain is invoked in order to produce an object file. +rtl_to_native(MFA, RTL, Roots, Options) -> + %% Compile to LLVM and get Instruction List (along with infos) + {LLVMCode, RelocsDict, ConstTab} = + hipe_rtl_to_llvm:translate(RTL, Roots), + %% Fix function name to an acceptable LLVM identifier (needed for closures) + {_Module, Fun, Arity} = hipe_rtl_to_llvm:fix_mfa_name(MFA), + %% Write LLVM Assembly to intermediate file (on disk) + {ok, Dir, ObjectFile} = + compile_with_llvm(Fun, Arity, LLVMCode, Options, false), + %% + %% Extract information from object file + %% + ObjBin = open_object_file(ObjectFile), + %% Read and set the ELF class + elf_format:set_architecture_flag(ObjBin), + %% Get labels info (for switches and jump tables) + Labels = elf_format:get_rodata_relocs(ObjBin), + {Switches, Closures} = get_tables(ObjBin), + %% Associate Labels with Switches and Closures with stack args + {SwitchInfos, ExposedClosures} = + correlate_labels(Switches ++ Closures, Labels), + %% SwitchInfos: [{"table_50", [Labels]}] + %% ExposedClosures: [{"table_closures", [Labels]}] + + %% Labelmap contains the offsets of the labels in the code that are + %% used for switch's jump tables + LabelMap = create_labelmap(MFA, SwitchInfos, RelocsDict), + %% Get relocation info + TextRelocs = elf_format:get_text_relocs(ObjBin), + %% AccRefs contains the offsets of all references to relocatable symbols in + %% the code: + AccRefs = fix_relocations(TextRelocs, RelocsDict, MFA), + %% Get stack descriptors + SDescs = get_sdescs(ObjBin), + %% FixedSDescs are the stack descriptors after correcting calls that have + %% arguments in the stack + FixedSDescs = + fix_stack_descriptors(RelocsDict, AccRefs, SDescs, ExposedClosures), + Refs = AccRefs ++ FixedSDescs, + %% Get binary code from object file + BinCode = elf_format:extract_text(ObjBin), + %% Remove temp files (if needed) + ok = remove_temp_folder(Dir, Options), + %% Return the code together with information that will be used in the + %% hipe_llvm_merge module to produce the final binary that will be loaded + %% by the hipe unified loader. + {MFA, BinCode, byte_size(BinCode), ConstTab, Refs, LabelMap}. + +%%------------------------------------------------------------------------------ +%% LLVM tool chain +%%------------------------------------------------------------------------------ + +%% @doc Compile function FunName/Arity to LLVM. Return Dir (in order to remove +%% it if we do not want to store temporary files) and ObjectFile name that +%% is created by the LLVM tools. +compile_with_llvm(FunName, Arity, LLVMCode, Options, UseBuffer) -> + Filename = atom_to_list(FunName) ++ "_" ++ integer_to_list(Arity), + %% Save temp files in a unique folder + Dir = unique_folder(FunName, Arity, Options), + ok = file:make_dir(Dir), + %% Print LLVM assembly to file + OpenOpts = [append, raw] ++ + case UseBuffer of + %% true -> [delayed_write]; % Use delayed_write! + false -> [] + end, + {ok, File_llvm} = file:open(Dir ++ Filename ++ ".ll", OpenOpts), + hipe_llvm:pp_ins_list(File_llvm, LLVMCode), + %% delayed_write can cause file:close not to do a close, hence the two calls + ok = file:close(File_llvm), + __ = file:close(File_llvm), + %% Invoke LLVM compiler tools to produce an object file + llvm_opt(Dir, Filename, Options), + llvm_llc(Dir, Filename, Options), + compile(Dir, Filename, "gcc"), %%FIXME: use llc -filetype=obj and skip this! + {ok, Dir, Dir ++ Filename ++ ".o"}. + +%% @doc Invoke opt tool to optimize the bitcode (_name.ll -> _name.bc). +llvm_opt(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".ll", + Dest = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(opt, Options), + OptFlags = [OptLevel, "-mem2reg", "-strip"], + Command = "opt " ++ fix_opts(OptFlags) ++ " " ++ Source ++ " -o " ++ Dest, + %% io:format("OPT: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, opt, Error}) + end. + +%% @doc Invoke llc tool to compile the bitcode to object file +%% (_name.bc -> _name.o). +llvm_llc(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(llc, Options), + Align = find_stack_alignment(), + LlcFlags = [OptLevel, "-code-model=medium", "-stack-alignment=" ++ Align + , "-tailcallopt", "-filetype=asm"], %%FIXME + Command = "llc " ++ fix_opts(LlcFlags) ++ " " ++ Source, + %% io:format("LLC: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, llc, Error}) + end. + +%% @doc Invoke the compiler tool ("gcc", "llvmc", etc.) to generate an object +%% file from native assembly. +compile(Dir, Fun_Name, Compiler) -> + Source = Dir ++ Fun_Name ++ ".s", + Dest = Dir ++ Fun_Name ++ ".o", + Command = Compiler ++ " -c " ++ Source ++ " -o " ++ Dest, + %% io:format("~s: ~s~n", [Compiler, Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, cc, Error}) + end. + +find_stack_alignment() -> + case get(hipe_target_arch) of + x86 -> "4"; + amd64 -> "8"; + _ -> exit({?MODULE, find_stack_alignment, "Unimplemented architecture"}) + end. + +%% @doc Join options. +fix_opts(Opts) -> + string:join(Opts, " "). + +%% @doc Translate optimization-level flag (default is "O2"). +trans_optlev_flag(Tool, Options) -> + Flag = case Tool of + opt -> llvm_opt; + llc -> llvm_llc + end, + case proplists:get_value(Flag, Options) of + o0 -> ""; % "-O0" does not exist in opt tool + o1 -> "-O1"; + o2 -> "-O2"; + o3 -> "-O3"; + undefined -> "-O2" + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Relocations +%%------------------------------------------------------------------------------ + +%% @doc Get switch table and closure table. +get_tables(Elf) -> + %% Search Symbol Table for an entry with name prefixed with "table_": + Triples = elf_format:get_tab_entries(Elf), + Switches = [T || T={"table_" ++ _, _, _} <- Triples], + Closures = [T || T={"table_closures" ++ _, _, _} <- Switches], + {Switches, Closures}. + +%% @doc This function associates symbols who point to some table of labels with +%% the corresponding offsets of the labels in the code. These tables can +%% either be jump tables for switches or a table which contains the labels +%% of blocks that contain closure calls with more than ?NR_ARG_REGS. +correlate_labels([], _L) -> {[], []}; +correlate_labels(Tables, Labels) -> + %% Sort "Tables" based on "ValueOffsets" + OffsetSortedTb = lists:ukeysort(2, Tables), + %% Unzip offset-sorted list of "Switches" + {Names, _Offsets, TablesSizeList} = lists:unzip3(OffsetSortedTb), + %% Associate switch names with labels + L = split_list(Labels, TablesSizeList), + %% Zip back! (to [{SwitchName, Values}]) + NamesValues = lists:zip(Names, L), + case lists:keytake("table_closures", 1, NamesValues) of + false -> %% No closures in the code, no closure table + {NamesValues, []}; + {value, ClosureTableNV, SwitchesNV} -> + {SwitchesNV, ClosureTableNV} + end. + +%% @doc Create a gb_tree which contains information about the labels that used +%% for switch's jump tables. The keys of the gb_tree are of the form +%% {MFA, Label} and the values are the actual Offsets. +create_labelmap(MFA, SwitchInfos, RelocsDict) -> + create_labelmap(MFA, SwitchInfos, RelocsDict, gb_trees:empty()). + +create_labelmap(_, [], _, LabelMap) -> LabelMap; +create_labelmap(MFA, [{Name, Offsets} | Rest], RelocsDict, LabelMap) -> + case dict:fetch(Name, RelocsDict) of + {switch, {_TableType, LabelList, _NrLabels, _SortOrder}, _JTabLab} -> + KVDict = lists:ukeysort(1, lists:zip(LabelList, Offsets)), + NewLabelMap = insert_to_labelmap(KVDict, LabelMap), + create_labelmap(MFA, Rest, RelocsDict, NewLabelMap); + _ -> + exit({?MODULE, create_labelmap, "Not a jump table!"}) + end. + +%% @doc Insert a list of [{Key,Value}] to a LabelMap (gb_tree). +insert_to_labelmap([], LabelMap) -> LabelMap; +insert_to_labelmap([{Key, Value}|Rest], LabelMap) -> + case gb_trees:lookup(Key, LabelMap) of + none -> + insert_to_labelmap(Rest, gb_trees:insert(Key, Value, LabelMap)); + {value, Value} -> %% Exists with the *exact* same Value. + insert_to_labelmap(Rest, LabelMap) + end. + +%% @doc Correlate object file relocation symbols with info from translation to +%% llvm code. +fix_relocations(Relocs, RelocsDict, MFA) -> + fix_relocs(Relocs, RelocsDict, MFA, []). + +fix_relocs([], _, _, RelocAcc) -> RelocAcc; +fix_relocs([{Name, Offset}|Rs], RelocsDict, {ModName,_,_}=MFA, RelocAcc) -> + case dict:fetch(Name, RelocsDict) of + {atom, AtomName} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ATOM, Offset, AtomName}|RelocAcc]); + {constant, Label} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, {constant, Label}}|RelocAcc]); + {switch, _, JTabLab} -> %% Treat switch exactly as constant + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, {constant, JTabLab}}|RelocAcc]); + {closure, _}=Closure -> + fix_relocs(Rs, RelocsDict, MFA, + [{?LOAD_ADDRESS, Offset, Closure}|RelocAcc]); + {call, {bif, BifName, _}} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_LOCAL, Offset, BifName}|RelocAcc]); + %% MFA calls to functions in the same module are of type 3, while all + %% other MFA calls are of type 2. + {call, {ModName,_F,_A}=CallMFA} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_LOCAL, Offset, CallMFA}|RelocAcc]); + {call, CallMFA} -> + fix_relocs(Rs, RelocsDict, MFA, + [{?CALL_REMOTE, Offset, CallMFA}|RelocAcc]); + Other -> + exit({?MODULE, fix_relocs, + {"Relocation not in relocation dictionary", Other}}) + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Stack Descriptors +%%------------------------------------------------------------------------------ + +%% @doc This function takes an ELF Object File binary and returns a proper sdesc +%% list for Erlang/OTP System's loader. The return value should be of the +%% form: +%% { +%% 4, Safepoint Address, +%% {ExnLabel OR [], FrameSize, StackArity, {Liveroot stack frame indexes}}, +%% } +get_sdescs(Elf) -> + case elf_format:extract_note(Elf, ?NOTE_ERLGC_NAME) of + <<>> -> % Object file has no ".note.gc" section! + []; + NoteGC_bin -> + %% Get safe point addresses (stored in ".rela.note.gc" section): + RelaNoteGC = elf_format:extract_rela(Elf, ?NOTE(?NOTE_ERLGC_NAME)), + SPCount = length(RelaNoteGC), + T = SPCount * ?SP_ADDR_SIZE, + %% Pattern match fields of ".note.gc": + <<SPCount:(?bits(?SP_COUNT_SIZE))/integer-little, % Sanity check! + SPAddrs:T/binary, % NOTE: In 64bit they are relocs! + StkFrameSize:(?bits(?SP_STKFRAME_SIZE))/integer-little, + StkArity:(?bits(?SP_STKARITY_SIZE))/integer-little, + _LiveRootCount:(?bits(?SP_LIVEROOTCNT_SIZE))/integer-little, % Skip + Roots/binary>> = NoteGC_bin, + LiveRoots = get_liveroots(Roots, []), + %% Extract information about the safe point addresses: + SPOffs = + case elf_format:is64bit() of + true -> %% Find offsets in ".rela.note.gc": + elf_format:get_rela_addends(RelaNoteGC); + false -> %% Find offsets in SPAddrs (in ".note.gc"): + get_spoffs(SPAddrs, []) + end, + %% Extract Exception Handler labels: + ExnHandlers = elf_format:get_exn_handlers(Elf), + %% Combine ExnHandlers and Safe point addresses (return addresses): + ExnAndSPOffs = combine_ras_and_exns(ExnHandlers, SPOffs, []), + create_sdesc_list(ExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, []) + end. + +%% @doc Extracts a bunch of integers (live roots) from a binary. Returns a tuple +%% as need for stack descriptors. +get_liveroots(<<>>, Acc) -> + list_to_tuple(Acc); +get_liveroots(<<Root:?bits(?LR_STKINDEX_SIZE)/integer-little, + MoreRoots/binary>>, Acc) -> + get_liveroots(MoreRoots, [Root | Acc]). + +%% @doc Extracts a bunch of integers (safepoint offsets) from a binary. Returns +%% a tuple as need for stack descriptors. +get_spoffs(<<>>, Acc) -> + lists:reverse(Acc); +get_spoffs(<<SPOff:?bits(?SP_ADDR_SIZE)/integer-little, More/binary>>, Acc) -> + get_spoffs(More, [SPOff | Acc]). + +combine_ras_and_exns(_, [], Acc) -> + lists:reverse(Acc); +combine_ras_and_exns(ExnHandlers, [RA | MoreRAs], Acc) -> + %% FIXME: do something better than O(n^2) by taking advantage of the property + %% ||ExnHandlers|| <= ||RAs|| + Handler = find_exn_handler(RA, ExnHandlers), + combine_ras_and_exns(ExnHandlers, MoreRAs, [{Handler, RA} | Acc]). + +find_exn_handler(_, []) -> + []; +find_exn_handler(RA, [{Start, End, Handler} | MoreExnHandlers]) -> + case (RA >= Start andalso RA =< End) of + true -> + Handler; + false -> + find_exn_handler(RA, MoreExnHandlers) + end. + +create_sdesc_list([], _, _, _, Acc) -> + lists:reverse(Acc); +create_sdesc_list([{ExnLbl, SPOff} | MoreExnAndSPOffs], + StkFrameSize, StkArity, LiveRoots, Acc) -> + Hdlr = case ExnLbl of + 0 -> []; + N -> N + end, + create_sdesc_list(MoreExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, + [{?SDESC, SPOff, {Hdlr, StkFrameSize, StkArity, LiveRoots}} + | Acc]). + +%% @doc This function is responsible for correcting the stack descriptors of +%% the calls that are found in the code and have more than NR_ARG_REGS +%% (thus, some of their arguments are passed to the stack). Because of the +%% Reserved Call Frame feature that the LLVM uses, the stack descriptors +%% are not correct since at the point of call the frame size is reduced +%% by the number of arguments that are passed on the stack. Also, the +%% offsets of the roots need to be re-adjusted. +fix_stack_descriptors(_, _, [], _) -> + []; +fix_stack_descriptors(RelocsDict, Relocs, SDescs, ExposedClosures) -> + %% NamedCalls are MFA and BIF calls that need fix + NamedCalls = calls_with_stack_args(RelocsDict), + NamedCallsOffs = calls_offsets_arity(Relocs, NamedCalls), + ExposedClosures1 = + case dict:is_key("table_closures", RelocsDict) of + true -> %% A Table with closures exists + {table_closures, ArityList} = dict:fetch("table_closures", RelocsDict), + case ExposedClosures of + {_, Offsets} -> + lists:zip(Offsets, ArityList); + _ -> + exit({?MODULE, fix_stack_descriptors, + {"Wrong exposed closures", ExposedClosures}}) + end; + false -> + [] + end, + ClosuresOffs = closures_offsets_arity(ExposedClosures1, SDescs), + fix_sdescs(NamedCallsOffs ++ ClosuresOffs, SDescs). + +%% @doc This function takes as argument the relocation dictionary as produced by +%% the translation of RTL code to LLVM and finds the names of the calls +%% (MFA and BIF calls) that have more than NR_ARG_REGS. +calls_with_stack_args(Dict) -> + calls_with_stack_args(dict:to_list(Dict), []). + +calls_with_stack_args([], Calls) -> Calls; +calls_with_stack_args([ {_Name, {call, {M, F, A}}} | Rest], Calls) + when A > ?NR_ARG_REGS -> + Call = + case M of + bif -> {F,A}; + _ -> {M,F,A} + end, + calls_with_stack_args(Rest, [Call|Calls]); +calls_with_stack_args([_|Rest], Calls) -> + calls_with_stack_args(Rest, Calls). + +%% @doc This function extracts the stack arity and the offset in the code of +%% the named calls (MFAs, BIFs) that have stack arguments. +calls_offsets_arity(AccRefs, CallsWithStackArgs) -> + calls_offsets_arity(AccRefs, CallsWithStackArgs, []). + +calls_offsets_arity([], _, Acc) -> Acc; +calls_offsets_arity([{Type, Offset, Term} | Rest], CallsWithStackArgs, Acc) + when Type =:= ?CALL_REMOTE orelse Type =:= ?CALL_LOCAL -> + case lists:member(Term, CallsWithStackArgs) of + true -> + Arity = + case Term of + {_M, _F, A} -> A; + {_F, A} -> A + end, + calls_offsets_arity(Rest, CallsWithStackArgs, + [{Offset + 4, Arity - ?NR_ARG_REGS} | Acc]); + false -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc) + end; +calls_offsets_arity([_|Rest], CallsWithStackArgs, Acc) -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc). + +%% @doc This function extracts the stack arity and the offsets of closures that +%% have stack arity. The Closures argument represents the +%% hipe_bifs:llvm_exposure_closure/0 calls in the code. The actual closure +%% is the next call in the code, so the offset of the next call must be +%% calculated from the stack descriptors. +closures_offsets_arity([], _) -> + []; +closures_offsets_arity(ExposedClosures, SDescs) -> + Offsets = [Offset || {_, Offset, _} <- SDescs], + %% Offsets and closures must be sorted in order for find_offsets/3 to work + SortedOffsets = lists:sort(Offsets), + SortedExposedClosures = lists:keysort(1, ExposedClosures), + find_offsets(SortedExposedClosures, SortedOffsets, []). + +find_offsets([], _, Acc) -> Acc; +find_offsets([{Off,Arity}|Rest], Offsets, Acc) -> + [I | RestOffsets] = lists:dropwhile(fun (Y) -> Y<Off end, Offsets), + find_offsets(Rest, RestOffsets, [{I, Arity}|Acc]). + +%% The function below corrects the stack descriptors of calls with arguments +%% that are passed on the stack (more than NR_ARG_REGS) by subtracting the +%% number of stacked arguments from the frame size and from the offset of the +%% roots. +fix_sdescs([], SDescs) -> SDescs; +fix_sdescs([{Offset, Arity} | Rest], SDescs) -> + case lists:keyfind(Offset, 2, SDescs) of + false -> + fix_sdescs(Rest, SDescs); + {?SDESC, Offset, {ExnHandler, FrameSize, StkArity, Roots}} -> + FixedRoots = list_to_tuple([Ri - Arity || Ri <- tuple_to_list(Roots)]), + FixedSDesc = + {?SDESC, Offset, {ExnHandler, FrameSize - Arity, StkArity, FixedRoots}}, + fix_sdescs(Rest, [FixedSDesc | lists:keydelete(Offset, 2, SDescs)]) + end. + +%%------------------------------------------------------------------------------ +%% Miscellaneous functions +%%------------------------------------------------------------------------------ + +%% @doc A function that opens a file as binary. The function takes as argument +%% the name of the file and returns an Erlang binary. +-spec open_object_file(string()) -> binary(). +open_object_file(ObjFile) -> + case file:read_file(ObjFile) of + {ok, Binary} -> + Binary; + {error, Reason} -> + exit({?MODULE, open_file, Reason}) + end. + +remove_temp_folder(Dir, Options) -> + case proplists:get_bool(llvm_save_temps, Options) of + true -> ok; + false -> spawn(fun () -> "" = os:cmd("rm -rf " ++ Dir) end), ok + end. + +unique_id(FunName, Arity) -> + integer_to_list(erlang:phash2({FunName, Arity, now()})). + +unique_folder(FunName, Arity, Options) -> + DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/", + Dir = + case proplists:get_bool(llvm_save_temps, Options) of + true -> %% Store folder in current directory + DirName; + false -> %% Temporarily store folder in tempfs (/dev/shm/) + "/dev/shm/" ++ DirName + end, + %% Make sure it does not exist + case dir_exists(Dir) of + true -> %% Dir already exists! Generate again. + unique_folder(FunName, Arity, Options); + false -> + Dir + end. + +%% @doc Function that checks that a given Filename is an existing Directory +%% Name (from http://rosettacode.org/wiki/Ensure_that_a_file_exists#Erlang) +dir_exists(Filename) -> + {Flag, Info} = file:read_file_info(Filename), + (Flag =:= ok) andalso (element(3, Info) =:= directory). + +%% @doc Function that takes as arguments a list of integers and a list with +%% numbers indicating how many items should each tuple have and splits +%% the original list to a list of lists of integers (with the specified +%% number of elements), i.e. [ [...], [...] ]. +-spec split_list([integer()], [integer()]) -> [ [integer()] ]. +split_list(List, ElemsPerTuple) -> + split_list(List, ElemsPerTuple, []). + +-spec split_list([integer()], [integer()], [ [integer()] ]) -> [ [integer()] ]. +split_list([], [], Acc) -> + lists:reverse(Acc); +split_list(List, [NumOfElems | MoreNums], Acc) -> + {L1, L2} = lists:split(NumOfElems, List), + split_list(L2, MoreNums, [ L1 | Acc]). diff --git a/lib/hipe/llvm/hipe_llvm_merge.erl b/lib/hipe/llvm/hipe_llvm_merge.erl new file mode 100644 index 0000000000..3ababfc21a --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_merge.erl @@ -0,0 +1,114 @@ +%%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_merge). + +-export([finalize/3]). + +-include("hipe_llvm_arch.hrl"). +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("../main/hipe.hrl"). + +finalize(CompiledCode, Closures, Exports) -> + CompiledCode1 = [CodePack || {_, CodePack} <- CompiledCode], + Code = [{MFA, [], ConstTab} + || {MFA, _, _ , ConstTab, _, _} <- CompiledCode1], + {ConstAlign, ConstSize, ConstMap, RefsFromConsts} = + hipe_pack_constants:pack_constants(Code, ?ARCH_REGISTERS:alignment()), + %% Compute total code size separately as a sanity check for alignment + CodeSize = compute_code_size(CompiledCode1, 0), + %% io:format("Code Size (pre-computed): ~w~n", [CodeSize]), + {CodeBinary, ExportMap} = merge_mfas(CompiledCode1, 0, <<>>, []), + %% io:format("Code Size (post-computed): ~w~n", [byte_size(CodeBinary)]), + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + AccRefs = merge_refs(CompiledCode1, ConstMap, 0, []), + %% Bring CompiledCode to a combine_label_maps-acceptable form. + LabelMap = combine_label_maps(CompiledCode1, 0, gb_trees:empty()), + SC = hipe_pack_constants:slim_constmap(ConstMap), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap, Closures, Exports), + SlimRefs = hipe_pack_constants:slim_refs(AccRefs), + term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + ConstAlign, ConstSize, + SC, % ConstMap + DataRelocs, % LabelMap + SSE, % ExportMap + CodeSize, CodeBinary, SlimRefs, + 0,[] % ColdCodeSize, SlimColdRefs + ]). + +%% Copied from hipe_x86_assemble.erl +nr_pad_bytes(Address) -> + (4 - (Address rem 4)) rem 4. % XXX: 16 or 32 instead? + +align_entry(Address) -> + Address + nr_pad_bytes(Address). + +compute_code_size([{_MFA, _BinaryCode, CodeSize, _, _, _}|Code], Size) -> + compute_code_size(Code, align_entry(Size+CodeSize)); +compute_code_size([], Size) -> Size. + +combine_label_maps([{MFA, _, CodeSize, _, _, LabelMap}|Code], Address, CLM) -> + NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM), + combine_label_maps(Code, align_entry(Address+CodeSize), NewCLM); +combine_label_maps([], _Address, CLM) -> CLM. + +merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) -> + NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM), + merge_label_map(Rest, MFA, Address, NewCLM); +merge_label_map([], _MFA, _Address, CLM) -> CLM. + +%% @doc Merge the MFAs' binary code to one continuous binary and compute the +%% size of this binary. At the same time create an exportmap in a form +%% of {Address, M, F, A}. +%% XXX: Is alignment correct/optimal for X86/AMD64? +merge_mfas([{{M,F,A}, CodeBinary, CodeSize, _, _, _}|Code], + Address, AccCode, AccExportMap) -> + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + {Address1, Code1} = + case nr_pad_bytes(Address + CodeSize) of + 0 -> %% Retains alignment: + {Address + CodeSize, CodeBinary}; + NrPadBytes -> %% Needs padding! + Padding = list_to_binary(lists:duplicate(NrPadBytes, 0)), + {Address + CodeSize + NrPadBytes, % =:= align_entry(Address+CodeSize) + <<CodeBinary/binary, Padding/binary>>} + end, + ?VERBOSE_ASSERT(Address1 =:= + align_entry(Address + CodeSize)), %XXX: Should address be aligned? + AccCode1 = <<AccCode/binary, Code1/binary>>, + merge_mfas(Code, Address1, AccCode1, [{Address, M, F, A}|AccExportMap]); +merge_mfas([], _Address, AccCode, AccExportMap) -> + {AccCode, AccExportMap}. + +%% @doc Merge the references of relocatable symbols in the binary code. The +%% offsets must be updated because of the merging of the code binaries! +merge_refs([], _ConstMap, _Addr, AccRefs) -> AccRefs; +merge_refs([{MFA, _, CodeSize, _, Refs, _}|Rest], ConstMap, Address, AccRefs) -> + %% Important!: The hipe_pack_constants:pack_constants/2 function assignes + %% unique numbers to constants (ConstNo). This numbers are used from now on, + %% instead of labels that were used before. So, in order to be compatible, we + %% must change all the constant labels in the Refs to the corresponding + %% ConstNo, that can be found in the ConstMap (#pcm_entry{}). + UpdatedRefs = [update_ref(label_to_constno(Ref, MFA, ConstMap), Address) + || Ref <- Refs], + merge_refs(Rest, ConstMap, align_entry(Address+CodeSize), + UpdatedRefs++AccRefs). + +label_to_constno({Type, Offset, {constant, Label}}, MFA, ConstMap) -> + ConstNo = hipe_pack_constants:find_const({MFA, Label}, ConstMap), + {Type, Offset, {constant, ConstNo}}; +label_to_constno(Other, _MFA, _ConstMap) -> + Other. + +%% @doc Update offset to a reference. In case of stack descriptors we must check +%% if there exists an exception handler, because it must also be updated. +update_ref({?SDESC, Offset, SDesc}, CodeAddr) -> + NewRefAddr = Offset+CodeAddr, + case SDesc of + {[], _, _, _} -> % No handler; only update offset + {?SDESC, NewRefAddr, SDesc}; + {ExnHandler, FrameSize, StackArity, Roots} -> % Update exception handler + {?SDESC, NewRefAddr, {ExnHandler+CodeAddr, FrameSize, StackArity, Roots}} + end; +update_ref({Type, Offset, Term}, CodeAddr) -> + {Type, Offset+CodeAddr, Term}. diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl new file mode 100644 index 0000000000..d7d8d1b049 --- /dev/null +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -0,0 +1,1613 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_rtl_to_llvm). +-author("Chris Stavrakakis, Yiannis Tsiouris"). + +-export([translate/2]). % the main function of this module +-export([fix_mfa_name/1]). % a help function used in hipe_llvm_main + +-include("../rtl/hipe_rtl.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("hipe_llvm_arch.hrl"). + +-define(WORD_WIDTH, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BRANCH_META_TAKEN, "0"). +-define(BRANCH_META_NOT_TAKEN, "1"). + +%%------------------------------------------------------------------------------ +%% @doc Main function for translating an RTL function to LLVM Assembly. Takes as +%% input the RTL code and the variable indexes of possible garbage +%% collection roots and returns the corresponing LLVM, a dictionary with +%% all the relocations in the code and a hipe_consttab() with informaton +%% about data. +%%------------------------------------------------------------------------------ +translate(RTL, Roots) -> + Fun = hipe_rtl:rtl_fun(RTL), + Params = hipe_rtl:rtl_params(RTL), + Data = hipe_rtl:rtl_data(RTL), + Code = hipe_rtl:rtl_code(RTL), + %% Init unique symbol generator and initialize the label counter to the last + %% RTL label. + hipe_gensym:init(llvm), + {_, MaxLabel} = hipe_rtl:rtl_label_range(RTL), + put({llvm,label_count}, MaxLabel + 1), + %% Put first label of RTL code in process dictionary + find_code_entry_label(Code), + %% Initialize relocations symbol dictionary + Relocs = dict:new(), + %% Print RTL to file + %% {ok, File_rtl} = file:open("rtl_" ++integer_to_list(random:uniform(2000)) + %% ++ ".rtl", [write]), + %% hipe_rtl:pp(File_rtl, RTL), + %% file:close(File_rtl), + + %% Pass on RTL code to handle exception handling and identify labels of Fail + %% Blocks + {Code1, FailLabels} = fix_code(Code), + %% Allocate stack slots for each virtual register and declare gc roots + AllocaStackCode = alloca_stack(Code1, Params, Roots), + %% Translate Code + {LLVM_Code1, Relocs1, NewData} = + translate_instr_list(Code1, [], Relocs, Data), + %% Create LLVM code to declare relocation symbols as external symbols along + %% with local variables in order to use them as just any other variable + {FinalRelocs, ExternalDecl, LocalVars} = + handle_relocations(Relocs1, Data, Fun), + %% Pass on LLVM code in order to create Fail blocks and a landingpad + %% instruction to each one + LLVM_Code2 = add_landingpads(LLVM_Code1, FailLabels), + %% Create LLVM Code for the compiled function + LLVM_Code3 = create_function_definition(Fun, Params, LLVM_Code2, + AllocaStackCode ++ LocalVars), + %% Final Code = CompiledFunction + External Declarations + FinalLLVMCode = [LLVM_Code3 | ExternalDecl], + {FinalLLVMCode, FinalRelocs, NewData}. + +find_code_entry_label([]) -> + exit({?MODULE, find_code_entry_label, "Empty code"}); +find_code_entry_label([I|_]) -> + case hipe_rtl:is_label(I) of + true -> + put(first_label, hipe_rtl:label_name(I)); + false -> + exit({?MODULE, find_code_entry_label, "First instruction is not a label"}) + end. + +%% @doc Create a stack slot for each virtual register. The stack slots +%% that correspond to possible garbage collection roots must be +%% marked as such. +alloca_stack(Code, Params, Roots) -> + %% Find all assigned virtual registers + Destinations = collect_destinations(Code), + %% Declare virtual registers, and declare garbage collection roots + do_alloca_stack(Destinations++Params, Params, Roots). + +collect_destinations(Code) -> + lists:usort(lists:flatmap(fun insn_dst/1, Code)). + +do_alloca_stack(Destinations, Params, Roots) -> + do_alloca_stack(Destinations, Params, Roots, []). + +do_alloca_stack([], _, _, Acc) -> + Acc; +do_alloca_stack([D|Ds], Params, Roots, Acc) -> + {Name, _I} = trans_dst(D), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + case hipe_rtl:is_var(D) of + true -> + Num = hipe_rtl:var_index(D), + I1 = hipe_llvm:mk_alloca(Name, WordTy, [], []), + case lists:member(Num, Roots) of + true -> %% Variable is a possible Root + T1 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I2 = + hipe_llvm:mk_conversion(T1, bitcast, WordTyPtr, Name, BYTE_TYPE_PP), + GcRootArgs = [{BYTE_TYPE_PP, T1}, {ByteTyPtr, "@gc_metadata"}], + I3 = hipe_llvm:mk_call([], false, [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", GcRootArgs, []), + I4 = case lists:member(D, Params) of + false -> + hipe_llvm:mk_store(WordTy, "-5", WordTyPtr, Name, + [], [], false); + true -> [] + end, + do_alloca_stack(Ds, Params, Roots, [I1, I2, I3, I4 | Acc]); + false -> + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end; + false -> + case hipe_rtl:is_reg(D) andalso isPrecoloured(D) of + true -> %% Precoloured registers are mapped to "special" stack slots + do_alloca_stack(Ds, Params, Roots, Acc); + false -> + I1 = case hipe_rtl:is_fpreg(D) of + true -> + FloatTy = hipe_llvm:mk_double(), + hipe_llvm:mk_alloca(Name, FloatTy, [], []); + false -> hipe_llvm:mk_alloca(Name, WordTy, [], []) + end, + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end + end. + +%%------------------------------------------------------------------------------ +%% @doc Translation of the linearized RTL Code. Each RTL instruction is +%% translated to a list of LLVM Assembly instructions. The relocation +%% dictionary is updated when needed. +%%------------------------------------------------------------------------------ +translate_instr_list([], Acc, Relocs, Data) -> + {lists:reverse(lists:flatten(Acc)), Relocs, Data}; +translate_instr_list([I | Is], Acc, Relocs, Data) -> + {Acc1, NewRelocs, NewData} = translate_instr(I, Relocs, Data), + translate_instr_list(Is, [Acc1 | Acc], NewRelocs, NewData). + +translate_instr(I, Relocs, Data) -> + case I of + #alu{} -> + {I2, Relocs2} = trans_alu(I, Relocs), + {I2, Relocs2, Data}; + #alub{} -> + {I2, Relocs2} = trans_alub(I, Relocs), + {I2, Relocs2, Data}; + #branch{} -> + {I2, Relocs2} = trans_branch(I, Relocs), + {I2, Relocs2, Data}; + #call{} -> + {I2, Relocs2} = + case hipe_rtl:call_fun(I) of + %% In AMD64 this instruction does nothing! + %% TODO: chech use of fwait in other architectures! + fwait -> + {[], Relocs}; + _ -> + trans_call(I, Relocs) + end, + {I2, Relocs2, Data}; + #comment{} -> + {I2, Relocs2} = trans_comment(I, Relocs), + {I2, Relocs2, Data}; + #enter{} -> + {I2, Relocs2} = trans_enter(I, Relocs), + {I2, Relocs2, Data}; + #fconv{} -> + {I2, Relocs2} = trans_fconv(I, Relocs), + {I2, Relocs2, Data}; + #fload{} -> + {I2, Relocs2} = trans_fload(I, Relocs), + {I2, Relocs2, Data}; + #fmove{} -> + {I2, Relocs2} = trans_fmove(I, Relocs), + {I2, Relocs2, Data}; + #fp{} -> + {I2, Relocs2} = trans_fp(I, Relocs), + {I2, Relocs2, Data}; + #fp_unop{} -> + {I2, Relocs2} = trans_fp_unop(I, Relocs), + {I2, Relocs2, Data}; + #fstore{} -> + {I2, Relocs2} = trans_fstore(I, Relocs), + {I2, Relocs2, Data}; + #goto{} -> + {I2, Relocs2} = trans_goto(I, Relocs), + {I2, Relocs2, Data}; + #label{} -> + {I2, Relocs2} = trans_label(I, Relocs), + {I2, Relocs2, Data}; + #load{} -> + {I2, Relocs2} = trans_load(I, Relocs), + {I2, Relocs2, Data}; + #load_address{} -> + {I2, Relocs2} = trans_load_address(I, Relocs), + {I2, Relocs2, Data}; + #load_atom{} -> + {I2, Relocs2} = trans_load_atom(I, Relocs), + {I2, Relocs2, Data}; + #move{} -> + {I2, Relocs2} = trans_move(I, Relocs), + {I2, Relocs2, Data}; + #return{} -> + {I2, Relocs2} = trans_return(I, Relocs), + {I2, Relocs2, Data}; + #store{} -> + {I2, Relocs2} = trans_store(I, Relocs), + {I2, Relocs2, Data}; + #switch{} -> %% Only switch instruction updates Data + {I2, Relocs2, NewData} = trans_switch(I, Relocs, Data), + {I2, Relocs2, NewData}; + Other -> + exit({?MODULE, translate_instr, {"Unknown RTL instruction", Other}}) + end. + +%% +%% alu +%% +trans_alu(I, Relocs) -> + RtlDst = hipe_rtl:alu_dst(I), + TmpDst = mk_temp(), + {Src1, I1} = trans_src(hipe_rtl:alu_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alu_src2(I)), + Op = trans_op(hipe_rtl:alu_op(I)), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_operation(TmpDst, Op, WordTy, Src1, Src2, []), + I4 = store_stack_dst(TmpDst, RtlDst), + {[I4, I3, I2, I1], Relocs}. + +%% +%% alub +%% +trans_alub(I, Relocs) -> + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= not_overflow -> + trans_alub_overflow(I, signed, Relocs); + ltu -> %% ltu means unsigned overflow + trans_alub_overflow(I, unsigned, Relocs); + _ -> + trans_alub_no_overflow(I, Relocs) + end. + +trans_alub_overflow(I, Sign, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:alub_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alub_src2(I)), + RtlDst = hipe_rtl:alub_dst(I), + TmpDst = mk_temp(), + Name = trans_alub_op(I, Sign), + NewRelocs = relocs_store(Name, {call, {llvm, Name, 2}}, Relocs), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ReturnType = hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), + T1 = mk_temp(), + I3 = hipe_llvm:mk_call(T1, false, [], [], ReturnType, "@" ++ Name, + [{WordTy, Src1}, {WordTy, Src2}], []), + %% T1{0}: result of the operation + I4 = hipe_llvm:mk_extractvalue(TmpDst, ReturnType, T1 , "0", []), + I5 = store_stack_dst(TmpDst, RtlDst), + T2 = mk_temp(), + %% T1{1}: Boolean variable indicating overflow + I6 = hipe_llvm:mk_extractvalue(T2, ReturnType, T1, "1", []), + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= ltu -> + True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + MetaData = branch_metadata(hipe_rtl:alub_pred(I)); + not_overflow -> + True_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + MetaData = branch_metadata(1 - hipe_rtl:alub_pred(I)) + end, + I7 = hipe_llvm:mk_br_cond(T2, True_label, False_label, MetaData), + {[I7, I6, I5, I4, I3, I2, I1], NewRelocs}. + +trans_alub_op(I, Sign) -> + Name = + case Sign of + signed -> + case hipe_rtl:alub_op(I) of + add -> "llvm.sadd.with.overflow."; + mul -> "llvm.smul.with.overflow."; + sub -> "llvm.ssub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end; + unsigned -> + case hipe_rtl:alub_op(I) of + add -> "llvm.uadd.with.overflow."; + mul -> "llvm.umul.with.overflow."; + sub -> "llvm.usub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end + end, + Type = + case hipe_rtl_arch:word_size() of + 4 -> "i32"; + 8 -> "i64" + %% Other -> exit({?MODULE, trans_alub_op, {"Unknown type", Other}}) + end, + Name ++ Type. + +trans_alub_no_overflow(I, Relocs) -> + %% alu + T = hipe_rtl:mk_alu(hipe_rtl:alub_dst(I), hipe_rtl:alub_src1(I), + hipe_rtl:alub_op(I), hipe_rtl:alub_src2(I)), + %% A trans_alu instruction cannot change relocations + {I1, _} = trans_alu(T, Relocs), + %% icmp + %% Translate destination as src, to match with the semantics of instruction + {Dst, I2} = trans_src(hipe_rtl:alub_dst(I)), + Cond = trans_rel_op(hipe_rtl:alub_cond(I)), + T3 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I5 = hipe_llvm:mk_icmp(T3, Cond, WordTy, Dst, "0"), + %% br + Metadata = branch_metadata(hipe_rtl:alub_pred(I)), + True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + I6 = hipe_llvm:mk_br_cond(T3, True_label, False_label, Metadata), + {[I6, I5, I2, I1], Relocs}. + +%% +%% branch +%% +trans_branch(I, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:branch_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:branch_src2(I)), + Cond = trans_rel_op(hipe_rtl:branch_cond(I)), + %% icmp + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_icmp(T1, Cond, WordTy, Src1, Src2), + %% br + True_label = mk_jump_label(hipe_rtl:branch_true_label(I)), + False_label = mk_jump_label(hipe_rtl:branch_false_label(I)), + Metadata = branch_metadata(hipe_rtl:branch_pred(I)), + I4 = hipe_llvm:mk_br_cond(T1, True_label, False_label, Metadata), + {[I4, I3, I2, I1], Relocs}. + +branch_metadata(X) when X =:= 0.5 -> []; +branch_metadata(X) when X > 0.5 -> ?BRANCH_META_TAKEN; +branch_metadata(X) when X < 0.5 -> ?BRANCH_META_NOT_TAKEN. + +%% +%% call +%% +trans_call(I, Relocs) -> + RtlCallArgList= hipe_rtl:call_arglist(I), + RtlCallName = hipe_rtl:call_fun(I), + {I0, Relocs1} = expose_closure(RtlCallName, RtlCallArgList, Relocs), + TmpDst = mk_temp(), + {CallArgs, I1} = trans_call_args(RtlCallArgList), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I3, Relocs2} = + trans_call_name(RtlCallName, Relocs1, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I4 = + case hipe_rtl:call_fail(I) of + %% Normal Call + [] -> + hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, Name, FinalArgs, + []); + %% Call With Exception + FailLabelNum -> + TrueLabel = "L" ++ integer_to_list(hipe_rtl:call_normal(I)), + FailLabel = "%FL" ++ integer_to_list(FailLabelNum), + II1 = + hipe_llvm:mk_invoke(T1, "cc 11", [], FunRetTy, Name, FinalArgs, [], + "%" ++ TrueLabel, FailLabel), + II2 = hipe_llvm:mk_label(TrueLabel), + [II2, II1] + end, + I5 = store_fixed_regs(FixedRegs, T1), + I6 = + case hipe_rtl:call_dstlist(I) of + [] -> []; %% No return value + [Destination] -> + II3 = + hipe_llvm:mk_extractvalue(TmpDst, FunRetTy, T1, + integer_to_list(?NR_PINNED_REGS), []), + II4 = store_stack_dst(TmpDst, Destination), + [II4, II3] + end, + I7 = + case hipe_rtl:call_continuation(I) of + [] -> []; %% No continuation + CC -> + {II5, _} = trans_goto(hipe_rtl:mk_goto(CC), Relocs2), + II5 + end, + {[I7, I6, I5, I4, I3, I2, I1, I0], Relocs2}. + +%% In case of call to a register (closure call) with more than ?NR_ARG_REGS +%% arguments we must track the offset this call in the code, in order to +%% to correct the stack descriptor. So, we insert a new Label and add this label +%% to the "table_closures" +%% --------------------------------|-------------------------------------------- +%% Old Code | New Code +%% --------------------------------|-------------------------------------------- +%% | br %ClosureLabel +%% call %reg(Args) | ClosureLabel: +%% | call %reg(Args) +expose_closure(CallName, CallArgs, Relocs) -> + CallArgsNr = length(CallArgs), + case hipe_rtl:is_reg(CallName) andalso CallArgsNr > ?NR_ARG_REGS of + true -> + LabelNum = hipe_gensym:new_label(llvm), + ClosureLabel = hipe_llvm:mk_label(mk_label(LabelNum)), + JumpIns = hipe_llvm:mk_br(mk_jump_label(LabelNum)), + Relocs1 = + relocs_store({CallName, LabelNum}, + {closure_label, LabelNum, CallArgsNr - ?NR_ARG_REGS}, + Relocs), + {[ClosureLabel, JumpIns], Relocs1}; + false -> + {[], Relocs} + end. + +trans_call_name(RtlCallName, Relocs, CallArgs, FinalArgs) -> + case RtlCallName of + PrimOp when is_atom(PrimOp) -> + LlvmName = trans_prim_op(PrimOp), + Relocs1 = + relocs_store(LlvmName, {call, {bif, PrimOp, length(CallArgs)}}, Relocs), + {"@" ++ LlvmName, [], Relocs1}; + {M, F, A} when is_atom(M), is_atom(F), is_integer(A) -> + LlvmName = trans_mfa_name({M, F, A}), + Relocs1 = + relocs_store(LlvmName, {call, {M, F, length(CallArgs)}}, Relocs), + {"@" ++ LlvmName, [], Relocs1}; + Reg -> + case hipe_rtl:is_reg(Reg) of + true -> + %% In case of a closure call, the register holding the address + %% of the closure must be converted to function type in + %% order to make the call + TT1 = mk_temp(), + {RegName, II1} = trans_src(Reg), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = + hipe_llvm:mk_conversion(TT1, inttoptr, WordTy, RegName, WordTyPtr), + TT2 = mk_temp(), + ArgsTypeList = lists:duplicate(length(FinalArgs), WordTy), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FunType = hipe_llvm:mk_fun(FunRetTy, ArgsTypeList), + FunTypeP = hipe_llvm:mk_pointer(FunType), + II3 = hipe_llvm:mk_conversion(TT2, bitcast, WordTyPtr, TT1, FunTypeP), + {TT2, [II3, II2, II1], Relocs}; + false -> + exit({?MODULE, trans_call, {"Unimplemented call to", RtlCallName}}) + end + end. + +%% +trans_call_args(ArgList) -> + {Args, I} = lists:unzip(trans_args(ArgList)), + %% Reverse arguments that are passed to stack to match with the Erlang + %% calling convention. (Propably not needed in prim calls.) + ReversedArgs = + case erlang:length(Args) > ?NR_ARG_REGS of + false -> + Args; + true -> + {ArgsInRegs, ArgsInStack} = lists:split(?NR_ARG_REGS, Args), + ArgsInRegs ++ lists:reverse(ArgsInStack) + end, + %% Reverse I, because some of the arguments may go out of scope and + %% should be killed(store -5). When two or more arguments are they + %% same, then order matters! + {ReversedArgs, lists:reverse(I)}. + +%% +%% trans_comment +%% +trans_comment(I, Relocs) -> + I1 = hipe_llvm:mk_comment(hipe_rtl:comment_text(I)), + {I1, Relocs}. + +%% +%% enter +%% +trans_enter(I, Relocs) -> + {CallArgs, I0} = trans_call_args(hipe_rtl:enter_arglist(I)), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I1} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I2, NewRelocs} = + trans_call_name(hipe_rtl:enter_fun(I), Relocs, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, true, "cc 11", [], FunRetTy, Name, FinalArgs, []), + I4 = hipe_llvm:mk_ret([{FunRetTy, T1}]), + {[I4, I3, I2, I1, I0], NewRelocs}. + +%% +%% fconv +%% +trans_fconv(I, Relocs) -> + %% XXX: Can a fconv destination be a precoloured reg? + RtlDst = hipe_rtl:fconv_dst(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(hipe_rtl:fconv_src(I)), + FloatTy = hipe_llvm:mk_double(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_conversion(TmpDst, sitofp, WordTy, Src, FloatTy), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. + + +%% TODO: fload, fstore, fmove, and fp are almost the same with load, store, move +%% and alu. Maybe we should join them. + +%% +%% fload +%% +trans_fload(I, Relocs) -> + RtlDst = hipe_rtl:fload_dst(I), + RtlSrc = hipe_rtl:fload_src(I), + _Offset = hipe_rtl:fload_offset(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + {Offset, I2} = trans_float_src(_Offset), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + T2 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, FloatTyPtr), + I5 = hipe_llvm:mk_load(TmpDst, FloatTyPtr, T2, [], [], false), + I6 = store_float_stack(TmpDst, RtlDst), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fmove +%% +trans_fmove(I, Relocs) -> + RtlDst = hipe_rtl:fmove_dst(I), + RtlSrc = hipe_rtl:fmove_src(I), + {Src, I1} = trans_float_src(RtlSrc), + I2 = store_float_stack(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% fp +%% +trans_fp(I, Relocs) -> + %% XXX: Just copied trans_alu...think again.. + RtlDst = hipe_rtl:fp_dst(I), + RtlSrc1 = hipe_rtl:fp_src1(I), + RtlSrc2 = hipe_rtl:fp_src2(I), + %% Destination cannot be a precoloured register + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + TmpDst = mk_temp(), + {Src1, I1} = trans_float_src(RtlSrc1), + {Src2, I2} = trans_float_src(RtlSrc2), + Op = trans_fp_op(hipe_rtl:fp_op(I)), + I3 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, Src1, Src2, []), + I4 = store_float_stack(TmpDst, RtlDst), + %% Synchronization for floating point exceptions + I5 = hipe_llvm:mk_store(FloatTy, TmpDst, FloatTyPtr, "%exception_sync", [], + [], true), + T1 = mk_temp(), + I6 = hipe_llvm:mk_load(T1, FloatTyPtr, "%exception_sync", [], [], true), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fp_unop +%% +trans_fp_unop(I, Relocs) -> + RtlDst = hipe_rtl:fp_unop_dst(I), + RtlSrc = hipe_rtl:fp_unop_src(I), + %% Destination cannot be a precoloured register + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + Op = trans_fp_op(hipe_rtl:fp_unop_op(I)), + FloatTy = hipe_llvm:mk_double(), + I2 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, "0.0", Src, []), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. +%% TODO: Fix fp_unop in a way like the following. You must change trans_dest, +%% in order to call float_to_list in a case of float constant. Maybe the type +%% check is expensive... +%% Dst = hipe_rtl:fp_unop_dst(I), +%% Src = hipe_rtl:fp_unop_src(I), +%% Op = hipe_rtl:fp_unop_op(I), +%% Zero = hipe_rtl:mk_imm(0.0), +%% I1 = hipe_rtl:mk_fp(Dst, Zero, Op, Src), +%% trans_fp(I, Relocs1). + +%% +%% fstore +%% +trans_fstore(I, Relocs) -> + Base = hipe_rtl:fstore_base(I), + case isPrecoloured(Base) of + true -> + trans_fstore_reg(I, Relocs); + false -> + exit({?MODULE, trans_fstore ,{"Not implemented yet", false}}) + end. + +trans_fstore_reg(I, Relocs) -> + {Base, I0} = trans_reg(hipe_rtl:fstore_base(I), dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Base, [], [], false), + {Offset, I2} = trans_src(hipe_rtl:fstore_offset(I)), + T2 = mk_temp(), + I3 = hipe_llvm:mk_operation(T2, add, WordTy, T1, Offset, []), + T3 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T3, inttoptr, WordTy, T2, FloatTyPtr), + {Value, I5} = trans_src(hipe_rtl:fstore_src(I)), + I6 = hipe_llvm:mk_store(FloatTy, Value, FloatTyPtr, T3, [], [], false), + {[I6, I5, I4, I3, I2, I1, I0], Relocs}. + +%% +%% goto +%% +trans_goto(I, Relocs) -> + I1 = hipe_llvm:mk_br(mk_jump_label(hipe_rtl:goto_label(I))), + {I1, Relocs}. + +%% +%% label +%% +trans_label(I, Relocs) -> + Label = mk_label(hipe_rtl:label_name(I)), + I1 = hipe_llvm:mk_label(Label), + {I1, Relocs}. + +%% +%% load +%% +trans_load(I, Relocs) -> + RtlDst = hipe_rtl:load_dst(I), + TmpDst = mk_temp(), + %% XXX: Why translate them independently? ------------------------ + {Src, I1} = trans_src(hipe_rtl:load_src(I)), + {Offset, I2} = trans_src(hipe_rtl:load_offset(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + %%---------------------------------------------------------------- + I4 = case hipe_rtl:load_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_load(TmpDst, WordTyPtr, T2, [], [], false), + [II2, II1]; + Size -> + LoadType = llvm_type_from_size(Size), + LoadTypeP = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypeP), + T3 = mk_temp(), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + II2 = hipe_llvm:mk_load(T3, LoadTypePointer, T2, [], [], false), + Conversion = + case hipe_rtl:load_sign(I) of + signed -> sext; + unsigned -> zext + end, + II3 = + hipe_llvm:mk_conversion(TmpDst, Conversion, LoadType, T3, WordTy), + [II3, II2, II1] + end, + I5 = store_stack_dst(TmpDst, RtlDst), + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% load_address +%% +trans_load_address(I, Relocs) -> + RtlDst = hipe_rtl:load_address_dst(I), + RtlAddr = hipe_rtl:load_address_addr(I), + {Addr, NewRelocs} = + case hipe_rtl:load_address_type(I) of + constant -> + {"%DL" ++ integer_to_list(RtlAddr) ++ "_var", Relocs}; + closure -> + {{_, ClosureName, _}, _, _} = RtlAddr, + FixedClosureName = fix_closure_name(ClosureName), + Relocs1 = relocs_store(FixedClosureName, {closure, RtlAddr}, Relocs), + {"%" ++ FixedClosureName ++ "_var", Relocs1}; + type -> + exit({?MODULE, trans_load_address, + {"Type not implemented in load_address", RtlAddr}}) + end, + I1 = store_stack_dst(Addr, RtlDst), + {[I1], NewRelocs}. + +%% +%% load_atom +%% +trans_load_atom(I, Relocs) -> + RtlDst = hipe_rtl:load_atom_dst(I), + RtlAtom = hipe_rtl:load_atom_atom(I), + AtomName = "atom_" ++ make_llvm_id(atom_to_list(RtlAtom)), + AtomVar = "%" ++ AtomName ++ "_var", + NewRelocs = relocs_store(AtomName, {atom, RtlAtom}, Relocs), + I1 = store_stack_dst(AtomVar, RtlDst), + {[I1], NewRelocs}. + +%% +%% move +%% +trans_move(I, Relocs) -> + RtlDst = hipe_rtl:move_dst(I), + RtlSrc = hipe_rtl:move_src(I), + {Src, I1} = trans_src(RtlSrc), + I2 = store_stack_dst(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% return +%% +trans_return(I, Relocs) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + {VarRet, I1} = + case hipe_rtl:return_varlist(I) of + [] -> + {[], []}; + [A] -> + {Name, II1} = trans_src(A), + {[{WordTy, Name}], II1} + end, + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FixedRet = [{WordTy, X} || X <- LoadedFixedRegs], + Ret = FixedRet ++ VarRet, + {RetTypes, _RetNames} = lists:unzip(Ret), + Type = hipe_llvm:mk_struct(RetTypes), + {RetStruct, I3} = mk_return_struct(Ret, Type), + I4 = hipe_llvm:mk_ret([{Type, RetStruct}]), + {[I4, I3, I2, I1], Relocs}. + +%% @doc Create a structure to hold the return value and the precoloured +%% registers. +mk_return_struct(RetValues, Type) -> + mk_return_struct(RetValues, Type, [], "undef", 0). + +mk_return_struct([], _, Acc, StructName, _) -> + {StructName, Acc}; +mk_return_struct([{ElemType, ElemName}|Rest], Type, Acc, StructName, Index) -> + T1 = mk_temp(), + I1 = hipe_llvm:mk_insertvalue(T1, Type, StructName, ElemType, ElemName, + integer_to_list(Index), []), + mk_return_struct(Rest, Type, [I1 | Acc], T1, Index+1). + +%% +%% store +%% +trans_store(I, Relocs) -> + {Base, I1} = trans_src(hipe_rtl:store_base(I)), + {Offset, I2} = trans_src(hipe_rtl:store_offset(I)), + {Value, I3} = trans_src(hipe_rtl:store_src(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I4 = hipe_llvm:mk_operation(T1, add, WordTy, Base, Offset, []), + I5 = + case hipe_rtl:store_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_store(WordTy, Value, WordTyPtr, T2, [], [], + false), + [II2, II1]; + Size -> + %% XXX: Is always trunc correct ? + LoadType = llvm_type_from_size(Size), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypePointer), + T3 = mk_temp(), + II2 = hipe_llvm:mk_conversion(T3, 'trunc', WordTy, Value, LoadType), + II3 = hipe_llvm:mk_store(LoadType, T3, LoadTypePointer, T2, [], [], false), + [II3, II2, II1] + end, + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% switch +%% +trans_switch(I, Relocs, Data) -> + RtlSrc = hipe_rtl:switch_src(I), + {Src, I1} = trans_src(RtlSrc), + Labels = hipe_rtl:switch_labels(I), + JumpLabels = [mk_jump_label(L) || L <- Labels], + SortOrder = hipe_rtl:switch_sort_order(I), + NrLabels = length(Labels), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + TableTypeP = hipe_llvm:mk_pointer(TableType), + TypedJumpLabels = [{hipe_llvm:mk_label_type(), X} || X <- JumpLabels], + T1 = mk_temp(), + {Src2, []} = trans_dst(RtlSrc), + TableName = "table_" ++ tl(Src2), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_getelementptr(T1, TableTypeP, "@"++TableName, + [{WordTy, "0"}, {WordTy, Src}], false), + T2 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I3 = hipe_llvm:mk_load(T2, BYTE_TYPE_PP, T1, [], [], false), + I4 = hipe_llvm:mk_indirectbr(ByteTyPtr, T2, TypedJumpLabels), + LMap = [{label, L} || L <- Labels], + %% Update data with the info for the jump table + {NewData, JTabLab} = + case hipe_rtl:switch_sort_order(I) of + [] -> + hipe_consttab:insert_block(Data, word, LMap); + SortOrder -> + hipe_consttab:insert_sorted_block(Data, word, LMap, SortOrder) + end, + Relocs2 = relocs_store(TableName, {switch, {TableType, Labels, NrLabels, + SortOrder}, JTabLab}, Relocs), + {[I4, I3, I2, I1], Relocs2, NewData}. + +%% @doc Pass on RTL code in order to fix invoke and closure calls. +fix_code(Code) -> + fix_calls(Code). + +%% @doc Fix invoke calls and closure calls with more than ?NR_ARG_REGS +%% arguments. +fix_calls(Code) -> + fix_calls(Code, [], []). + +fix_calls([], Acc, FailLabels) -> + {lists:reverse(Acc), FailLabels}; +fix_calls([I | Is], Acc, FailLabels) -> + case hipe_rtl:is_call(I) of + true -> + {NewCall, NewFailLabels} = + case hipe_rtl:call_fail(I) of + [] -> + {I, FailLabels}; + FailLabel -> + fix_invoke_call(I, FailLabel, FailLabels) + end, + fix_calls(Is, [NewCall|Acc], NewFailLabels); + false -> + fix_calls(Is, [I|Acc], FailLabels) + end. + +%% @doc When a call has a fail continuation label it must be extended with a +%% normal continuation label to go with the LLVM's invoke instruction. +%% FailLabels is the list of labels of all fail blocks, which are needed to +%% be declared as landing pads. Furtermore, we must add to fail labels a +%% call to hipe_bifs:llvm_fix_pinned_regs/0 in order to avoid reloading old +%% values of pinned registers. This may happen because the result of an +%% invoke instruction is not available at fail-labels, and, thus, we cannot +%% get the correct values of pinned registers. Finally, the stack needs to +%% be re-adjusted when there are stack arguments. +fix_invoke_call(I, FailLabel, FailLabels) -> + NewLabel = hipe_gensym:new_label(llvm), + NewCall1 = hipe_rtl:call_normal_update(I, NewLabel), + SpAdj = find_sp_adj(hipe_rtl:call_arglist(I)), + case lists:keyfind(FailLabel, 1, FailLabels) of + %% Same fail label with same Stack Pointer adjustment + {FailLabel, NewFailLabel, SpAdj} -> + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, FailLabels}; + %% Same fail label but with different Stack Pointer adjustment + {_, _, _} -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]}; + %% New Fail label + false -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]} + end. + +find_sp_adj(ArgList) -> + NrArgs = length(ArgList), + case NrArgs > ?NR_ARG_REGS of + true -> + (NrArgs - ?NR_ARG_REGS) * hipe_rtl_arch:word_size(); + false -> + 0 + end. + +%% @doc Add landingpad instruction in Fail Blocks. +add_landingpads(LLVM_Code, FailLabels) -> + FailLabels2 = [convert_label(T) || T <- FailLabels], + add_landingpads(LLVM_Code, FailLabels2, []). + +add_landingpads([], _, Acc) -> + lists:reverse(Acc); +add_landingpads([I | Is], FailLabels, Acc) -> + case hipe_llvm:is_label(I) of + true -> + Label = hipe_llvm:label_label(I), + Ins = create_fail_blocks(Label, FailLabels), + add_landingpads(Is, FailLabels, [I | Ins] ++ Acc); + false -> + add_landingpads(Is, FailLabels, [I | Acc]) + end. + +convert_label({X,Y,Z}) -> + {"L" ++ integer_to_list(X), "FL" ++ integer_to_list(Y), Z}. + +%% @doc Create a fail block wich. +create_fail_blocks(_, []) -> []; +create_fail_blocks(Label, FailLabels) -> + create_fail_blocks(Label, FailLabels, []). + +create_fail_blocks(Label, FailLabels, Acc) -> + case lists:keytake(Label, 1, FailLabels) of + false -> + Acc; + {value, {Label, FailLabel, SpAdj}, RestFailLabels} -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I1 = hipe_llvm:mk_label(FailLabel), + LP = hipe_llvm:mk_landingpad(), + I2 = + case SpAdj > 0 of + true -> + StackPointer = ?ARCH_REGISTERS:reg_name(?ARCH_REGISTERS:sp()), + hipe_llvm:mk_adj_stack(integer_to_list(SpAdj), StackPointer, + WordTy); + false -> [] + end, + T1 = mk_temp(), + FixedRegs = fixed_registers(), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + I4 = store_fixed_regs(FixedRegs, T1), + I5 = hipe_llvm:mk_br("%" ++ Label), + Ins = lists:flatten([I5, I4, I3, I2, LP,I1]), + create_fail_blocks(Label, RestFailLabels, Ins ++ Acc) + end. + +%%------------------------------------------------------------------------------ +%% Miscellaneous Functions +%%------------------------------------------------------------------------------ + +%% @doc Convert RTL argument list to LLVM argument list. +trans_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + MakeArg = + fun(A) -> + {Name, I1} = trans_src(A), + {{WordTy, Name}, I1} + end, + [MakeArg(A) || A <- ArgList]. + +%% @doc Convert a list of Precoloured registers to LLVM argument list. +fix_reg_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, A} || A <- ArgList]. + +%% @doc Load Precoloured registers. +load_fixed_regs(RegList) -> + Names = [mk_temp_reg(R) || R <- RegList], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun (X, Y) -> + hipe_llvm:mk_load(X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], false) + end, + Ins = lists:zipwith(Fun1, Names, RegList), + {Names, Ins}. + +%% @doc Store Precoloured registers. +store_fixed_regs(RegList, Name) -> + Names = [mk_temp_reg(R) || R <- RegList], + Indexes = lists:seq(0, erlang:length(RegList) - 1), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + Fun1 = + fun(X,Y) -> + hipe_llvm:mk_extractvalue(X, FunRetTy, Name, integer_to_list(Y), []) + end, + I1 = lists:zipwith(Fun1, Names, Indexes), + Fun2 = + fun (X, Y) -> + hipe_llvm:mk_store(WordTy, X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], + false) + end, + I2 = lists:zipwith(Fun2, Names, RegList), + [I2, I1]. + +%%------------------------------------------------------------------------------ +%% Translation of Names +%%------------------------------------------------------------------------------ + +%% @doc Fix F in MFA tuple to acceptable LLVM identifier (case of closure). +-spec fix_mfa_name(mfa()) -> mfa(). +fix_mfa_name({Mod_Name, Closure_Name, Arity}) -> + Fun_Name = list_to_atom(fix_closure_name(Closure_Name)), + {Mod_Name, Fun_Name, Arity}. + +%% @doc Make an acceptable LLVM identifier for a closure name. +fix_closure_name(ClosureName) -> + make_llvm_id(atom_to_list(ClosureName)). + +%% @doc Create an acceptable LLVM identifier. +make_llvm_id(Name) -> + case Name of + "" -> "Empty"; + Other -> lists:flatten([llvm_id(C) || C <- Other]) + end. + +llvm_id(C) when C=:=46; C>47 andalso C<58; C>64 andalso C<91; C=:=95; + C>96 andalso C<123 -> + C; +llvm_id(C) -> + io_lib:format("_~2.16.0B_",[C]). + +%% @doc Create an acceptable LLVM identifier for an MFA. +trans_mfa_name({M,F,A}) -> + N = atom_to_list(M) ++ "." ++ atom_to_list(F) ++ "." ++ integer_to_list(A), + make_llvm_id(N). + +%%------------------------------------------------------------------------------ +%% Creation of Labels and Temporaries +%%------------------------------------------------------------------------------ +mk_label(N) -> + "L" ++ integer_to_list(N). + +mk_jump_label(N) -> + "%L" ++ integer_to_list(N). + +mk_temp() -> + "%t" ++ integer_to_list(hipe_gensym:new_var(llvm)). + +mk_temp_reg(Name) -> + "%" ++ Name ++ integer_to_list(hipe_gensym:new_var(llvm)). + +%%---------------------------------------------------------------------------- +%% Translation of Operands +%%---------------------------------------------------------------------------- + +store_stack_dst(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = hipe_llvm:mk_store(WordTy, TempDst, WordTyPtr, Dst2, [], [], false), + [II2, II1]. + +store_float_stack(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + II2 = hipe_llvm:mk_store(FloatTy, TempDst, FloatTyPtr, Dst2, [], [], false), + [II2, II1]. + +trans_float_src(Src) -> + case hipe_rtl:is_const_label(Src) of + true -> + Name = "@DL" ++ integer_to_list(hipe_rtl:const_label_label(Src)), + T1 = mk_temp(), + %% XXX: Hardcoded offset + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + I1 = hipe_llvm:mk_getelementptr(T1, ByteTyPtr, Name, + [{ByteTy, integer_to_list(?FLOAT_OFFSET)}], true), + T2 = mk_temp(), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + I2 = hipe_llvm:mk_conversion(T2, bitcast, ByteTyPtr, T1, FloatTyPtr), + T3 = mk_temp(), + I3 = hipe_llvm:mk_load(T3, FloatTyPtr, T2, [], [], false), + {T3, [I3, I2, I1]}; + false -> + trans_src(Src) + end. + +trans_src(A) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case hipe_rtl:is_imm(A) of + true -> + Value = integer_to_list(hipe_rtl:imm_value(A)), + {Value, []}; + false -> + case hipe_rtl:is_reg(A) of + true -> + case isPrecoloured(A) of + true -> trans_reg(A, src); + false -> + {Name, []} = trans_reg(A, src), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false), + {T1, [I1]} + end; + false -> + case hipe_rtl:is_var(A) of + true -> + RootName = "%vr" ++ integer_to_list(hipe_rtl:var_index(A)), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, RootName, [], [], false), + I2 = + case hipe_rtl:var_liveness(A) of + live -> + []; + dead -> + NilValue = hipe_tagscheme:mk_nil(), + hipe_llvm:mk_store(WordTy, integer_to_list(NilValue), WordTyPtr, RootName, + [], [], false) + end, + {T1, [I2, I1]}; + false -> + case hipe_rtl:is_fpreg(A) of + true -> + {Name, []} = trans_dst(A), + T1 = mk_temp(), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I1 = hipe_llvm:mk_load(T1, FloatTyPtr, Name, [], [], false), + {T1, [I1]}; + false -> trans_dst(A) + end + end + end + end. + +trans_dst(A) -> + case hipe_rtl:is_reg(A) of + true -> + trans_reg(A, dst); + false -> + Name = case hipe_rtl:is_var(A) of + true -> + "%vr" ++ integer_to_list(hipe_rtl:var_index(A)); + false -> + case hipe_rtl:is_fpreg(A) of + true -> "%fr" ++ integer_to_list(hipe_rtl:fpreg_index(A)); + false -> + case hipe_rtl:is_const_label(A) of + true -> + "%DL" ++ integer_to_list(hipe_rtl:const_label_label(A)) ++ "_var"; + false -> + exit({?MODULE, trans_dst, {"Bad RTL argument",A}}) + end + end + end, + {Name, []} + end. + +%% @doc Translate a register. If it is precoloured it must be mapped to the +%% correct stack slot that holds the precoloured register value. +trans_reg(Arg, Position) -> + Index = hipe_rtl:reg_index(Arg), + case isPrecoloured(Arg) of + true -> + Name = map_precoloured_reg(Index), + case Position of + src -> fix_reg_src(Name); + dst -> fix_reg_dst(Name) + end; + false -> + {hipe_rtl_arch:reg_name(Index), []} + end. + +map_precoloured_reg(Index) -> + case hipe_rtl_arch:reg_name(Index) of + "%r15" -> "%hp_reg_var"; + "%rbp" -> "%p_reg_var"; + "%esi" -> "%hp_reg_var"; + "%ebp" -> "%p_reg_var"; + "%fcalls" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:fcalls())}; + "%hplim" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:heap_limit())}; + _ -> + exit({?MODULE, map_precoloured_reg, {"Register not mapped yet", Index}}) + end. + +%% @doc Load precoloured dst register. +fix_reg_dst(Register) -> + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + pointer_from_reg(Name, WordTy, Offset); + Name -> %% Case of %p and %hp + {Name, []} + end. + +%% @doc Load precoloured src register. +fix_reg_src(Register) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + {T1, I1} = pointer_from_reg(Name, WordTy, Offset), + T2 = mk_temp(), + I2 = hipe_llvm:mk_load(T2, WordTyPtr, T1, [], [] , false), + {T2, [I2, I1]}; + Name -> %% Case of %p and %hp + T1 = mk_temp(), + {T1, hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false)} + end. + +%% @doc Load %fcalls and %hplim. +pointer_from_reg(RegName, Type, Offset) -> + PointerType = hipe_llvm:mk_pointer(Type), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, PointerType, RegName, [], [] ,false), + T2 = mk_temp(), + I2 = hipe_llvm:mk_conversion(T2, inttoptr, Type, T1, PointerType), + T3 = mk_temp(), + %% XXX: Offsets should be a power of 2. + I3 = hipe_llvm:mk_getelementptr(T3, PointerType, T2, + [{Type, integer_to_list(Offset div hipe_rtl_arch:word_size())}], true), + {T3, [I3, I2, I1]}. + +isPrecoloured(X) -> + hipe_rtl_arch:is_precoloured(X). + +%%------------------------------------------------------------------------------ +%% Translation of operators +%%------------------------------------------------------------------------------ + +trans_op(Op) -> + case Op of + add -> add; + sub -> sub; + 'or' -> 'or'; + 'and' -> 'and'; + 'xor' -> 'xor'; + sll -> shl; + srl -> lshr; + sra -> ashr; + mul -> mul; + 'fdiv' -> fdiv; + 'sdiv' -> sdiv; + 'srem' -> srem; + Other -> exit({?MODULE, trans_op, {"Unknown RTL operator", Other}}) + end. + +trans_rel_op(Op) -> + case Op of + eq -> eq; + ne -> ne; + gtu -> ugt; + geu -> uge; + ltu -> ult; + leu -> ule; + gt -> sgt; + ge -> sge; + lt -> slt; + le -> sle + end. + +trans_prim_op(Op) -> + case Op of + '+' -> "bif_add"; + '-' -> "bif_sub"; + '*' -> "bif_mul"; + 'div' -> "bif_div"; + '/' -> "bif_div"; + Other -> atom_to_list(Other) + end. + +trans_fp_op(Op) -> + case Op of + fadd -> fadd; + fsub -> fsub; + fdiv -> fdiv; + fmul -> fmul; + fchs -> fsub; + Other -> exit({?MODULE, trans_fp_op, {"Unknown RTL float operator",Other}}) + end. + +%% Misc. +insn_dst(I) -> + case I of + #alu{} -> + [hipe_rtl:alu_dst(I)]; + #alub{} -> + [hipe_rtl:alub_dst(I)]; + #call{} -> + case hipe_rtl:call_dstlist(I) of + [] -> []; + [Dst] -> [Dst] + end; + #load{} -> + [hipe_rtl:load_dst(I)]; + #load_address{} -> + [hipe_rtl:load_address_dst(I)]; + #load_atom{} -> + [hipe_rtl:load_atom_dst(I)]; + #move{} -> + [hipe_rtl:move_dst(I)]; + #phi{} -> + [hipe_rtl:phi_dst(I)]; + #fconv{} -> + [hipe_rtl:fconv_dst(I)]; + #fload{} -> + [hipe_rtl:fload_dst(I)]; + #fmove{} -> + [hipe_rtl:fmove_dst(I)]; + #fp{} -> + [hipe_rtl:fp_dst(I)]; + #fp_unop{} -> + [hipe_rtl:fp_unop_dst(I)]; + _ -> + [] + end. + +llvm_type_from_size(Size) -> + case Size of + byte -> hipe_llvm:mk_int(8); + int16 -> hipe_llvm:mk_int(16); + int32 -> hipe_llvm:mk_int(32); + word -> hipe_llvm:mk_int(64) + end. + +%% @doc Create definition for the compiled function. The parameters that are +%% passed to the stack must be reversed to match with the CC. Also +%% precoloured registers that are passed as arguments must be stored to +%% the corresonding stack slots. +create_function_definition(Fun, Params, Code, LocalVars) -> + FunctionName = trans_mfa_name(Fun), + FixedRegs = fixed_registers(), + %% Reverse parameters to match with the Erlang calling convention + ReversedParams = + case erlang:length(Params) > ?NR_ARG_REGS of + false -> + Params; + true -> + {ParamsInRegs, ParamsInStack} = lists:split(?NR_ARG_REGS, Params), + ParamsInRegs ++ lists:reverse(ParamsInStack) + end, + Args = header_regs(FixedRegs) ++ header_params(ReversedParams), + EntryLabel = hipe_llvm:mk_label("Entry"), + FloatTy = hipe_llvm:mk_double(), + ExceptionSync = hipe_llvm:mk_alloca("%exception_sync", FloatTy, [], []), + I2 = load_regs(FixedRegs), + I3 = hipe_llvm:mk_br(mk_jump_label(get(first_label))), + StoredParams = store_params(Params), + EntryBlock = + lists:flatten([EntryLabel, ExceptionSync, I2, LocalVars, StoredParams, I3]), + Final_Code = EntryBlock ++ Code, + FunctionOptions = [nounwind, noredzone, list_to_atom("gc \"erlang\"")], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + hipe_llvm:mk_fun_def([], [], "cc 11", [], FunRetTy, FunctionName, Args, + FunctionOptions, [], Final_Code). + +header_params(Params) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%v" ++ integer_to_list(hipe_rtl:var_index(P))} || P <- Params]. + +store_params(Params) -> + Fun1 = + fun(X) -> + Index = hipe_rtl:var_index(X), + {Name, _} = trans_dst(X), + ParamName = "%v" ++ integer_to_list(Index), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_store(WordTy, ParamName, WordTyPtr, Name, [], [], false) + end, + lists:map(Fun1, Params). + +fixed_registers() -> + case get(hipe_target_arch) of + x86 -> + ["hp", "p"]; + amd64 -> + ["hp", "p"]; + Other -> + exit({?MODULE, map_registers, {"Unknown architecture", Other}}) + end. + +header_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%" ++ X ++ "_in"} || X <- Registers]. + +load_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun(X) -> + I1 = hipe_llvm:mk_alloca("%" ++ X ++ "_reg_var", WordTy, [], []), + I2 = hipe_llvm:mk_store(WordTy, "%" ++ X ++ "_in", WordTyPtr, + "%" ++ X ++ "_reg_var", [], [], false), + [I1, I2] + end, + lists:map(Fun1, Registers). + +%%------------------------------------------------------------------------------ +%% Relocation-specific Stuff +%%------------------------------------------------------------------------------ + +relocs_store(Key, Value, Relocs) -> + dict:store(Key, Value, Relocs). + +relocs_to_list(Relocs) -> + dict:to_list(Relocs). + +%% @doc This function is responsible for the actions needed to handle +%% relocations: +%% 1) Updates relocations with constants and switch jump tables. +%% 2) Creates LLVM code to declare relocations as external +%% functions/constants. +%% 3) Creates LLVM code in order to create local variables for the external +%% constants/labels. +handle_relocations(Relocs, Data, Fun) -> + RelocsList = relocs_to_list(Relocs), + %% Seperate Relocations according to their type + {CallList, AtomList, ClosureList, ClosureLabels, SwitchList} = + seperate_relocs(RelocsList), + %% Create code to declare atoms + AtomDecl = [declare_atom(A) || A <- AtomList], + %% Create code to create local name for atoms + AtomLoad = [load_atom(A) || A <- AtomList], + %% Create code to declare closures + ClosureDecl = [declare_closure(C) || C <- ClosureList], + %% Create code to create local name for closures + ClosureLoad = [load_closure(C) || C <- ClosureList], + %% Find function calls + IsExternalCall = fun (X) -> is_external_call(X, Fun) end, + ExternalCallList = lists:filter(IsExternalCall, CallList), + %% Create code to declare external function + FunDecl = fixed_fun_decl() ++ [call_to_decl(C) || C <- ExternalCallList], + %% Extract constant labels from Constant Map (remove duplicates) + ConstLabels = hipe_consttab:labels(Data), + %% Create code to declare constants + ConstDecl = [declare_constant(C) || C <- ConstLabels], + %% Create code to create local name for constants + ConstLoad = [load_constant(C) || C <- ConstLabels], + %% Create code to create jump tables + SwitchDecl = declare_switches(SwitchList, Fun), + %% Create code to create a table with the labels of all closure calls + {ClosureLabelDecl, Relocs1} = + declare_closure_labels(ClosureLabels, Relocs, Fun), + %% Enter constants to relocations + Relocs2 = lists:foldl(fun const_to_dict/2, Relocs1, ConstLabels), + %% Temporary Store inc_stack and llvm_fix_pinned_regs to Dictionary + %% TODO: Remove this + Relocs3 = dict:store("inc_stack_0", {call, {bif, inc_stack_0, 0}}, Relocs2), + Relocs4 = dict:store("hipe_bifs.llvm_fix_pinned_regs.0", + {call, {hipe_bifs, llvm_fix_pinned_regs, 0}}, Relocs3), + BranchMetaData = [ + hipe_llvm:mk_branch_meta(?BRANCH_META_TAKEN, "99", "1") + , hipe_llvm:mk_branch_meta(?BRANCH_META_NOT_TAKEN, "1", "99") + ], + ExternalDeclarations = AtomDecl ++ ClosureDecl ++ ConstDecl ++ FunDecl ++ + ClosureLabelDecl ++ SwitchDecl ++ BranchMetaData, + LocalVariables = AtomLoad ++ ClosureLoad ++ ConstLoad, + {Relocs4, ExternalDeclarations, LocalVariables}. + +%% @doc Seperate relocations according to their type. +seperate_relocs(Relocs) -> + seperate_relocs(Relocs, [], [], [], [], []). + +seperate_relocs([], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + {CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc}; +seperate_relocs([R|Rs], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + case R of + {_, {call, _}} -> + seperate_relocs(Rs, [R | CallAcc], AtomAcc, ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {atom, _}} -> + seperate_relocs(Rs, CallAcc, [R | AtomAcc], ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {closure, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, [R | ClosureAcc], LabelAcc, + JmpTableAcc); + {_, {switch, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, LabelAcc, + [R | JmpTableAcc]); + {_, {closure_label, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, [R | LabelAcc], + JmpTableAcc) + end. + +%% @doc External declaration of an atom. +declare_atom({AtomName, _}) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", WordTy, ""). + +%% @doc Creation of local variable for an atom. +load_atom({AtomName, _}) -> + Dst = "%" ++ AtomName ++ "_var", + Name = "@" ++ AtomName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_conversion(Dst, ptrtoint, WordTyPtr, Name, WordTy). + +%% @doc External declaration of a closure. +declare_closure({ClosureName, _})-> + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl("@" ++ ClosureName, "external constant", ByteTy, ""). + +%% @doc Creation of local variable for a closure. +load_closure({ClosureName, _})-> + Dst = "%" ++ ClosureName ++ "_var", + Name = "@" ++ ClosureName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Declaration of a local variable for a switch jump table. +declare_switches(JumpTableList, Fun) -> + FunName = trans_mfa_name(Fun), + [declare_switch_table(X, FunName) || X <- JumpTableList]. + +declare_switch_table({Name, {switch, {TableType, Labels, _, _}, _}}, FunName) -> + LabelList = [mk_jump_label(L) || L <- Labels], + Fun1 = fun(X) -> "i8* blockaddress(@" ++ FunName ++ ", " ++ X ++ ")" end, + List2 = lists:map(Fun1, LabelList), + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + hipe_llvm:mk_const_decl("@" ++ Name, "constant", TableType, List4). + +%% @doc Declaration of a variable for a table with the labels of all closure +%% calls in the code. +declare_closure_labels([], Relocs, _Fun) -> + {[], Relocs}; +declare_closure_labels(ClosureLabels, Relocs, Fun) -> + FunName = trans_mfa_name(Fun), + {LabelList, ArityList} = + lists:unzip([{mk_jump_label(Label), A} || + {_, {closure_label, Label, A}} <- ClosureLabels]), + Relocs1 = relocs_store("table_closures", {table_closures, ArityList}, Relocs), + List2 = + ["i8* blockaddress(@" ++ FunName ++ ", " ++ L ++ ")" || L <- LabelList], + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + NrLabels = length(LabelList), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + ConstDecl = + hipe_llvm:mk_const_decl("@table_closures", "constant", TableType, List4), + {[ConstDecl], Relocs1}. + +%% @doc A call is treated as non external only in a case of a recursive +%% function. +is_external_call({_, {call, Fun}}, Fun) -> false; +is_external_call(_, _) -> true. + +%% @doc External declaration of a function. +call_to_decl({Name, {call, MFA}}) -> + {M, _F, A} = MFA, + CConv = "cc 11", + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + {Type, Args} = + case M of + llvm -> + {hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), [1, 2]}; + %% +precoloured regs + _ -> + {FunRetTy, lists:seq(1, A + ?NR_PINNED_REGS)} + end, + ArgsTypes = lists:duplicate(length(Args), WordTy), + hipe_llvm:mk_fun_decl([], [], CConv, [], Type, "@" ++ Name, ArgsTypes, []). + +%% @doc These functions are always declared, even if not used. +fixed_fun_decl() -> + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + LandPad = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_int(32), + "@__gcc_personality_v0", [hipe_llvm:mk_int(32), hipe_llvm:mk_int(64), + ByteTyPtr, ByteTyPtr], []), + GCROOTDecl = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", [hipe_llvm:mk_pointer(ByteTyPtr), ByteTyPtr], []), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FixPinnedRegs = hipe_llvm:mk_fun_decl([], [], [], [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + GcMetadata = hipe_llvm:mk_const_decl("@gc_metadata", "external constant", + ByteTy, ""), + [LandPad, GCROOTDecl, FixPinnedRegs, GcMetadata]. + +%% @doc Declare an External Consant. We declare all constants as i8 in order to +%% be able to calcucate pointers of the form DL+6, with the getelementptr +%% instruction. Otherwise we have to convert constants form pointers to +%% values, add the offset and convert them again to pointers. +declare_constant(Label) -> + Name = "@DL" ++ integer_to_list(Label), + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl(Name, "external constant", ByteTy, ""). + +%% @doc Load a constant is achieved by converting a pointer to an integer of +%% the correct width. +load_constant(Label) -> + Dst = "%DL" ++ integer_to_list(Label) ++ "_var", + Name = "@DL" ++ integer_to_list(Label), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Store external constants and calls to dictionary. +const_to_dict(Elem, Dict) -> + Name = "DL" ++ integer_to_list(Elem), + dict:store(Name, {'constant', Elem}, Dict). diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index bcdfcb0e03..e81212d4dc 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -30,6 +30,7 @@ cerl_prettypr, cerl_to_icode, cerl_typean, + elf_format, erl_bif_types, erl_types, hipe, @@ -108,6 +109,10 @@ hipe_ig, hipe_ig_moves, hipe_jit, + hipe_llvm, + hipe_llvm_liveness, + hipe_llvm_main, + hipe_llvm_merge, hipe_ls_regalloc, hipe_main, hipe_moves, @@ -159,6 +164,7 @@ hipe_rtl_symbolic, hipe_rtl_to_amd64, hipe_rtl_to_arm, + hipe_rtl_to_llvm, hipe_rtl_to_ppc, hipe_rtl_to_sparc, hipe_rtl_to_x86, @@ -216,4 +222,6 @@ hipe_x86_x87]}, {registered,[]}, {applications, [kernel,stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.0","kernel-3.0", + "erts-6.0","compiler-5.0"]}]}. diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 434d5c3061..539ce883c0 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -200,6 +200,7 @@ compile_core/4, file/1, file/2, + llvm_support_available/0, load/1, help/0, help_hiper/0, @@ -648,7 +649,18 @@ run_compiler_1(DisasmFun, IcodeFun, Options) -> %% The full option expansion is not done %% until the DisasmFun returns. {Code, CompOpts} = DisasmFun(Options), - Opts = expand_options(Options ++ CompOpts), + Opts0 = expand_options(Options ++ CompOpts), + Opts = + case proplists:get_bool(to_llvm, Opts0) andalso + not llvm_support_available() of + true -> + ?error_msg("No LLVM version 3.4 or greater " + "found in $PATH; aborting " + "native code compilation.\n", []), + ?EXIT(cant_find_required_llvm_version); + false -> + Opts0 + end, check_options(Opts), ?when_option(verbose, Options, ?debug_msg("Options: ~p.\n",[Opts])), @@ -821,7 +833,9 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) -> ?debug_msg("Compiled ~w in ~.2f s\n", [MFA,(T2-T1)/1000])), {MFA, Code}; {rtl, LinearRtl} -> - {MFA, LinearRtl} + {MFA, LinearRtl}; + {llvm_binary, Binary} -> + {MFA, Binary} catch error:Error -> ?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])), @@ -890,21 +904,27 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); end. assemble(CompiledCode, Closures, Exports, Options) -> - case get(hipe_target_arch) of - ultrasparc -> - hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); - powerpc -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - ppc64 -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - arm -> - hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); - x86 -> - hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); - amd64 -> - hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); - Arch -> - ?EXIT({executing_on_an_unsupported_architecture, Arch}) + case proplists:get_bool(to_llvm, Options) of + false -> + case get(hipe_target_arch) of + ultrasparc -> + hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); + powerpc -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + ppc64 -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + arm -> + hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); + x86 -> + hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); + amd64 -> + hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); + Arch -> + ?EXIT({executing_on_an_unsupported_architecture, Arch}) + end; + true -> + %% Merge already compiled code (per MFA) to a single binary. + hipe_llvm_merge:finalize(CompiledCode, Closures, Exports) end. %% -------------------------------------------------------------------- @@ -1330,6 +1350,11 @@ opt_keys() -> timeregalloc, timers, to_rtl, + to_llvm, % Use the LLVM backend for compilation. + llvm_save_temps, % Save the LLVM intermediate files in the current + % directory; useful for debugging. + llvm_llc, % Specify llc optimization-level: o1, o2, o3, undefined. + llvm_opt, % Specify opt optimization-level: o1, o2, o3, undefined. use_indexing, use_inline_atom_search, use_callgraph, @@ -1468,11 +1493,19 @@ opt_expansions() -> [{o1, o1_opts()}, {o2, o2_opts()}, {o3, o3_opts()}, + {to_llvm, llvm_opts(o3)}, + {{to_llvm, o0}, llvm_opts(o0)}, + {{to_llvm, o1}, llvm_opts(o1)}, + {{to_llvm, o2}, llvm_opts(o2)}, + {{to_llvm, o3}, llvm_opts(o3)}, {x87, [x87, inline_fp]}, {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86 x86 -> [x87, inline_fp]; %% has sse2 _ -> [inline_fp] end}]. +llvm_opts(O) -> + [to_llvm, {llvm_opt, O}, {llvm_llc, O}]. + %% This expands "basic" options, which may be tested early and cannot be %% in conflict with options found in the source code. @@ -1516,4 +1549,22 @@ check_options(Opts) -> ok end. +-spec llvm_support_available() -> boolean(). + +llvm_support_available() -> + get_llvm_version() >= 3.4. + +get_llvm_version() -> + OptStr = os:cmd("opt -version"), + SubStr = "LLVM version ", N = length(SubStr), + case string:str(OptStr, SubStr) of + 0 -> % No opt available + 0.0; + S -> + case string:to_float(string:sub_string(OptStr, S + N)) of + {error, _} -> 0.0; %XXX: Assumes no revision numbers in versioning + {Float, _} -> Float + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index 99028cc3c1..89b79998be 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -49,7 +49,7 @@ %%===================================================================== -type comp_icode_ret() :: {'native',hipe_architecture(),{'unprofiled',_}} - | {'rtl',tuple()}. + | {'rtl',tuple()} | {'llvm_binary',term()}. %%===================================================================== @@ -115,11 +115,18 @@ compile_icode(MFA, LinearIcode0, Options, Servers, DebugState) -> pp(IcodeCfg7, MFA, icode_liveness, pp_icode_liveness, Options, Servers), FinalIcode = hipe_icode_cfg:cfg_to_linear(IcodeCfg7), ?opt_stop_timer("Icode"), - LinearRTL = ?option_time(icode_to_rtl(MFA,FinalIcode,Options, Servers), - "RTL", Options), + {LinearRTL, Roots} = ?option_time(icode_to_rtl(MFA, FinalIcode, Options, Servers), + "RTL", Options), case proplists:get_bool(to_rtl, Options) of false -> - rtl_to_native(MFA, LinearRTL, Options, DebugState); + case proplists:get_bool(to_llvm, Options) of + false -> + rtl_to_native(MFA, LinearRTL, Options, DebugState); + true -> + %% The LLVM backend returns binary code, unlike the rest of the HiPE + %% backends which return native assembly. + rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) + end; true -> put(hipe_debug, DebugState), {rtl, LinearRTL} @@ -385,11 +392,21 @@ icode_to_rtl(MFA, Icode, Options, Servers) -> %% hipe_rtl_cfg:pp(RtlCfg3), pp(RtlCfg3, MFA, rtl_liveness, pp_rtl_liveness, Options, Servers), RtlCfg4 = rtl_lcm(RtlCfg3, Options), - pp(RtlCfg4, MFA, rtl, pp_rtl, Options, Servers), - LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg4), + %% LLVM: A liveness analysis on RTL must be performed in order to find the GC + %% roots and explicitly mark them (in RTL) when they go out of scope (only + %% when the LLVM backend is used). + {RtlCfg5, Roots} = + case proplists:get_bool(to_llvm, Options) of + false -> + {RtlCfg4, []}; + true -> + hipe_llvm_liveness:analyze(RtlCfg4) + end, + pp(RtlCfg5, MFA, rtl, pp_rtl, Options, Servers), + LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg5), LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1), %% hipe_rtl:pp(standard_io, LinearRTL2), - LinearRTL2. + {LinearRTL2, Roots}. translate_to_rtl(Icode, Options) -> %% GC tests should have been added in the conversion to Icode. @@ -540,6 +557,17 @@ rtl_to_native(MFA, LinearRTL, Options, DebugState) -> put(hipe_debug, DebugState), LinearNativeCode. +%% Translate Linear RTL to binary code using LLVM. +rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) -> + ?opt_start_timer("LLVM native code"), + %% BinaryCode is a tuple, as defined in llvm/hipe_llvm_main module, which + %% contains the binary code together with info needed by the loader, e.g. + %% ConstTab, Refs, LabelMap, etc. + BinaryCode = hipe_llvm_main:rtl_to_native(MFA, LinearRTL, Roots, Options), + ?opt_stop_timer("LLVM native code"), + put(hipe_debug, DebugState), + {llvm_binary, BinaryCode}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Debugging stuff ... %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/misc/hipe_gensym.erl b/lib/hipe/misc/hipe_gensym.erl index 84fc8fa7e8..4d2a237188 100644 --- a/lib/hipe/misc/hipe_gensym.erl +++ b/lib/hipe/misc/hipe_gensym.erl @@ -44,7 +44,7 @@ %% Types of allowable entities to set global variables for %%----------------------------------------------------------------------- --type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86'. +-type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86' | 'llvm'. %%----------------------------------------------------------------------- diff --git a/lib/hipe/misc/hipe_pack_constants.erl b/lib/hipe/misc/hipe_pack_constants.erl index ca8a9e6bf7..300f9ae43a 100644 --- a/lib/hipe/misc/hipe_pack_constants.erl +++ b/lib/hipe/misc/hipe_pack_constants.erl @@ -20,30 +20,48 @@ %% -module(hipe_pack_constants). --export([pack_constants/2, slim_refs/1, slim_constmap/1]). +-export([pack_constants/2, slim_refs/1, slim_constmap/1, + find_const/2, mk_data_relocs/2, slim_sorted_exportmap/3]). -include("hipe_consttab.hrl"). -include("../../kernel/src/hipe_ext_format.hrl"). +-include("../main/hipe.hrl"). % Needed for the EXIT macro in find_const/2. %%----------------------------------------------------------------------------- --type raw_data() :: binary() | number() | list() | tuple(). --type tbl_ref() :: {hipe_constlbl(), non_neg_integer()}. +-type const_num() :: non_neg_integer(). +-type raw_data() :: binary() | number() | list() | tuple(). + +-type addr() :: non_neg_integer(). +-type ref_p() :: {DataPos :: hipe_constlbl(), CodeOffset :: addr()}. +-type ref() :: ref_p() | {'sorted', Base :: addr(), [ref_p()]}. + +-type mfa_refs() :: {mfa(), [ref()]}. + +%% XXX: these types may not belong here: FIX! +-type fa() :: {atom(), arity()}. +-type export_map() :: [{addr(), module(), atom(), arity()}]. -record(pcm_entry, {mfa :: mfa(), label :: hipe_constlbl(), - const_num :: non_neg_integer(), - start :: non_neg_integer(), + const_num :: const_num(), + start :: addr(), type :: 0 | 1 | 2, raw_data :: raw_data()}). +-type pcm_entry() :: #pcm_entry{}. + +-type label_map() :: gb_trees:tree({mfa(), hipe_constlbl()}, addr()). + +%% Some of the following types may possibly need to be exported +-type data_relocs() :: [ref()]. +-type packed_const_map() :: [pcm_entry()]. +-type mfa_refs_map() :: [mfa_refs()]. +-type slim_export_map() :: [addr() | module() | atom() | arity() | boolean()]. %%----------------------------------------------------------------------------- -spec pack_constants([{mfa(),[_],hipe_consttab()}], ct_alignment()) -> - {ct_alignment(), - non_neg_integer(), - [#pcm_entry{}], - [{mfa(),[tbl_ref() | {'sorted',non_neg_integer(),[tbl_ref()]}]}]}. + {ct_alignment(), non_neg_integer(), packed_const_map(), mfa_refs_map()}. pack_constants(Data, Align) -> pack_constants(Data, 0, Align, 0, [], []). @@ -194,13 +212,12 @@ compact_dests([], Dest, AccofDest, Acc) -> %% to the slimmed and flattened format ConstMap which is put in object %% files. %% --spec slim_constmap([#pcm_entry{}]) -> [raw_data()]. +-spec slim_constmap(packed_const_map()) -> [raw_data()]. slim_constmap(Map) -> slim_constmap(Map, gb_sets:new(), []). --spec slim_constmap([#pcm_entry{}], gb_sets:set(), [raw_data()]) -> [raw_data()]. -slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, - type=Type, raw_data=Term}|Rest], Inserted, Acc) -> +slim_constmap([#pcm_entry{const_num = ConstNo, start = Offset, + type = Type, raw_data = Term}|Rest], Inserted, Acc) -> case gb_sets:is_member(ConstNo, Inserted) of true -> slim_constmap(Rest, Inserted, Acc); @@ -209,3 +226,60 @@ slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, slim_constmap(Rest, NewInserted, [ConstNo, Offset, Type, Term|Acc]) end; slim_constmap([], _Inserted, Acc) -> Acc. + +%% +%% Lookup a constant in a ConstMap. +%% +-spec find_const({mfa(), hipe_constlbl()}, packed_const_map()) -> const_num(). + +find_const({MFA, Label}, [E = #pcm_entry{mfa = MFA, label = Label}|_]) -> + E#pcm_entry.const_num; +find_const(N, [_|R]) -> + find_const(N, R); +find_const(C, []) -> + ?EXIT({constant_not_found, C}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% +%% Functions to build and handle Refs, ExportMap and LabelMap. +%% Note: Moved here because they are used by all backends in +%% hipe_{arm,sparc,ppc,x86}_assemble.erl +%% XXX: Is this the right place for them? +%% + +-spec mk_data_relocs(mfa_refs_map(), label_map()) -> data_relocs(). + +mk_data_relocs(RefsFromConsts, LabelMap) -> + lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). + +mk_data_relocs([{MFA, Labels} | Rest], LabelMap, Acc) -> + Map = [case Label of + {L,Pos} -> + Offset = find({MFA,L}, LabelMap), + {Pos,Offset}; + {sorted,Base,OrderedLabels} -> + {sorted, Base, [begin + Offset = find({MFA,L}, LabelMap), + {Order, Offset} + end + || {L,Order} <- OrderedLabels]} + end + || Label <- Labels], + %% msg("Map: ~w Map\n", [Map]), + mk_data_relocs(Rest, LabelMap, [Map,Acc]); +mk_data_relocs([], _, Acc) -> Acc. + +find({MFA,L}, LabelMap) -> + gb_trees:get({MFA,L}, LabelMap). + +-spec slim_sorted_exportmap(export_map(), [mfa()], [fa()]) -> slim_export_map(). + +slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> + IsClosure = lists:member({M,F,A}, Closures), + IsExported = is_exported(F, A, Exports), + [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; +slim_sorted_exportmap([], _, _) -> []. + +is_exported(F, A, Exports) -> + lists:member({F,A}, Exports). diff --git a/lib/hipe/ppc/hipe_ppc_assemble.erl b/lib/hipe/ppc/hipe_ppc_assemble.erl index b2fd50517b..3ad91f4051 100644 --- a/lib/hipe/ppc/hipe_ppc_assemble.erl +++ b/lib/hipe/ppc/hipe_ppc_assemble.erl @@ -46,8 +46,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -288,7 +288,7 @@ do_pseudo_li(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -574,37 +574,6 @@ mk_y(Pred, BD) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL,LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -642,14 +611,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label}, [{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N, [_|R]) -> - find_const(N, R); -find_const(C, []) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/regalloc/hipe_ls_regalloc.erl b/lib/hipe/regalloc/hipe_ls_regalloc.erl index 4276b8f968..7a00a0534a 100644 --- a/lib/hipe/regalloc/hipe_ls_regalloc.erl +++ b/lib/hipe/regalloc/hipe_ls_regalloc.erl @@ -722,7 +722,7 @@ is_free(R, Free) -> is_free(R, Free, []). is_free(R, [{R,_}|Rest], Acc) -> - {true,lists:reverse(Acc)++Rest}; + {true, lists:reverse(Acc, Rest)}; is_free(R, [X|Rs],Acc) -> is_free(R, Rs, [X|Acc]); is_free(_, [], _) -> @@ -733,7 +733,7 @@ exists_free_register(Start, Regs) -> exists_free_register(Start, [{Phys, Start0}|Rest], Acc) when Start > Start0 -> - {true, Phys, lists:reverse(Acc)++Rest}; + {true, Phys, lists:reverse(Acc, Rest)}; exists_free_register(Start, [Free|Rest], Acc) -> exists_free_register(Start, Rest, [Free|Acc]); exists_free_register(_, [], _) -> diff --git a/lib/hipe/regalloc/hipe_optimistic_regalloc.erl b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl index 5bad31ade9..0278a896d2 100644 --- a/lib/hipe/regalloc/hipe_optimistic_regalloc.erl +++ b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl @@ -958,9 +958,9 @@ splits_2({Cols, NonCols, OldSpillCost}, L, SpillCost) -> %% Merge two ordered sub-splits into one. spillCostOrderedMerge(Spl1, [], Spl) -> - lists:reverse(Spl) ++ Spl1; + lists:reverse(Spl, Spl1); spillCostOrderedMerge([], Spl2, Spl) -> - lists:reverse(Spl) ++ Spl2; + lists:reverse(Spl, Spl2); spillCostOrderedMerge(Spl1, Spl2, Spl) -> {_, _, SpillCost1} = hd(Spl1), {_, _, SpillCost2} = hd(Spl2), diff --git a/lib/hipe/rtl/hipe_icode2rtl.erl b/lib/hipe/rtl/hipe_icode2rtl.erl index 034153a3cb..483d0b37f7 100644 --- a/lib/hipe/rtl/hipe_icode2rtl.erl +++ b/lib/hipe/rtl/hipe_icode2rtl.erl @@ -427,8 +427,6 @@ gen_type_test([X], Type, TrueLbl, FalseLbl, Pred, ConstTab) -> hipe_rtl:mk_branch(X, eq, TmpF, TrueLbl, FalseLbl, Pred)], ConstTab}; cons -> {hipe_tagscheme:test_cons(X, TrueLbl, FalseLbl, Pred), ConstTab}; - constant -> - {hipe_tagscheme:test_constant(X, TrueLbl, FalseLbl, Pred), ConstTab}; fixnum -> {hipe_tagscheme:test_fixnum(X, TrueLbl, FalseLbl, Pred), ConstTab}; float -> @@ -439,6 +437,8 @@ gen_type_test([X], Type, TrueLbl, FalseLbl, Pred, ConstTab) -> {hipe_tagscheme:test_integer(X, TrueLbl, FalseLbl, Pred), ConstTab}; list -> {hipe_tagscheme:test_list(X, TrueLbl, FalseLbl, Pred), ConstTab}; + map -> + {hipe_tagscheme:test_map(X, TrueLbl, FalseLbl, Pred), ConstTab}; nil -> {hipe_tagscheme:test_nil(X, TrueLbl, FalseLbl, Pred), ConstTab}; number -> diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 4bf4eb6bd7..bc61bec0bd 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -29,7 +29,7 @@ %% <li> {alu, Dst, Src1, Op, Src2} </li> %% <li> {alub, Dst, Src1, Op, Src2, RelOp, TrueLabel, FalseLabel, P} </li> %% <li> {branch, Src1, Src2, RelOp, TrueLabel, FalseLabel, P} </li> -%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation} +%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation, NormalContinuation} %% Type is one of {local, remote, primop, closure} </li> %% <li> {comment, Text} </li> %% <li> {enter, Fun, ArgList, Type} @@ -106,7 +106,7 @@ %% rtl_data_update/2, %% rtl_var_range/1, %% rtl_var_range_update/2, - %% rtl_label_range/1, + rtl_label_range/1, %% rtl_label_range_update/2, rtl_info/1, rtl_info_update/2]). @@ -226,6 +226,7 @@ %% goto_label_update/2, mk_call/6, + mk_call/7, call_fun/1, call_dstlist/1, call_dstlist_update/2, @@ -233,8 +234,10 @@ call_continuation/1, call_fail/1, call_type/1, + call_normal/1, + call_normal_update/2, %% call_continuation_update/2, - %% call_fail_update/2, + call_fail_update/2, is_call/1, mk_enter/3, @@ -290,10 +293,13 @@ %% fconv_src_update/2, %% is_fconv/1, - %% mk_var/1, + mk_var/1, + mk_var/2, mk_new_var/0, is_var/1, var_index/1, + var_liveness/1, + var_liveness_update/2, %% change_vars_to_regs/1, @@ -350,10 +356,15 @@ %% move_dst_update/2, fixnumop_dst_update/2, pp_instr/2, - %% pp_arg/2, + %% Uber hack! + pp_var/2, + pp_reg/2, + pp_arg/2, phi_arglist_update/2, phi_redirect_pred/3]). +-export([subst_uses_llvm/2]). + -export_type([alub_cond/0]). %% @@ -387,7 +398,7 @@ rtl_data(#rtl{data=Data}) -> Data. %% rtl_data_update(Rtl, Data) -> Rtl#rtl{data=Data}. %% rtl_var_range(#rtl{var_range=VarRange}) -> VarRange. %% rtl_var_range_update(Rtl, VarRange) -> Rtl#rtl{var_range=VarRange}. -%% rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. +rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. %% rtl_label_range_update(Rtl, LabelRange) -> Rtl#rtl{label_range=LabelRange}. rtl_info(#rtl{info=Info}) -> Info. rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. @@ -643,6 +654,17 @@ is_goto(_) -> false. %% call %% +%% LLVM: Call with normal continuation +mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, + NormalContinuation, Type) -> + case Type of + remote -> ok; + not_remote -> ok + end, + #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, + continuation=Continuation, failcontinuation=FailContinuation, + normalcontinuation=NormalContinuation}. + mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> case Type of remote -> ok; @@ -651,6 +673,10 @@ mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, continuation=Continuation, failcontinuation=FailContinuation}. + +call_normal(#call{normalcontinuation=NormalContinuation}) -> NormalContinuation. +call_normal_update(C, NewNormalContinuation) -> + C#call{normalcontinuation=NewNormalContinuation}. call_dstlist(#call{dstlist=DstList}) -> DstList. call_dstlist_update(C, NewDstList) -> C#call{dstlist=NewDstList}. call_fun(#call{'fun'=Fun}) -> Fun. @@ -853,11 +879,14 @@ reg_is_gcsafe(#rtl_reg{is_gc_safe=IsGcSafe}) -> IsGcSafe. is_reg(#rtl_reg{}) -> true; is_reg(_) -> false. --record(rtl_var, {index :: non_neg_integer()}). +-record(rtl_var, {index :: non_neg_integer(), liveness=live :: dead | live}). mk_var(Num) when is_integer(Num), Num >= 0 -> #rtl_var{index=Num}. +mk_var(Num, Liveness) when is_integer(Num), Num>=0 -> #rtl_var{index=Num, liveness=Liveness}. mk_new_var() -> mk_var(hipe_gensym:get_next_var(rtl)). var_index(#rtl_var{index=Index}) -> Index. +var_liveness(#rtl_var{liveness=Liveness}) -> Liveness. +var_liveness_update(RtlVar, Liveness) -> RtlVar#rtl_var{liveness=Liveness}. is_var(#rtl_var{}) -> true; is_var(_) -> false. @@ -1077,6 +1106,131 @@ subst_uses(Subst, I) -> switch_src_update(I, subst1(Subst, switch_src(I))) end. +subst_uses_llvm(Subst, I) -> + case I of + #alu{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alu_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alu_src1(I)), + I0 = alu_src1_update(I, NewSrc1), + alu_src2_update(I0, NewSrc2); + #alub{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alub_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alub_src1(I)), + I0 = alub_src1_update(I, NewSrc1), + alub_src2_update(I0, NewSrc2); + #branch{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, branch_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, branch_src1(I)), + I0 = branch_src1_update(I, NewSrc1), + branch_src2_update(I0, NewSrc2); + #call{} -> + case call_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, call_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, call_arglist(I)), + I0 = call_fun_update(I, NewFun), + call_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, call_arglist(I)), + call_arglist_update(I, NewArgList) + end; + #comment{} -> + I; + #enter{} -> + case enter_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, enter_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, enter_arglist(I)), + I0 = enter_fun_update(I, NewFun), + enter_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, enter_arglist(I)), + enter_arglist_update(I, NewArgList) + end; + #fconv{} -> + {NewSrc, _ } = subst1_llvm(Subst, fconv_src(I)), + fconv_src_update(I, NewSrc); + #fixnumop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fixnumop_src(I)), + fixnumop_src_update(I, NewSrc); + #fload{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fload_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, fload_offset(I)), + I0 = fload_src_update(I, NewSrc), + fload_offset_update(I0, NewOffset); + #fmove{} -> + {NewSrc, _ } = subst1_llvm(Subst, fmove_src(I)), + fmove_src_update(I, NewSrc); + #fp{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, fp_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, fp_src1(I)), + I0 = fp_src1_update(I, NewSrc1), + fp_src2_update(I0, NewSrc2); + #fp_unop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fp_unop_src(I)), + fp_unop_src_update(I, NewSrc); + #fstore{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fstore_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, fstore_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, fstore_offset(I)), + I0 = fstore_src_update(I, NewSrc), + I1 = fstore_base_update(I0, NewBase), + fstore_offset_update(I1, NewOffset); + #goto{} -> + I; + #goto_index{} -> + I; + #gctest{} -> + {NewWords, _ } = subst1_llvm(Subst, gctest_words(I)), + gctest_words_update(I, NewWords); + #label{} -> + I; + #load{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, load_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, load_offset(I)), + I0 = load_src_update(I, NewSrc), + load_offset_update(I0, NewOffset); + #load_address{} -> + I; + #load_atom{} -> + I; + #load_word_index{} -> + I; + #move{} -> + {NewSrc, _ } = subst1_llvm(Subst, move_src(I)), + move_src_update(I, NewSrc); + #multimove{} -> + {NewSrcList, _} = subst_list_llvm(Subst, multimove_srclist(I)), + multimove_srclist_update(I, NewSrcList); + #phi{} -> + phi_argvar_subst(I, Subst); + #return{} -> + {NewVarList, _} = subst_list_llvm(Subst, return_varlist(I)), + return_varlist_update(I, NewVarList); + #store{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, store_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, store_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, store_offset(I)), + I0 = store_src_update(I, NewSrc), + I1 = store_base_update(I0, NewBase), + store_offset_update(I1, NewOffset); + #switch{} -> + {NewSrc, _ } = subst1_llvm(Subst, switch_src(I)), + switch_src_update(I, NewSrc) + end. + +subst_list_llvm(S,X) -> subst_list_llvm(S, lists:reverse(X), []). +subst_list_llvm(S, [], Acc) -> {Acc, S}; +subst_list_llvm(S, [X|Xs], Acc) -> + {NewX, RestS} = subst1_llvm(S, X), + subst_list_llvm(RestS, Xs, [NewX|Acc]). + +subst1_llvm(A,B) -> subst1_llvm(A,B,[]). + +subst1_llvm([], X, Acc) -> {X, Acc}; +subst1_llvm([{X,Y}|Rs], X, Acc) -> {Y, Acc++Rs}; +subst1_llvm([R|Xs], X, Acc) -> subst1_llvm(Xs,X,[R|Acc]). + subst_defines(Subst, I)-> case I of #alu{} -> @@ -1614,7 +1768,11 @@ pp_var(Dev, Arg) -> true -> pp_hard_reg(Dev, var_index(Arg)); false -> - io:format(Dev, "v~w", [var_index(Arg)]) + io:format(Dev, "v~w", [var_index(Arg)]), + case var_liveness(Arg) of + dead -> io:format(Dev, "(dead)", []); + _ -> ok + end end. pp_arg(Dev, A) -> diff --git a/lib/hipe/rtl/hipe_rtl.hrl b/lib/hipe/rtl/hipe_rtl.hrl index 974e40f830..fbdf9ac524 100644 --- a/lib/hipe/rtl/hipe_rtl.hrl +++ b/lib/hipe/rtl/hipe_rtl.hrl @@ -28,7 +28,8 @@ -record(alu, {dst, src1, op, src2}). -record(alub, {dst, src1, op, src2, 'cond', true_label, false_label, p}). -record(branch, {src1, src2, 'cond', true_label, false_label, p}). --record(call, {dstlist, 'fun', arglist, type, continuation, failcontinuation}). +-record(call, {dstlist, 'fun', arglist, type, continuation, + failcontinuation, normalcontinuation = []}). -record(comment, {text}). -record(enter, {'fun', arglist, type}). -record(fconv, {dst, src}). diff --git a/lib/hipe/rtl/hipe_rtl_liveness.erl b/lib/hipe/rtl/hipe_rtl_liveness.erl index 3cfada9d6c..0c4b6b2e11 100644 --- a/lib/hipe/rtl/hipe_rtl_liveness.erl +++ b/lib/hipe/rtl/hipe_rtl_liveness.erl @@ -34,7 +34,8 @@ -module(hipe_rtl_liveness). -%% -define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. +%% -define(DEBUG_LIVENESS,true). +-define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. -define(PRETTY_PRINT,false). -include("hipe_rtl.hrl"). diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index f1e8d1ef41..c27c682915 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -39,14 +39,13 @@ test_tuple/4, test_atom/4, test_bignum/4, test_pos_bignum/4, test_any_pid/4, test_any_port/4, test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4, - test_binary/4, test_bitstr/4, test_list/4, - test_integer/4, test_number/4, test_constant/4, test_tuple_N/5]). + test_binary/4, test_bitstr/4, test_list/4, test_map/4, + test_integer/4, test_number/4, test_tuple_N/5]). -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]). -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3, unsafe_fixnum_sub/3, fixnum_gt/5, fixnum_lt/5, fixnum_ge/5, fixnum_le/5, fixnum_val/1, - fixnum_mul/4, - fixnum_addsub/5, fixnum_andorxor/4, fixnum_not/2, + fixnum_mul/4, fixnum_addsub/5, fixnum_andorxor/4, fixnum_not/2, fixnum_bsr/3, fixnum_bsl/3]). -export([unsafe_car/2, unsafe_cdr/2, unsafe_constant_element/3, unsafe_update_element/3, element/6]). @@ -113,13 +112,15 @@ -define(TAG_HEADER_EXTERNAL_PID, ((16#C bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). -define(TAG_HEADER_EXTERNAL_PORT,((16#D bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). -define(TAG_HEADER_EXTERNAL_REF, ((16#E bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). +-define(TAG_HEADER_MAP, ((16#F bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). -define(TAG_HEADER_MASK, 16#3F). -define(HEADER_ARITY_OFFS, 6). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_header(SZ,TAG) -> (SZ bsl ?HEADER_ARITY_OFFS) + TAG. +mk_header(SZ, TAG) -> (SZ bsl ?HEADER_ARITY_OFFS) + TAG. + mk_arityval(SZ) -> mk_header(SZ, ?TAG_HEADER_ARITYVAL). size_from_header(Sz, Header) -> @@ -133,9 +134,9 @@ mk_var_header(Header, Size, Tag) -> mk_fixnum(X) -> (X bsl ?TAG_IMMED1_SIZE) + ?TAG_IMMED1_SMALL. -define(NIL, ((-1 bsl ?TAG_IMMED2_SIZE) bor ?TAG_IMMED2_NIL)). -mk_nil() -> ?NIL. -%% mk_atom(X) -> (X bsl ?TAG_IMMED2_SIZE) + ?TAG_IMMED2_ATOM. -mk_non_value() -> ?THE_NON_VALUE. +mk_nil() -> ?NIL. +%% mk_atom(X) -> (X bsl ?TAG_IMMED2_SIZE) + ?TAG_IMMED2_ATOM. +mk_non_value() -> ?THE_NON_VALUE. -spec is_fixnum(integer()) -> boolean(). is_fixnum(N) when is_integer(N) -> @@ -253,6 +254,15 @@ test_tuple_N(X, N, TrueLab, FalseLab, Pred) -> hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(mk_arityval(N)), TrueLab, FalseLab, Pred)]. +test_map(X, TrueLab, FalseLab, Pred) -> + Tmp = hipe_rtl:mk_new_reg_gcsafe(), + HalfTrueLab = hipe_rtl:mk_new_label(), + MapMask = ?TAG_HEADER_MASK, + [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred), + HalfTrueLab, + get_header(Tmp, X), + mask_and_compare(Tmp, MapMask, ?TAG_HEADER_MAP, TrueLab, FalseLab, Pred)]. + test_ref(X, TrueLab, FalseLab, Pred) -> Hdr = hipe_rtl:mk_new_reg_gcsafe(), Tag = hipe_rtl:mk_new_reg_gcsafe(), @@ -405,17 +415,6 @@ test_number(X, TrueLab, FalseLab, Pred) -> hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(HeaderFlonum), TrueLab, FalseLab, Pred)]. -%% CONS, NIL, and TUPLE are not constants, everything else is -test_constant(X, TrueLab, FalseLab, Pred) -> - Lab1 = hipe_rtl:mk_new_label(), - Lab2 = hipe_rtl:mk_new_label(), - Pred1 = 1-Pred, - [test_cons(X, FalseLab, hipe_rtl:label_name(Lab1), Pred1), - Lab1, - test_nil(X, FalseLab, hipe_rtl:label_name(Lab2), Pred1), - Lab2, - test_tuple(X, FalseLab, TrueLab, Pred1)]. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% tag_fixnum(DestVar, SrcReg) -> diff --git a/lib/hipe/sparc/hipe_sparc_assemble.erl b/lib/hipe/sparc/hipe_sparc_assemble.erl index b534fe20ec..68a4e1b349 100644 --- a/lib/hipe/sparc/hipe_sparc_assemble.erl +++ b/lib/hipe/sparc/hipe_sparc_assemble.erl @@ -45,8 +45,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -222,7 +222,7 @@ do_pseudo_set(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -507,37 +507,6 @@ px({pred,Pred}) -> % XXX: use pt/pn throughout entire backend %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -575,14 +544,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index cedb150b5d..009f503abb 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -8,6 +8,11 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ hipe_SUITE +# .erl files for these modules are automatically generated +GEN_MODULES= \ + bs_SUITE \ + maps_SUITE + ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -40,6 +45,8 @@ EBIN = . make_emakefile: $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ > $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(GEN_MODULES) \ + >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \ >> $(EMAKEFILE) diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl index c8fdf1600c..5f05a716bc 100644 --- a/lib/hipe/test/hipe_testsuite_driver.erl +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -85,7 +85,7 @@ list_testcases(Dirname) -> list_dir(Dir, Extension, Dirs) -> case file:list_dir(Dir) of - {error, _} = Error-> Error; + {error, _} = Error -> Error; {ok, Filenames} -> FullFilenames = [filename:join(Dir, F) || F <- Filenames], Matches1 = case Dirs of @@ -173,10 +173,29 @@ run(TestCase, Dir, _OutDir) -> %% end, DataFiles), %% try ok = TestCase:test(), - HiPEOpts = try TestCase:hipe_options() catch _:_ -> [] end, + HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end, {ok, TestCase} = hipe:c(TestCase, HiPEOpts), - ok = TestCase:test(). + ok = TestCase:test(), + case is_llvm_opt_available() of + true -> + {ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]), + ok = TestCase:test(); + false -> ok + end. %% after %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, %% [filename:join(OutDir, D) || D <- DataFiles]) %% end. + + +%% This function, which is supposed to check whether the right LLVM +%% infrastructure is available, should be probably written in a better +%% and more portable way and moved to the hipe application. + +is_llvm_opt_available() -> + OptStr = os:cmd("opt -version"), + SubStr = "LLVM version ", N = length(SubStr), + case string:str(OptStr, SubStr) of + 0 -> false; + S -> P = S + N, string:sub_string(OptStr, P, P + 2) >= "3.4" + end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl new file mode 100644 index 0000000000..14d8320cdf --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl @@ -0,0 +1,20 @@ +-module(maps_build_and_match_aliasing). +-export([test/0]). + +test() -> + M1 = id(#{a=>1,b=>2,c=>3,d=>4}), + #{c:=C1=_=_=C2} = M1, + true = C1 =:= C2, + #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1, + #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1, + #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1, + #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1, + #{c:=C=_=3=_=C} = M1, + + M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), + #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, + #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl new file mode 100644 index 0000000000..2abfa4e5b3 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl @@ -0,0 +1,17 @@ +-module(maps_build_and_match_empty_val). +-export([test/0]). + +test() -> + F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end, + ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl new file mode 100644 index 0000000000..dc2c63fab2 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl @@ -0,0 +1,40 @@ +-module(maps_build_and_match_literals). +-export([test/0]). + +test() -> + #{} = id(#{}), + #{1:=a} = id(#{1=>a}), + #{1:=a,2:=b} = id(#{1=>a,2=>b}), + #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}), + #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), + + #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}), + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), + + %% nil key + #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl new file mode 100644 index 0000000000..dae6f64e5f --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl @@ -0,0 +1,16 @@ +-module(maps_build_and_match_over_alloc). +-export([test/0]). + +test() -> + Ls = id([1,2,3]), + V0 = [a|Ls], + M0 = id(#{ "a" => V0 }), + #{ "a" := V1 } = M0, + V2 = id([c|Ls]), + M2 = id(#{ "a" => V2 }), + #{ "a" := V3 } = M2, + {[a,1,2,3],[c,1,2,3]} = id({V1,V3}), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl new file mode 100644 index 0000000000..284f69e06c --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl @@ -0,0 +1,23 @@ +-module(maps_build_and_match_val). +-export([test/0]). + +test() -> + F = fun + (#{ "hi" := first, v := V}) -> {1,V}; + (#{ "hi" := second, v := V}) -> {2,V} + end, + + + {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})), + {2,"second"} = F(id(#{"hi"=>second,v=>"second"})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl new file mode 100644 index 0000000000..df0f77ea47 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl @@ -0,0 +1,7 @@ +-module(maps_expand_map_update). +-export([test/0]). + +test() -> + M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>}, + #{<<"hello">> := <<"les gens">>} = M, + ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_export.erl b/lib/hipe/test/maps_SUITE_data/maps_export.erl new file mode 100644 index 0000000000..4d43fc96ed --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_export.erl @@ -0,0 +1,11 @@ +-module(maps_export). +-export([test/0]). + +test() -> + Raclette = id(#{}), + case brie of brie -> Fromage = Raclette end, + Raclette = Fromage#{}, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl new file mode 100644 index 0000000000..b2d749796a --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_get_map_elements). + +-export([test/0]). + +test() -> + {A, B} = id({"hej", <<123>>}), + Map = maps:from_list([{a, A}, {b, B}]), + #{a := A, b := B} = id(Map), + false = test_pattern(Map), + true = test_pattern(#{b => 1, a => "hej"}), + case Map of + #{a := C, b := <<124>>} -> yay; + _ -> C = B, nay + end, + C = id(B), + ok. + +id(X) -> X. + +test_pattern(#{a := _, b := 1}) -> true; +test_pattern(#{}) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl new file mode 100644 index 0000000000..61a0eaa1e7 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl @@ -0,0 +1,31 @@ +-module(maps_guard_bifs). +-export([test/0]). + +test() -> + true = map_guard_empty(), + true = map_guard_empty_2(), + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + true = map_guard_tautology(), + true = map_guard_ill_map_size(), + ok. + +map_guard_empty() when is_map(#{}); false -> true. + +map_guard_empty_2() when true; #{} andalso false -> true. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +map_guard_tautology() when #{} =:= #{}; true -> true. + +map_guard_ill_map_size() when true; map_size(0) -> true. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl new file mode 100644 index 0000000000..9f6eb3a04e --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl @@ -0,0 +1,36 @@ +-module(maps_guard_fun). +-export([test/0]). + +test() -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + case (catch F1(#{s=>none,v=>none})) of + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok; + {'EXIT', {function_clause,[{?MODULE,_,1,[#{s:=none,v:=none}]}|_]}} -> ok; + {'EXIT', {function_clause,[Frame|_]}} + when is_tuple(Frame), element(1, Frame) =:= ?MODULE -> + test_server:comment("Unexpected trace format, probably using HiPE"); + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl new file mode 100644 index 0000000000..f84ba19c86 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl @@ -0,0 +1,54 @@ +-module(maps_guard_receive). +-export([test/0]). + +test() -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl new file mode 100644 index 0000000000..4eb18dcea1 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl @@ -0,0 +1,35 @@ +-module(maps_guard_sequence). +-export([test/0]). + +test() -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl new file mode 100644 index 0000000000..254c1c2984 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl @@ -0,0 +1,14 @@ +-module(maps_guard_update). +-export([test/0]). + +test() -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}), + ok. + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third; +map_guard_update(_, _) -> error. diff --git a/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl new file mode 100644 index 0000000000..61653aa519 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl @@ -0,0 +1,46 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_has_map_fields). + +-export([test/0]). + +test() -> + false = has_a_field(#{}), + false = has_a_field(#{b => 2}), + true = has_a_field(#{a => 3}), + true = has_a_field(#{b => c, a => false}), + + false = has_a_b_field(#{a => true}), + false = has_a_b_field(#{b => a}), + true = has_a_b_field(#{a => 1, b => 2}), + true = has_a_b_field(#{b => 3, a => 4}), + + false = has_binary_field(#{}), + false = has_binary_field(#{#{} => yay}), + true = has_binary_field(#{<<"true">> => false}), + + false = has_binary_but_no_map_field(#{}), + false = has_map_but_no_binary_field(#{}), + false = has_binary_but_no_map_field(#{#{} => 1}), + false = has_map_but_no_binary_field(#{<<"true">> => true}), + true = has_binary_but_no_map_field(#{<<"true">> => false}), + true = has_map_but_no_binary_field(#{#{} => 1}), + false = has_binary_but_no_map_field(#{<<"true">> => true, #{} => 1}), + false = has_map_but_no_binary_field(#{<<"true">> => true, #{} => 1}), + ok. + +has_a_field(#{a := _}) -> true; +has_a_field(#{}) -> false. + +has_a_b_field(#{a := _, b := _}) -> true; +has_a_b_field(#{}) -> false. + +has_binary_field(#{<<"true">> := _}) -> true; +has_binary_field(#{}) -> false. + +has_map_but_no_binary_field(#{<<"true">> := _}) -> false; +has_map_but_no_binary_field(#{} = M) -> maps:is_key(#{}, M). + +has_binary_but_no_map_field(#{<<"true">> := _} = M) -> + not maps:is_key(#{}, M); +has_binary_but_no_map_field(#{}) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_is_map.erl b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl new file mode 100644 index 0000000000..e84f4b8c44 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl @@ -0,0 +1,24 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_is_map). + +-export([test/0]). + +test() -> + true = test_is_map(#{}), + false = test_is_map(<<"hej">>), + true = test_is_map_guard(#{a => b}), + false = test_is_map_guard(3), + true = test_is_map_with_binary_guard(#{"a" => <<"b">>}), + false = test_is_map_with_binary_guard(12), + ok. + +test_is_map(X) -> + is_map(X). + +test_is_map_guard(Map) when is_map(Map) -> true; +test_is_map_guard(_) -> false. + +test_is_map_with_binary_guard(B) when is_binary(B) -> false; +test_is_map_with_binary_guard(#{}) -> true; +test_is_map_with_binary_guard(_) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl new file mode 100644 index 0000000000..ad2c726d65 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl @@ -0,0 +1,6 @@ +-module(maps_list_comprehension). +-export([test/0]). + +test() -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl new file mode 100644 index 0000000000..25c8e5d4c7 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl @@ -0,0 +1,29 @@ +-module(maps_map_size). +-export([test/0]). + +test() -> + 0 = map_size(id(#{})), + 1 = map_size(id(#{a=>1})), + 1 = map_size(id(#{a=>"wat"})), + 2 = map_size(id(#{a=>1, b=>2})), + 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + %% Error cases. + {'EXIT',{badarg,_}} = (catch map_size([])), + {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{badarg,_}} = (catch map_size(1)), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl new file mode 100644 index 0000000000..31abf15d49 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl @@ -0,0 +1,41 @@ +-module(maps_map_sort_literals). +-export([test/0]). + +test() -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}), + true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}), + false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}), + + %% key order + true = id(#{ a => 1 }) < id(#{ b => 1}), + false = id(#{ b => 1 }) < id(#{ a => 1}), + true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}), + true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}), + true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}), + true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}), + false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}), + false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}), + false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}), + + %% value order + true = id(#{ a => 1 }) < id(#{ a => 2}), + false = id(#{ a => 2 }) < id(#{ a => 1}), + false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}), + true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}), + + true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}), + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl new file mode 100644 index 0000000000..29a6a29290 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl @@ -0,0 +1,24 @@ +-module(maps_match_and_update_literals). +-export([test/0]). + +test() -> + Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl new file mode 100644 index 0000000000..72ac9ce078 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_put_map_assoc). + +-export([test/0]). + +test() -> + true = assoc_guard(#{}), + false = assoc_guard(not_a_map), + #{a := true} = assoc_update(#{}), + {'EXIT', {badarg, [{?MODULE, assoc_update, 1, _}|_]}} + = (catch assoc_update(not_a_map)), + ok = assoc_guard_clause(#{}), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch assoc_guard_clause(not_a_map)), + ok. + +assoc_guard(M) when is_map(M#{a => b}) -> true; +assoc_guard(_) -> false. + +assoc_update(M) -> M#{a => true}. + +assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl new file mode 100644 index 0000000000..1cfcd80180 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl @@ -0,0 +1,28 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_put_map_exact). + +-export([test/0]). + +test() -> + false = exact_guard(#{b => a}), + false = exact_guard(not_a_map), + true = exact_guard(#{a => false}), + #{a := true} = exact_update(#{a => false}), + {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}} + = (catch exact_update(not_a_map)), + {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}} + = (catch exact_update(#{})), + ok = exact_guard_clause(#{a => yes}), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(#{})), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(not_a_map)), + ok. + +exact_guard(M) when is_map(M#{a := b}) -> true; +exact_guard(_) -> false. + +exact_update(M) -> M#{a := true}. + +exact_guard_clause(M) when is_map(M#{a := 42}) -> ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl new file mode 100644 index 0000000000..cc7c1353de --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl @@ -0,0 +1,22 @@ +-module(maps_update_assoc). +-export([test/0]). + +test() -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl new file mode 100644 index 0000000000..6e5acb3283 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl @@ -0,0 +1,32 @@ +-module(maps_update_exact). +-export([test/0]). + +test() -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl new file mode 100644 index 0000000000..87aea3d8e1 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl @@ -0,0 +1,13 @@ +-module(maps_update_literals). +-export([test/0]). + +test() -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl new file mode 100644 index 0000000000..181e3f18f7 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl @@ -0,0 +1,32 @@ +-module(maps_update_map_expressions). +-export([test/0]). + +test() -> + M = maps:new(), + X = id(fondue), + M1 = #{ a := 1 } = M#{a => 1}, + #{ b := {X} } = M1#{ a := 1, b => {X} }, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + + %% Test need to be in a fun. + %% This tests that let expr optimisation in sys_core_fold + %% covers maps correctly. + F = fun() -> + M0 = id(#{ "a" => [1,2,3] }), + #{ "a" := _ } = M0, + M0#{ "a" := b } + end, + + #{ "a" := b } = F(), + + %% Error cases, FIXME: should be 'badmap'? + {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_values.erl b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl new file mode 100644 index 0000000000..bbad5ac19e --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl @@ -0,0 +1,28 @@ +-module(maps_update_values). +-export([test/0]). + +test() -> + V0 = id(1337), + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + [1337, {some_val, 1337}] = get_val(M1), + + N = 110, + List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], + + {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun + ({V2,V3},{Old2,Old3,Mi}) -> + ok = check_val(Mi,Old2,Old3), + #{ val1 := Old2, val2 := Old3 } = Mi, + {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}} + end, {none, none, #{val1=>none,val2=>none}},List), + ok. + +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. + +check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl new file mode 100644 index 0000000000..76b2a91f94 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl @@ -0,0 +1,27 @@ +-module(maps_warn_pair_key_overloaded). +-export([test/0]). + +test() -> + #{ "hi1" := 42 } = id(#{ "hi1" => 1, "hi1" => 42 }), + + #{ "hi1" := 1337, "hi2" := [2], "hi3" := 3 } = id(#{ + "hi1" => erlang:atom_to_binary(?MODULE,utf8), + "hi1" => erlang:binary_to_atom(<<"wazzup">>,utf8), + "hi1" => erlang:binary_to_float(<<"3.1416">>), + "hi1" => erlang:float_to_binary(3.1416), + "hi2" => erlang:pid_to_list(self()), + "hi3" => erlang:float_to_binary(3.1416), + "hi2" => lists:subtract([1,2],[1]), + "hi3" => +3, + "hi1" => erlang:min(1,2), + "hi1" => erlang:hash({1,2},35), + "hi1" => erlang:phash({1,2},33), + "hi1" => erlang:phash2({1,2},34), + "hi1" => erlang:integer_to_binary(1337), + "hi1" => erlang:binary_to_integer(<<"1337">>), + "hi4" => erlang:float_to_binary(3.1416) + }), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl new file mode 100644 index 0000000000..6cb0366314 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl @@ -0,0 +1,9 @@ +-module(maps_warn_useless_build). +-export([test/0]). + +test() -> + [#{ a => id(I)} || I <- [1,2,3]], + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index ed4b4dc8d2..fb7e4b91a0 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.10.2.2 +HIPE_VSN = 3.10.3 diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl index 7878c7219d..3f756769c4 100644 --- a/lib/hipe/x86/hipe_x86_assemble.erl +++ b/lib/hipe/x86/hipe_x86_assemble.erl @@ -21,7 +21,6 @@ %%% %%% TODO: %%% - Simplify combine_label_maps and mk_data_relocs. -%%% - Move find_const to hipe_pack_constants? -ifdef(HIPE_AMD64). -define(HIPE_X86_ASSEMBLE, hipe_amd64_assemble). @@ -80,8 +79,8 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% ?debug_msg("Constants are ~w bytes\n",[ConstSize])), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, ConstAlign, ConstSize, @@ -442,7 +441,7 @@ translate_imm(#x86_imm{value=Imm}, Context, MayTrunc8) -> case Imm of {Label,constant} -> {MFA,ConstMap} = Context, - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {constant,ConstNo}; {Label,closure} -> {closure,Label}; @@ -712,7 +711,7 @@ resolve_jmp_switch_arg(I, _Context) -> {rm64,hipe_amd64_encode:rm_mem(EA)}. -else. resolve_jmp_switch_arg(I, {MFA,ConstMap}) -> - ConstNo = find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), Disp32 = {?LOAD_ADDRESS,{constant,ConstNo}}, SINDEX = ?HIPE_X86_ENCODE:sindex(2, hipe_x86:temp_reg(hipe_x86:jmp_switch_temp(I))), EA = ?HIPE_X86_ENCODE:ea_disp32_sindex(Disp32, SINDEX), % this creates a SIB implicitly @@ -932,37 +931,6 @@ resolve_x87_binop_args(Src=#x86_fpreg{}, Dst=#x86_fpreg{})-> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({MFA,L},LabelMap) -> - gb_trees:get({MFA,L}, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -1001,14 +969,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). |