diff options
Diffstat (limited to 'lib/hipe/rtl/hipe_rtl.erl')
| -rw-r--r-- | lib/hipe/rtl/hipe_rtl.erl | 1655 |
1 files changed, 1655 insertions, 0 deletions
diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl new file mode 100644 index 0000000000..ef06b2abf8 --- /dev/null +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -0,0 +1,1655 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. 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% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% @doc +%% +%% Provides an abstract datatype for HiPE's RTL (Register Transfer Language). +%% +%% <h3> RTL - Register Transfer Language </h3> +%% +%% Consists of the instructions: +%% <ul> +%% <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} +%% Type is one of {local, remote, primop, closure} </li> +%% <li> {comment, Text} </li> +%% <li> {enter, Fun, ArgList, Type} +%% Type is one of {local, remote, primop, closure} </li> +%% <li> {fconv, Dst, Src} </li> +%% <li> {fload, Dst, Src, Offset} </li> +%% <li> {fmove, Dst, Src} </li> +%% <li> {fp, Dst, Src1, Op, Src2} </li> +%% <li> {fp_unop, Dst, Src, Op} </li> +%% <li> {fstore, Base, Offset, Src} </li> +%% <li> {gctest, Words} </li> +%% <li> {goto, Label} </li> +%% <li> {goto_index, Block, Index, LabelList} </li> +%% <li> {label, Name} </li> +%% <li> {load, Dst, Src, Offset, Size, Sign} </li> +%% <li> {load_address, Dst, Addr, Type} </li> +%% <li> {load_atom, Dst, Atom} </li> +%% <li> {load_word_index, Dst, Block, Index} </li> +%% <li> {move, Dst, Src} </li> +%% <li> {multimove, [Dst1, ..., DstN], [Src1, ..., SrcN]} </li> +%% <li> {phi, Dst, Id, [Src1, ..., SrcN]} </li> +%% <li> {return, VarList} </li> +%% <li> {store, Base, Offset, Src, Size} </li> +%% <li> {switch, Src1, Labels, SortedBy} </li> +%% </ul> +%% +%% There are three kinds of 'registers' in RTL. +%% <ol> +%% <li> Variables containing tagged data that are traced by the GC. </li> +%% <li> Registers that are ignored by the GC. </li> +%% <li> Floating point registers. </li> +%% </ol> +%% These registers all share the same namespace. +%% +%% IMPORTANT: +%% +%% The variables contain tagged Erlang terms, the registers +%% contain untagged values (that can be all sorts of things) and +%% the floating point registers contain untagged floating point +%% values. This means that the different kinds of 'registers' are +%% incompatible and CANNOT be assigned to each other unless the +%% proper conversions are made. +%% +%% When performing optimizations, it is reasonably safe to move +%% values stored in variables. However, when moving around untagged +%% values from either registers or floating point registers make +%% sure you know what you are doing. +%% +%% Example 1: A register might contain the untagged pointer to +%% something on the heap. If this value is moved across +%% a program point where a garbage collection might +%% occur, the pointer can be invalid. If you are lucky +%% you will end up with a segmentation fault; if unlucky, +%% you will be stuck on a wild goose chase. +%% +%% Example 2: Floating point arithmetic instructions must occur in +%% a floating point block. Otherwise, exceptions can be +%% masked. +%% +%% @end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(hipe_rtl). +-include("../main/hipe.hrl"). + +-export([mk_rtl/8, + rtl_fun/1, + rtl_params/1, + rtl_is_closure/1, + rtl_is_leaf/1, + rtl_code/1, + rtl_code_update/2, + rtl_data/1, + %% rtl_data_update/2, + %% rtl_var_range/1, + %% rtl_var_range_update/2, + %% rtl_label_range/1, + %% rtl_label_range_update/2, + rtl_info/1, + rtl_info_update/2]). + +-export([mk_move/2, + move_dst/1, + move_src/1, + %% move_src_update/2, + %% is_move/1, + + mk_multimove/2, + multimove_dstlist/1, + multimove_srclist/1, + %% multimove_srclist_update/2, + %% is_multimove/1, + + mk_phi/1, + phi_dst/1, + phi_id/1, + phi_arg/2, + phi_arglist/1, + is_phi/1, + phi_enter_pred/3, + phi_remove_pred/2, + + mk_alu/4, + alu_dst/1, + alu_src1/1, + alu_src1_update/2, + alu_src2/1, + alu_src2_update/2, + alu_op/1, + %% is_alu_op/1, + is_shift_op/1, + + mk_load/3, + mk_load/5, + load_dst/1, + load_src/1, + load_offset/1, + load_size/1, + load_sign/1, + + mk_load_atom/2, + load_atom_dst/1, + load_atom_atom/1, + + mk_load_word_index/3, + load_word_index_dst/1, + %% load_word_index_index/1, + %% load_word_index_block/1, + + mk_goto_index/3, + goto_index_index/1, + %% goto_index_block/1, + goto_index_labels/1, + + mk_load_address/3, + load_address_dst/1, + %% load_address_dst_update/2, + load_address_addr/1, + load_address_addr_update/2, + load_address_type/1, + %% load_address_type_update/2, + + mk_store/3, + mk_store/4, + store_base/1, + store_src/1, + store_offset/1, + store_size/1, + + mk_label/1, + mk_new_label/0, + label_name/1, + is_label/1, + + mk_branch/5, + mk_branch/6, + branch_src1/1, + branch_src2/1, + branch_cond/1, + branch_true_label/1, + branch_false_label/1, + branch_pred/1, + %% is_branch/1, + %% branch_true_label_update/2, + %% branch_false_label_update/2, + + mk_alub/7, + mk_alub/8, + alub_dst/1, + alub_src1/1, + alub_op/1, + alub_src2/1, + alub_cond/1, + alub_true_label/1, + %% alub_true_label_update/2, + alub_false_label/1, + %% alub_false_label_update/2, + alub_pred/1, + %% is_alub/1, + + mk_switch/2, + %% mk_switch/3, + mk_sorted_switch/3, + switch_src/1, + %% switch_src_update/2, + switch_labels/1, + %% switch_labels_update/2, + switch_sort_order/1, + %% switch_sort_order_update/2, + + mk_goto/1, + goto_label/1, + is_goto/1, + %% goto_label_update/2, + + mk_call/6, + call_fun/1, + call_dstlist/1, + call_dstlist_update/2, + call_arglist/1, + call_continuation/1, + call_fail/1, + call_type/1, + %% call_continuation_update/2, + %% call_fail_update/2, + is_call/1, + + mk_enter/3, + enter_fun/1, + enter_arglist/1, + enter_type/1, + + mk_return/1, + return_varlist/1, + + mk_gctest/1, + gctest_words/1, + + mk_comment/1, + comment_text/1, + is_comment/1, + + mk_fload/3, + fload_dst/1, + fload_src/1, + %% fload_src_update/2, + fload_offset/1, + %% fload_offset_update/2, + + mk_fstore/3, + fstore_base/1, + fstore_src/1, + fstore_offset/1, + + mk_fp/4, + fp_dst/1, + fp_src1/1, + %% fp_src1_update/2, + fp_src2/1, + %% fp_src2_update/2, + fp_op/1, + + mk_fp_unop/3, + fp_unop_dst/1, + fp_unop_src/1, + %% fp_unop_src_update/2, + fp_unop_op/1, + + mk_fmove/2, + fmove_dst/1, + fmove_src/1, + %% fmove_src_update/2, + %% is_fmove/1, + + mk_fconv/2, + fconv_dst/1, + fconv_src/1, + %% fconv_src_update/2, + %% is_fconv/1, + + %% mk_var/1, + mk_new_var/0, + is_var/1, + var_index/1, + + %% change_vars_to_regs/1, + + mk_fixnumop/3, + fixnumop_dst/1, + fixnumop_src/1, + fixnumop_type/1, + + mk_reg/1, % assumes non gc-safe + mk_reg_gcsafe/1, + mk_new_reg/0, % assumes non gc-safe + mk_new_reg_gcsafe/0, + is_reg/1, + reg_index/1, + reg_is_gcsafe/1, + + %% mk_fpreg/1, + mk_new_fpreg/0, + is_fpreg/1, + fpreg_index/1, + + mk_imm/1, + is_imm/1, + imm_value/1, + + mk_const_label/1, + const_label_label/1, + is_const_label/1, + + args/1, + uses/1, + %% subst/2, + subst_uses/2, + subst_defines/2, + defines/1, + redirect_jmp/3, + is_safe/1, + %% highest_var/1, + pp/1, + pp/2, + pp_block/1, + + %% FIXME _dst_update command. Ok to export these? + alu_dst_update/2, + fconv_dst_update/2, + fload_dst_update/2, + %% fmove_dst_update/2, + fp_dst_update/2, + fp_unop_dst_update/2, + load_dst_update/2, + load_address_dst_update/2, + load_atom_dst_update/2, + load_word_index_dst_update/2, + %% move_dst_update/2, + fixnumop_dst_update/2, + pp_instr/2, + %% pp_arg/2, + phi_arglist_update/2, + phi_redirect_pred/3]). + +%% +%% RTL +%% + +-record(rtl, {'fun', %% Name of the function (MFA) + arglist, %% List of argument names (formals) + is_closure, %% True if this is code for a closure. + is_leaf, %% True if this is a leaf function. + code, %% Linear list of RTL-instructions. + data, %% Data segment + var_range, %% {Min,Max} First and last name used for + %% regs, fpregs, or vars. + %% (they use a common namespace) + label_range, %% {Min,Max} First and last name used for labels + info=[] %% A keylist with arbitrary information. + }). + +mk_rtl(Fun, ArgList, Closure, Leaf, Code, Data, VarRange, LabelRange) -> + #rtl{'fun'=Fun, arglist=ArgList, code=Code, + data=Data, is_closure=Closure, is_leaf=Leaf, + var_range=VarRange, label_range=LabelRange}. +rtl_fun(#rtl{'fun'=Fun}) -> Fun. +rtl_params(#rtl{arglist=ArgList}) -> ArgList. +rtl_is_closure(#rtl{is_closure=Closure}) -> Closure. +rtl_is_leaf(#rtl{is_leaf=Leaf}) -> Leaf. +rtl_code(#rtl{code=Code}) -> Code. +rtl_code_update(Rtl, Code) -> Rtl#rtl{code=Code}. +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_update(Rtl, LabelRange) -> Rtl#rtl{label_range=LabelRange}. +rtl_info(#rtl{info=Info}) -> Info. +rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. + +%%----------------------------------------------------------------------------- + +-include("hipe_rtl.hrl"). + +%%----------------------------------------------------------------------------- + +%% +%% move +%% + +mk_move(Dst, Src) -> #move{dst=Dst, src=Src}. +move_dst(#move{dst=Dst}) -> Dst. +move_dst_update(M, NewDst) -> M#move{dst=NewDst}. +move_src(#move{src=Src}) -> Src. +move_src_update(M, NewSrc) -> M#move{src=NewSrc}. +%% is_move(#move{}) -> true; +%% is_move(_) -> false. + +%% +%% multimove +%% + +mk_multimove(DstList, SrcList) -> + case length(DstList) =:= length(SrcList) of + true -> true; + false -> + exit({?MODULE,mk_multimove, + {"different arities",{dstlist,DstList},{srclist,SrcList}}}) + end, + #multimove{dstlist=DstList, srclist=SrcList}. +multimove_dstlist(#multimove{dstlist=DstList}) -> DstList. +multimove_dstlist_update(M, NewDstList) -> M#multimove{dstlist=NewDstList}. +multimove_srclist(#multimove{srclist=SrcList}) -> SrcList. +multimove_srclist_update(M, NewSrcList) -> M#multimove{srclist=NewSrcList}. +%% is_multimove(#multimove{}) -> true; +%% is_multimove(_) -> false. + +%% +%% phi +%% + +%% The id field is not entirely redundant. It is used in mappings +%% in the SSA pass since the dst field can change. +mk_phi(Var) -> #phi{dst = Var, id = Var, arglist = []}. +%% mk_phi(Var, ArgList) -> #phi{dst = Var, id = Var, arglist = ArgList}. +phi_dst(#phi{dst=Dst}) -> Dst. +phi_dst_update(Phi, NewDst) -> Phi#phi{dst = NewDst}. +phi_id(#phi{id=Id}) -> Id. +phi_args(Phi) -> [X || {_,X} <- phi_arglist(Phi)]. +phi_arg(Phi, Pred) -> + case lists:keyfind(Pred, 1, phi_arglist(Phi)) of + false -> + exit({?MODULE,phi_arg,{"Uknown Phi predecessor",Phi,{pred,Pred}}}); + {_, Var} -> Var + end. +phi_arglist(#phi{arglist=ArgList}) -> ArgList. +phi_arglist_update(P,NewArgList) ->P#phi{arglist=NewArgList}. +is_phi(#phi{}) -> true; +is_phi(_) -> false. +phi_enter_pred(Phi, Pred, Var) -> + Phi#phi{arglist=[{Pred,Var}|lists:keydelete(Pred, 1, phi_arglist(Phi))]}. +phi_remove_pred(Phi, Pred) -> + NewArgList = lists:keydelete(Pred, 1, phi_arglist(Phi)), + case NewArgList of + [Arg] -> %% the phi should be turned into a move instruction + {_Label,Var} = Arg, + mk_move(phi_dst(Phi), Var); + %% io:format("~nPhi (~w) turned into move (~w) when removing pred ~w~n",[Phi,Move,Pred]), + [_|_] -> + Phi#phi{arglist=NewArgList} + end. +phi_argvar_subst(Phi, Subst) -> + NewArgList = [{Pred,subst1(Subst, Var)} || {Pred,Var} <- phi_arglist(Phi)], + Phi#phi{arglist=NewArgList}. +phi_redirect_pred(P, OldPred, NewPred)-> + Subst = [{OldPred, NewPred}], + NewArgList = [{subst1(Subst, Pred), Var} || {Pred,Var} <- phi_arglist(P)], + P#phi{arglist=NewArgList}. + + +%% +%% alu +%% + +mk_alu(Dst, Src1, Op, Src2) -> + #alu{dst=Dst, src1=Src1, op=Op, src2=Src2}. +alu_dst(#alu{dst=Dst}) -> Dst. +alu_dst_update(Alu, NewDst) -> Alu#alu{dst=NewDst}. +alu_src1(#alu{src1=Src1}) -> Src1. +alu_src1_update(Alu, NewSrc) -> Alu#alu{src1=NewSrc}. +alu_src2(#alu{src2=Src2}) -> Src2. +alu_src2_update(Alu, NewSrc) -> Alu#alu{src2=NewSrc}. +alu_op(#alu{op=Op}) -> Op. + +%% +%% load +%% + +mk_load(Dst, Src, Offset) -> mk_load(Dst, Src, Offset, word, unsigned). +mk_load(Dst, Src, Offset, Size, Sign) -> + ?ASSERT((Sign =:= unsigned) orelse (Sign =:= signed)), + ?ASSERT((Size =:= word) orelse (Size =:= int32) orelse + (Size =:= int16) orelse (Size =:= byte)), + #load{dst=Dst, src=Src, offset=Offset, size=Size, sign=Sign}. +load_dst(#load{dst=Dst}) -> Dst. +load_dst_update(L, NewDst) -> L#load{dst=NewDst}. +load_src(#load{src=Src}) -> Src. +load_src_update(L, NewSrc) -> L#load{src=NewSrc}. +load_offset(#load{offset=Offset}) -> Offset. +load_offset_update(L, NewOffset) -> L#load{offset=NewOffset}. +load_size(#load{size=Size}) -> Size. +load_sign(#load{sign=Sign}) -> Sign. + +%% +%% load_atom +%% + +mk_load_atom(Dst, Atom) -> #load_atom{dst=Dst,atom=Atom}. +load_atom_dst(#load_atom{dst=Dst}) -> Dst. +load_atom_dst_update(L, NewDst) -> L#load_atom{dst=NewDst}. +load_atom_atom(#load_atom{atom=Atom}) -> Atom. + +mk_load_word_index(Dst, Block, Index) -> + #load_word_index{dst=Dst, block=Block, index=Index}. +load_word_index_dst(#load_word_index{dst=Dst}) -> Dst. +load_word_index_dst_update(L, NewDst) -> L#load_word_index{dst=NewDst}. +load_word_index_block(#load_word_index{block=Block}) -> Block. +load_word_index_index(#load_word_index{index=Index}) -> Index. + +mk_goto_index(Block, Index, Labels) -> + #goto_index{block=Block, index=Index, labels=Labels}. +goto_index_block(#goto_index{block=Block}) -> Block. +goto_index_index(#goto_index{index=Index}) -> Index. +goto_index_labels(#goto_index{labels=Labels}) -> Labels. + +%% +%% load_address +%% + +mk_load_address(Dst, Addr, Type) -> + #load_address{dst=Dst, addr=Addr, type=Type}. +load_address_dst(#load_address{dst=Dst}) -> Dst. +load_address_dst_update(LA, NewDst) -> LA#load_address{dst=NewDst}. +load_address_addr(#load_address{addr=Addr}) -> Addr. +load_address_addr_update(LoadAddress, NewAdr) -> + LoadAddress#load_address{addr=NewAdr}. +load_address_type(#load_address{type=Type}) -> Type. +%% load_address_type_update(LA, NewType) -> LA#load_address{type=NewType}. + +%% +%% store +%% + +mk_store(Base, Offset, Src) -> mk_store(Base, Offset, Src, word). +mk_store(Base, Offset, Src, Size) -> + ?ASSERT((Size =:= word) orelse (Size =:= int32) orelse + (Size =:= int16) orelse (Size =:= byte)), + #store{base=Base, src=Src, offset=Offset, size=Size}. +store_base(#store{base=Base}) -> Base. +store_base_update(S, NewBase) -> S#store{base=NewBase}. +store_offset(#store{offset=Offset}) -> Offset. +store_offset_update(S, NewOffset) -> S#store{offset=NewOffset}. +store_src(#store{src=Src}) -> Src. +store_src_update(S, NewSrc) -> S#store{src=NewSrc}. +store_size(#store{size=Size}) -> Size. + +%% +%% label +%% + +mk_label(Name) -> #label{name=Name}. +mk_new_label() -> mk_label(hipe_gensym:get_next_label(rtl)). +label_name(#label{name=Name}) -> Name. +is_label(#label{}) -> true; +is_label(_) -> false. + +%% +%% branch +%% + +mk_branch(Src1, Op, Src2, True, False) -> + mk_branch(Src1, Op, Src2, True, False, 0.5). +mk_branch(Src1, Op, Src2, True, False, P) -> + #branch{src1=Src1, 'cond'=Op, src2=Src2, true_label=True, + false_label=False, p=P}. +branch_src1(#branch{src1=Src1}) -> Src1. +branch_src1_update(Br, NewSrc) -> Br#branch{src1=NewSrc}. +branch_src2(#branch{src2=Src2}) -> Src2. +branch_src2_update(Br, NewSrc) -> Br#branch{src2=NewSrc}. +branch_cond(#branch{'cond'=Cond}) -> Cond. +branch_true_label(#branch{true_label=TrueLbl}) -> TrueLbl. +branch_true_label_update(Br, NewTrue) -> Br#branch{true_label=NewTrue}. +branch_false_label(#branch{false_label=FalseLbl}) -> FalseLbl. +branch_false_label_update(Br, NewFalse) -> Br#branch{false_label=NewFalse}. +branch_pred(#branch{p=P}) -> P. + +%% +%% alub +%% + +mk_alub(Dst, Src1, Op, Src2, Cond, True, False) -> + mk_alub(Dst, Src1, Op, Src2, Cond, True, False, 0.5). +mk_alub(Dst, Src1, Op, Src2, Cond, True, False, P) -> + #alub{dst=Dst, src1=Src1, op=Op, src2=Src2, 'cond'=Cond, + true_label=True, false_label=False, p=P}. +alub_dst(#alub{dst=Dst}) -> Dst. +alub_dst_update(A, NewDst) -> A#alub{dst=NewDst}. +alub_src1(#alub{src1=Src1}) -> Src1. +alub_src1_update(A, NewSrc) -> A#alub{src1=NewSrc}. +alub_op(#alub{op=Op}) -> Op. +alub_src2(#alub{src2=Src2}) -> Src2. +alub_src2_update(A, NewSrc) -> A#alub{src2=NewSrc}. +alub_cond(#alub{'cond'=Cond}) -> Cond. +alub_true_label(#alub{true_label=TrueLbl}) -> TrueLbl. +alub_true_label_update(A, NewTrue) -> A#alub{true_label=NewTrue}. +alub_false_label(#alub{false_label=FalseLbl}) -> FalseLbl. +alub_false_label_update(A, NewFalse) -> A#alub{false_label=NewFalse}. +alub_pred(#alub{p=P}) -> P. + +%% +%% switch +%% + +mk_switch(Src, Labels) -> #switch{src=Src, labels=Labels}. +mk_sorted_switch(Src, Labels, Order) -> + #switch{src=Src, labels=Labels, sorted_by=Order}. +switch_src(#switch{src=Src}) -> Src. +switch_src_update(I, N) -> I#switch{src=N}. +switch_labels(#switch{labels=Labels}) -> Labels. +switch_labels_update(I,N) -> I#switch{labels=N}. +switch_sort_order(#switch{sorted_by=Order}) -> Order. +%% switch_sort_order_update(I,N) -> I#switch{sorted_by=N}. + +%% +%% goto +%% + +mk_goto(Label) -> #goto{label=Label}. +goto_label(#goto{label=Label}) -> Label. +goto_label_update(I, NewLabel) -> + I#goto{label=NewLabel}. +is_goto(#goto{}) -> true; +is_goto(_) -> false. + +%% +%% call +%% + +mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> + case Type of + remote -> ok; + not_remote -> ok + end, + #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, + continuation=Continuation, + failcontinuation=FailContinuation}. +call_dstlist(#call{dstlist=DstList}) -> DstList. +call_dstlist_update(C, NewDstList) -> C#call{dstlist=NewDstList}. +call_fun(#call{'fun'=Fun}) -> Fun. +call_fun_update(C, F) -> C#call{'fun'=F}. +call_arglist(#call{arglist=ArgList}) -> ArgList. +call_arglist_update(C, NewArgList) -> C#call{arglist=NewArgList}. +call_continuation(#call{continuation=Continuation}) -> Continuation. +call_fail(#call{failcontinuation=FailContinuation}) -> FailContinuation. +call_type(#call{type=Type}) -> Type. +call_continuation_update(C, NewCont) -> C#call{continuation=NewCont}. +call_fail_update(C, NewCont) -> C#call{failcontinuation=NewCont}. +is_call(#call{}) -> true; +is_call(_) -> false. +call_is_known(C) -> + Fun = call_fun(C), + call_or_enter_fun_is_known(Fun). + +call_or_enter_fun_is_known(Fun) -> + case is_atom(Fun) of + true -> true; %% make the expected common case fast + false -> + case is_reg(Fun) of + true -> false; + false -> + case is_var(Fun) of + true -> false; + false -> + case Fun of + {M,F,A} when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> + true; + {F,A} when is_atom(F), is_integer(A), A >= 0 -> + true; + _ -> %% colored versions of rtl_reg or rtl_var (used in SSA) + false + end + end + end + end. + +%% +%% enter +%% + +mk_enter(Fun, ArgList, Type) -> + case Type of + remote -> ok; + not_remote -> ok % {local,primop,closure,pointer} + end, + #enter{'fun'=Fun, arglist=ArgList, type=Type}. +enter_fun(#enter{'fun'=Fun}) -> Fun. +enter_fun_update(I, F) -> I#enter{'fun' = F}. +enter_arglist(#enter{arglist=ArgList}) -> ArgList. +enter_arglist_update(E, NewArgList) -> E#enter{arglist=NewArgList}. +enter_type(#enter{type=Type}) -> Type. +enter_is_known(E) -> + Fun = enter_fun(E), + call_or_enter_fun_is_known(Fun). + +%% +%% return +%% + +mk_return(VarList) -> #return{varlist=VarList}. +return_varlist(#return{varlist=VarList}) -> VarList. +return_varlist_update(R, NewVarList) -> R#return{varlist=NewVarList}. + +%% +%% gctests +%% + +mk_gctest(Words) when is_integer(Words) -> #gctest{words=mk_imm(Words)}; +mk_gctest(Reg) -> #gctest{words=Reg}. % This handles rtl_regs and rtl_vars +gctest_words(#gctest{words=Words}) -> Words. +gctest_words_update(S, NewWords) -> S#gctest{words=NewWords}. + + +%% +%% fixnumop +%% + +mk_fixnumop(Dst, Src, Type) -> + #fixnumop{dst=Dst, src=Src, type=Type}. +fixnumop_dst(#fixnumop{dst=Dst}) -> Dst. +fixnumop_dst_update(S, Dst) -> S#fixnumop{dst=Dst}. +fixnumop_src(#fixnumop{src=Src}) -> Src. +fixnumop_src_update(S, Src) -> S#fixnumop{src=Src}. +fixnumop_type(#fixnumop{type=Type}) -> Type. + +%% +%% comments +%% + +mk_comment(Text) -> #comment{text=Text}. +comment_text(#comment{text=Text}) -> Text. +is_comment(#comment{}) -> true; +is_comment(_) -> false. + +%%------------------------------------------------------------------------- +%% Floating point stuff. +%%------------------------------------------------------------------------- + +%% +%% fload +%% + +mk_fload(Dst, Src, Offset) -> #fload{dst=Dst, src=Src, offset=Offset}. +fload_dst(#fload{dst=Dst}) -> Dst. +fload_dst_update(L, NewDst) -> L#fload{dst=NewDst}. +fload_src(#fload{src=Src}) -> Src. +fload_src_update(L, NewSrc) -> L#fload{src=NewSrc}. +fload_offset(#fload{offset=Offset}) -> Offset. +fload_offset_update(L, NewOffset) -> L#fload{offset=NewOffset}. + +%% +%% fstore +%% + +mk_fstore(Base, Offset, Src) -> + #fstore{base=Base, offset=Offset, src=Src}. +fstore_base(#fstore{base=Base}) -> Base. +fstore_base_update(F, NewBase) -> F#fstore{base=NewBase}. +fstore_offset(#fstore{offset=Offset}) -> Offset. +fstore_offset_update(F, NewOff) -> F#fstore{offset=NewOff}. +fstore_src(#fstore{src=Src}) -> Src. +fstore_src_update(F, NewSrc) -> F#fstore{src=NewSrc}. + +%% +%% fp +%% + +mk_fp(Dst, Src1, Op, Src2) -> + #fp{dst=Dst, src1=Src1, op=Op, src2=Src2}. +fp_dst(#fp{dst=Dst}) -> Dst. +fp_dst_update(Fp, NewDst) -> Fp#fp{dst=NewDst}. +fp_src1(#fp{src1=Src1}) -> Src1. +fp_src1_update(Fp, NewSrc) -> Fp#fp{src1=NewSrc}. +fp_src2(#fp{src2=Src2}) -> Src2. +fp_src2_update(Fp, NewSrc) -> Fp#fp{src2=NewSrc}. +fp_op(#fp{op=Op}) -> Op. + +%% +%% fp_unop +%% + +mk_fp_unop(Dst, Src, Op) -> + #fp_unop{dst=Dst, src=Src, op=Op}. +fp_unop_dst(#fp_unop{dst=Dst}) -> Dst. +fp_unop_dst_update(Fp, NewDst) -> Fp#fp_unop{dst=NewDst}. +fp_unop_src(#fp_unop{src=Src}) -> Src. +fp_unop_src_update(Fp, NewSrc) -> Fp#fp_unop{src=NewSrc}. +fp_unop_op(#fp_unop{op=Op}) -> Op. + +%% +%% fmove +%% + +mk_fmove(X, Y) -> #fmove{dst=X, src=Y}. +fmove_dst(#fmove{dst=Dst}) -> Dst. +fmove_dst_update(M, NewDst) -> M#fmove{dst=NewDst}. +fmove_src(#fmove{src=Src}) -> Src. +fmove_src_update(M, NewSrc) -> M#fmove{src=NewSrc}. + +%% +%% fconv +%% + +mk_fconv(X, Y) -> #fconv{dst=X, src=Y}. +fconv_dst(#fconv{dst=Dst}) -> Dst. +fconv_dst_update(C, NewDst) -> C#fconv{dst=NewDst}. +fconv_src(#fconv{src=Src}) -> Src. +fconv_src_update(C, NewSrc) -> C#fconv{src=NewSrc}. + +%% +%% The values +%% +%% change_vars_to_regs(Vars) -> +%% change_vars_to_regs(Vars, []). +%% change_vars_to_regs([Var|Rest], Acc) -> +%% change_vars_to_regs(Rest,[change_var_to_reg(Var)|Acc]); +%% change_vars_to_regs([], Acc) -> +%% lists:reverse(Acc). +%% +%% change_var_to_reg(Var) -> +%% mk_reg(var_index(Var)). + +-record(rtl_reg, {index :: integer(), + is_gc_safe :: boolean()}). + +mk_reg(Num, IsGcSafe) when is_integer(Num), Num >= 0 -> + #rtl_reg{index=Num,is_gc_safe=IsGcSafe}. +mk_reg(Num) -> mk_reg(Num, false). +mk_reg_gcsafe(Num) -> mk_reg(Num, true). +mk_new_reg() -> mk_reg(hipe_gensym:get_next_var(rtl), false). +mk_new_reg_gcsafe() -> mk_reg(hipe_gensym:get_next_var(rtl), true). +reg_index(#rtl_reg{index=Index}) -> Index. +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()}). + +mk_var(Num) when is_integer(Num), Num >= 0 -> #rtl_var{index=Num}. +mk_new_var() -> mk_var(hipe_gensym:get_next_var(rtl)). +var_index(#rtl_var{index=Index}) -> Index. +is_var(#rtl_var{}) -> true; +is_var(_) -> false. + +-record(rtl_fpreg, {index :: non_neg_integer()}). + +mk_fpreg(Num) when is_integer(Num), Num >= 0 -> #rtl_fpreg{index=Num}. +mk_new_fpreg() -> mk_fpreg(hipe_gensym:get_next_var(rtl)). +fpreg_index(#rtl_fpreg{index=Index}) -> Index. +is_fpreg(#rtl_fpreg{}) -> true; +is_fpreg(_) -> false. + +-record(rtl_imm, {value}). + +mk_imm(Value) -> #rtl_imm{value=Value}. +imm_value(#rtl_imm{value=Value}) -> Value. +is_imm(#rtl_imm{}) -> true; +is_imm(_) -> false. + +-record(rtl_const_lbl, {label}). + +mk_const_label(Label) -> #rtl_const_lbl{label=Label}. +const_label_label(#rtl_const_lbl{label=Label}) -> Label. +is_const_label(#rtl_const_lbl{}) -> true; +is_const_label(_) -> false. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Utilities - no representation visible below this point +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% +%% @doc Returns the list of variables, constant labels and immediates +%% an RTL instruction uses. +%% + +uses(I) -> + remove_imms_and_const_lbls(args(I)). + +%% +%% @doc Returns the list of variables an RTL instruction uses. +%% + +args(I) -> + case I of + #alu{} -> [alu_src1(I), alu_src2(I)]; + #alub{} -> [alub_src1(I), alub_src2(I)]; + #branch{} -> [branch_src1(I), branch_src2(I)]; + #call{} -> + Args = call_arglist(I) ++ hipe_rtl_arch:call_used(), + case call_is_known(I) of + false -> [call_fun(I) | Args]; + true -> Args + end; + #comment{} -> []; + #enter{} -> + Args = enter_arglist(I) ++ hipe_rtl_arch:tailcall_used(), + case enter_is_known(I) of + false -> [enter_fun(I) | Args]; + true -> Args + end; + #fconv{} -> [fconv_src(I)]; + #fixnumop{} -> [fixnumop_src(I)]; + #fload{} -> [fload_src(I), fload_offset(I)]; + #fmove{} -> [fmove_src(I)]; + #fp{} -> [fp_src1(I), fp_src2(I)]; + #fp_unop{} -> [fp_unop_src(I)]; + #fstore{} -> [fstore_base(I), fstore_offset(I), fstore_src(I)]; + #goto{} -> []; + #goto_index{} -> []; + #gctest{} -> [gctest_words(I)]; + #label{} -> []; + #load{} -> [load_src(I), load_offset(I)]; + #load_address{} -> []; + #load_atom{} -> []; + #load_word_index{} -> []; + #move{} -> [move_src(I)]; + #multimove{} -> multimove_srclist(I); + #phi{} -> phi_args(I); + #return{} -> return_varlist(I) ++ hipe_rtl_arch:return_used(); + #store{} -> [store_base(I), store_offset(I), store_src(I)]; + #switch{} -> [switch_src(I)] + end. + +%% +%% @doc Returns a list of variables that an RTL instruction defines. +%% + +defines(Instr) -> + Defs = case Instr of + #alu{} -> [alu_dst(Instr)]; + #alub{} -> [alub_dst(Instr)]; + #branch{} -> []; + #call{} -> call_dstlist(Instr) ++ hipe_rtl_arch:call_defined(); + #comment{} -> []; + #enter{} -> []; + #fconv{} -> [fconv_dst(Instr)]; + #fixnumop{} -> [fixnumop_dst(Instr)]; + #fload{} -> [fload_dst(Instr)]; + #fmove{} -> [fmove_dst(Instr)]; + #fp{} -> [fp_dst(Instr)]; + #fp_unop{} -> [fp_unop_dst(Instr)]; + #fstore{} -> []; + #gctest{} -> []; + #goto{} -> []; + #goto_index{} -> []; + #label{} -> []; + #load{} -> [load_dst(Instr)]; + #load_address{} -> [load_address_dst(Instr)]; + #load_atom{} -> [load_atom_dst(Instr)]; + #load_word_index{} -> [load_word_index_dst(Instr)]; + #move{} -> [move_dst(Instr)]; + #multimove{} -> multimove_dstlist(Instr); + #phi{} -> [phi_dst(Instr)]; + #return{} -> []; + #store{} -> []; + #switch{} -> [] + end, + remove_imms_and_const_lbls(Defs). + +%% @spec remove_imms_and_const_lbls([rtl_argument()]) -> [rtl_argument()] +%% +%% @doc Removes all RTL immediates and constant labels from a list of arguments. + +remove_imms_and_const_lbls([]) -> + []; +remove_imms_and_const_lbls([Arg|Args]) -> + case is_imm(Arg) orelse is_const_label(Arg) of + true -> remove_imms_and_const_lbls(Args); + false -> [Arg | remove_imms_and_const_lbls(Args)] + end. + +%% +%% Substitution: replace occurrences of X by Y if {X,Y} is in Subst. +%% +%% subst(Subst, X) -> +%% subst_defines(Subst, subst_uses(Subst,X)). + +subst_uses(Subst, I) -> + case I of + #alu{} -> + I0 = alu_src1_update(I, subst1(Subst, alu_src1(I))), + alu_src2_update(I0, subst1(Subst, alu_src2(I))); + #alub{} -> + I0 = alub_src1_update(I, subst1(Subst, alub_src1(I))), + alub_src2_update(I0, subst1(Subst, alub_src2(I))); + #branch{} -> + I0 = branch_src1_update(I, subst1(Subst, branch_src1(I))), + branch_src2_update(I0, subst1(Subst, branch_src2(I))); + #call{} -> + case call_is_known(I) of + false -> + I0 = call_fun_update(I, subst1(Subst, call_fun(I))), + call_arglist_update(I0, subst_list(Subst, call_arglist(I0))); + true -> + call_arglist_update(I, subst_list(Subst, call_arglist(I))) + end; + #comment{} -> + I; + #enter{} -> + case enter_is_known(I) of + false -> + I0 = enter_fun_update(I, subst1(Subst, enter_fun(I))), + enter_arglist_update(I0, subst_list(Subst, enter_arglist(I0))); + true -> + enter_arglist_update(I, subst_list(Subst, enter_arglist(I))) + end; + #fconv{} -> + fconv_src_update(I, subst1(Subst, fconv_src(I))); + #fixnumop{} -> + fixnumop_src_update(I, subst1(Subst, fixnumop_src(I))); + #fload{} -> + I0 = fload_src_update(I, subst1(Subst, fload_src(I))), + fload_offset_update(I0, subst1(Subst, fload_offset(I))); + #fmove{} -> + fmove_src_update(I, subst1(Subst, fmove_src(I))); + #fp{} -> + I0 = fp_src1_update(I, subst1(Subst, fp_src1(I))), + fp_src2_update(I0, subst1(Subst, fp_src2(I))); + #fp_unop{} -> + fp_unop_src_update(I, subst1(Subst, fp_unop_src(I))); + #fstore{} -> + I0 = fstore_src_update(I, subst1(Subst, fstore_src(I))), + I1 = fstore_base_update(I0, subst1(Subst, fstore_base(I))), + fstore_offset_update(I1, subst1(Subst, fstore_offset(I))); + #goto{} -> + I; + #goto_index{} -> + I; + #gctest{} -> + gctest_words_update(I, subst1(Subst, gctest_words(I))); + #label{} -> + I; + #load{} -> + I0 = load_src_update(I, subst1(Subst, load_src(I))), + load_offset_update(I0, subst1(Subst, load_offset(I))); + #load_address{} -> + I; + #load_atom{} -> + I; + #load_word_index{} -> + I; + #move{} -> + move_src_update(I, subst1(Subst, move_src(I))); + #multimove{} -> + multimove_srclist_update(I, subst_list(Subst, multimove_srclist(I))); + #phi{} -> + phi_argvar_subst(I, Subst); + #return{} -> + return_varlist_update(I, subst_list(Subst, return_varlist(I))); + #store{} -> + I0 = store_src_update(I, subst1(Subst, store_src(I))), + I1 = store_base_update(I0, subst1(Subst, store_base(I))), + store_offset_update(I1, subst1(Subst, store_offset(I))); + #switch{} -> + switch_src_update(I, subst1(Subst, switch_src(I))) + end. + +subst_defines(Subst, I)-> + case I of + #alu{} -> + alu_dst_update(I, subst1(Subst, alu_dst(I))); + #alub{} -> + alub_dst_update(I, subst1(Subst, alub_dst(I))); + #branch{} -> + I; + #call{} -> + call_dstlist_update(I, subst_list(Subst, call_dstlist(I))); + #comment{} -> + I; + #enter{} -> + I; + #fconv{} -> + fconv_dst_update(I, subst1(Subst, fconv_dst(I))); + #fixnumop{} -> + fixnumop_dst_update(I, subst1(Subst, fixnumop_dst(I))); + #fload{} -> + fload_dst_update(I, subst1(Subst, fload_dst(I))); + #fmove{} -> + fmove_dst_update(I, subst1(Subst, fmove_dst(I))); + #fp{} -> + fp_dst_update(I, subst1(Subst, fp_dst(I))); + #fp_unop{} -> + fp_unop_dst_update(I, subst1(Subst, fp_unop_dst(I))); + #fstore{} -> + I; + #gctest{} -> + I; + #goto{} -> + I; + #goto_index{} -> + I; + #label{} -> + I; + #load{} -> + load_dst_update(I, subst1(Subst, load_dst(I))); + #load_address{} -> + load_address_dst_update(I, subst1(Subst, load_address_dst(I))); + #load_atom{} -> + load_atom_dst_update(I, subst1(Subst, load_atom_dst(I))); + #load_word_index{} -> + load_word_index_dst_update(I, subst1(Subst, load_word_index_dst(I))); + #move{} -> + move_dst_update(I, subst1(Subst, move_dst(I))); + #multimove{} -> + multimove_dstlist_update(I, subst_list(Subst, multimove_dstlist(I))); + #phi{} -> + phi_dst_update(I, subst1(Subst, phi_dst(I))); + #return{} -> + I; + #store{} -> + I; + #switch{} -> + I + end. + +subst_list(S, Xs) -> + [subst1(S, X) || X <- Xs]. + +subst1([], X) -> X; +subst1([{X,Y}|_], X) -> Y; +subst1([_|Xs], X) -> subst1(Xs,X). + +%% @spec is_safe(rtl_instruction()) -> boolean() +%% +%% @doc Succeeds if an RTL instruction is safe and can be deleted if the +%% result is not used. + +is_safe(Instr) -> + case Instr of + #alu{} -> true; + #alub{} -> false; + #branch{} -> false; + #call{} -> false; + #comment{} -> false; + #enter{} -> false; + #fconv{} -> true; + #fixnumop{} -> true; + #fload{} -> true; + #fmove{} -> true; + #fp{} -> false; + #fp_unop{} -> false; + #fstore{} -> false; + #gctest{} -> false; + #goto{} -> false; + #goto_index{} -> false; % ??? + #label{} -> true; + #load{} -> true; + #load_address{} -> true; + #load_atom{} -> true; + #load_word_index{} -> true; + #move{} -> true; + #multimove{} -> true; + #phi{} -> true; + #return{} -> false; + #store{} -> false; + #switch{} -> false %% Maybe this is safe... + end. + +%% +%% True if argument is an alu-operator +%% + +%% is_alu_op(add) -> true; +%% is_alu_op(sub) -> true; +%% is_alu_op('or') -> true; +%% is_alu_op('and') -> true; +%% is_alu_op('xor') -> true; +%% is_alu_op(andnot) -> true; +%% is_alu_op(sll) -> true; +%% is_alu_op(srl) -> true; +%% is_alu_op(sra) -> true; +%% is_alu_op(_) -> false. + +%% @spec is_shift_op(rtl_operator()) -> boolean() +%% +%% @doc Succeeds if its argument is an RTL operator. +is_shift_op(sll) -> true; +is_shift_op(srl) -> true; +is_shift_op(sra) -> true; +is_shift_op(_) -> false. + + +%% +%% True if argument is an relational operator +%% + +%% is_rel_op(eq) -> true; +%% is_rel_op(ne) -> true; +%% is_rel_op(gt) -> true; +%% is_rel_op(gtu) -> true; +%% is_rel_op(ge) -> true; +%% is_rel_op(geu) -> true; +%% is_rel_op(lt) -> true; +%% is_rel_op(ltu) -> true; +%% is_rel_op(le) -> true; +%% is_rel_op(leu) -> true; +%% is_rel_op(overflow) -> true; +%% is_rel_op(not_overflow) -> true; +%% is_rel_op(_) -> false. + +redirect_jmp(Jmp, ToOld, ToNew) -> + %% OBS: In a jmp instruction more than one labels may be identical + %% and thus need redirection! + case Jmp of + #branch{} -> + TmpJmp = case branch_true_label(Jmp) of + ToOld -> branch_true_label_update(Jmp, ToNew); + _ -> Jmp + end, + case branch_false_label(TmpJmp) of + ToOld -> + branch_false_label_update(TmpJmp, ToNew); + _ -> + TmpJmp + end; + #switch{} -> + NewLbls = [case Lbl =:= ToOld of + true -> ToNew; + false -> Lbl + end || Lbl <- switch_labels(Jmp)], + switch_labels_update(Jmp, NewLbls); + #alub{} -> + TmpJmp = case alub_true_label(Jmp) of + ToOld -> alub_true_label_update(Jmp, ToNew); + _ -> Jmp + end, + case alub_false_label(TmpJmp) of + ToOld -> alub_false_label_update(TmpJmp, ToNew); + _ -> TmpJmp + end; + #goto{} -> + case goto_label(Jmp) of + ToOld -> goto_label_update(Jmp, ToNew); + _ -> Jmp + end; + #call{} -> + TmpJmp = case call_continuation(Jmp) of + ToOld -> call_continuation_update(Jmp, ToNew); + _ -> Jmp + end, + case call_fail(TmpJmp) of + ToOld -> call_fail_update(TmpJmp, ToNew); + _ -> TmpJmp + end; + _ -> + Jmp + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% highest_var(Code) -> +%% highest_var(Code,0). +%% +%% highest_var([I|Is],Max) -> +%% Defs = defines(I), +%% Uses = uses(I), +%% highest_var(Is,new_max(Defs++Uses,Max)); +%% highest_var([],Max) -> +%% Max. +%% +%% new_max([V|Vs],Max) -> +%% VName = +%% case is_var(V) of +%% true -> +%% var_index(V); +%% false -> +%% case is_fpreg(V) of +%% true -> +%% fpreg_index(V); +%% _ -> +%% reg_index(V) +%% end +%% end, +%% if VName > Max -> +%% new_max(Vs, VName); +%% true -> +%% new_max(Vs, Max) +%% end; +%% new_max([],Max) -> +%% Max. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% @doc Pretty-printer for RTL. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +pp(Rtl) -> + pp(standard_io, Rtl). + +pp_block(Instrs) -> + pp_instrs(standard_io, Instrs). + +pp(Dev, Rtl) -> + io:format(Dev, "~w(", [rtl_fun(Rtl)]), + pp_args(Dev, rtl_params(Rtl)), + io:format(Dev, ") ->~n", []), + case rtl_is_closure(Rtl) of + true -> + io:format(Dev, ";; Closure\n", []); + false -> ok + end, + case rtl_is_leaf(Rtl) of + true -> + io:format(Dev, ";; Leaf function\n", []); + false -> ok + end, + io:format(Dev, ";; Info: ~w\n", [rtl_info(Rtl)]), + io:format(Dev, ".DataSegment\n", []), + hipe_data_pp:pp(Dev, rtl_data(Rtl), rtl, ""), + io:format(Dev, ".CodeSegment\n", []), + pp_instrs(Dev, rtl_code(Rtl)). + +pp_instrs(_Dev, []) -> + ok; +pp_instrs(Dev, [I|Is]) -> + try pp_instr(Dev, I) + catch _:_ -> io:format("*** ~w ***\n", [I]) + end, + pp_instrs(Dev, Is). + +pp_instr(Dev, I) -> + case I of + #phi{} -> + io:format(Dev, " ", []), + pp_arg(Dev, phi_dst(I)), + io:format(Dev, " <- phi(", []), + pp_phi_args(Dev, phi_arglist(I)), + io:format(Dev, ")~n", []); + #move{} -> + io:format(Dev, " ", []), + pp_arg(Dev, move_dst(I)), + io:format(Dev, " <- ", []), + pp_arg(Dev, move_src(I)), + io:format(Dev, "~n", []); + #multimove{} -> + io:format(Dev, " ", []), + pp_args(Dev, multimove_dstlist(I)), + io:format(Dev, " <= ", []), + pp_args(Dev, multimove_srclist(I)), + io:format(Dev, "~n", []); + #alu{} -> + io:format(Dev, " ", []), + pp_arg(Dev, alu_dst(I)), + io:format(Dev, " <- ", []), + pp_arg(Dev, alu_src1(I)), + io:format(Dev, " ~w ", [alu_op(I)]), + pp_arg(Dev, alu_src2(I)), + io:format(Dev, "~n", []); + #load{} -> + io:format(Dev, " ", []), + pp_arg(Dev, load_dst(I)), + io:format(Dev, " <- [", []), + pp_arg(Dev, load_src(I)), + io:format(Dev, "+", []), + pp_arg(Dev, load_offset(I)), + io:format(Dev, "]", []), + case load_sign(I) of + signed -> io:format(Dev, " -signed",[]); + _ -> ok + end, + case load_size(I) of + byte -> io:format(Dev, " -byte",[]); + int16 -> io:format(Dev, " -int16",[]); + int32 -> io:format(Dev, " -int32",[]); + _ -> ok + end, + io:format(Dev, "~n", []); + #load_atom{} -> + io:format(Dev, " ", []), + pp_arg(Dev, load_atom_dst(I)), + io:format(Dev, " <- atom_no(\'~s\')~n", [load_atom_atom(I)]); + #load_word_index{} -> + io:format(Dev, " ", []), + pp_arg(Dev, load_word_index_dst(I)), + io:format(Dev, " <- word_index_no( DL~p[~p] )~n", + [load_word_index_block(I),load_word_index_index(I)]); + #goto_index{} -> + io:format(Dev, " ", []), + io:format(Dev, "goto_index DL~p[~p]~n", + [goto_index_block(I), goto_index_index(I)]); + #load_address{} -> + io:format(Dev, " ", []), + pp_arg(Dev, load_address_dst(I)), + case load_address_type(I) of + constant -> + io:format(Dev, " <- DL~p~n", [load_address_addr(I)]); + closure -> + io:format(Dev, " <- L~p [closure]~n", [load_address_addr(I)]); + Type -> + io:format(Dev, " <- L~p [~p]~n", [load_address_addr(I),Type]) + end; + #store{} -> + io:format(Dev, " [", []), + pp_arg(Dev, store_base(I)), + io:format(Dev, "+", []), + pp_arg(Dev, store_offset(I)), + io:format(Dev, "] <- ", []), + pp_arg(Dev, store_src(I)), + case store_size(I) of + byte -> io:format(Dev, " -byte",[]); + int16 -> io:format(Dev, " -int16",[]); + int32 -> io:format(Dev, " -int32",[]); + _ -> ok + end, + io:format(Dev, "~n", []); + #label{} -> + io:format(Dev, "L~w:~n", [label_name(I)]); + #branch{} -> + io:format(Dev, " if (", []), + pp_arg(Dev, branch_src1(I)), + io:format(Dev, " ~w ", [branch_cond(I)]), + pp_arg(Dev, branch_src2(I)), + io:format(Dev, ") then L~w (~.2f) else L~w~n", + [branch_true_label(I), branch_pred(I), branch_false_label(I)]); + #switch{} -> + io:format(Dev, " switch (", []), + pp_arg(Dev, switch_src(I)), + io:format(Dev, ") <", []), + pp_switch_labels(Dev, switch_labels(I)), + io:format(Dev, ">\n", []); + #alub{} -> + io:format(Dev, " ", []), + pp_arg(Dev, alub_dst(I)), + io:format(Dev, " <- ", []), + pp_arg(Dev, alub_src1(I)), + io:format(Dev, " ~w ", [alub_op(I)]), + pp_arg(Dev, alub_src2(I)), + io:format(Dev, " if",[]), + io:format(Dev, " ~w ", [alub_cond(I)]), + io:format(Dev, "then L~w (~.2f) else L~w~n", + [alub_true_label(I), alub_pred(I), alub_false_label(I)]); + #goto{} -> + io:format(Dev, " goto L~w~n", [goto_label(I)]); + #call{} -> + io:format(Dev, " ", []), + pp_args(Dev, call_dstlist(I)), + io:format(Dev, " <- ", []), + case call_is_known(I) of + true -> + case call_fun(I) of + F when is_atom(F) -> + io:format(Dev, "~w(", [F]); + {M,F,A} when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> + io:format(Dev, "~w:~w(", [M, F]); + {F,A} when is_atom(F), is_integer(A), A >=0 -> + io:format(Dev, "~w(", [F]) + end; + false -> + io:format(Dev, "(",[]), + pp_arg(Dev, call_fun(I)), + io:format(Dev, ")(",[]) + end, + pp_args(Dev, call_arglist(I)), + io:format(Dev, ")", []), + case call_continuation(I) of + [] -> true; + CC -> + io:format(Dev, " then L~w", [CC]) + end, + case call_fail(I) of + [] -> true; + L -> + io:format(Dev, " fail to L~w", [L]) + end, + io:format(Dev, "~n", []); + #enter{} -> + io:format(Dev, " ", []), + case enter_is_known(I) of + true -> + case enter_fun(I) of + F when is_atom(F) -> + io:format(Dev, "~w(", [F]); + {M,F,A} when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> + io:format(Dev, "~w:~w(", [M, F]); + {F,A} when is_atom(F), is_integer(A), A >= 0 -> + io:format(Dev, "~w(", [F]) + end; + false -> + io:format(Dev, "(",[]), + pp_arg(Dev, enter_fun(I)), + io:format(Dev, ")(",[]) + end, + pp_args(Dev, enter_arglist(I)), + io:format(Dev, ")~n", []); + #return{} -> + io:format(Dev, " return(", []), + pp_args(Dev, return_varlist(I)), + io:format(Dev, ")~n", []); + #comment{} -> + io:format(Dev, " ;; ~p~n", [comment_text(I)]); + #fixnumop{} -> + io:format(Dev, " ", []), + pp_arg(Dev, fixnumop_dst(I)), + io:format(Dev, " <- ", []), + case fixnumop_type(I) of + tag -> + io:format(Dev, "fixnum_tag(", []); + untag -> + io:format(Dev, "fixnum_untag(", []) + end, + pp_arg(Dev, fixnumop_src(I)), + io:format(Dev, ")~n", []); + #gctest{} -> + io:format(Dev, " gctest(", []), + pp_arg(Dev, gctest_words(I)), + io:format(Dev, ")~n", []); + %% Floating point handling instructions below + #fload{} -> + io:format(Dev, " ", []), + pp_arg(Dev, fload_dst(I)), + io:format(Dev, " <-f [", []), + pp_arg(Dev, fload_src(I)), + io:format(Dev, "+", []), + pp_arg(Dev, fload_offset(I)), + io:format(Dev, "]~n", []); + #fstore{} -> + io:format(Dev, " [", []), + pp_arg(Dev, fstore_base(I)), + io:format(Dev, "+", []), + pp_arg(Dev, fstore_offset(I)), + io:format(Dev, "] <- ", []), + pp_arg(Dev, fstore_src(I)), + io:format(Dev, "~n", []); + #fp{} -> + io:format(Dev, " ", []), + pp_arg(Dev, fp_dst(I)), + io:format(Dev, " <- ", []), + pp_arg(Dev, fp_src1(I)), + io:format(Dev, " ~w ", [fp_op(I)]), + pp_arg(Dev, fp_src2(I)), + io:format(Dev, "~n", []); + #fp_unop{} -> + io:format(Dev, " ", []), + pp_arg(Dev, fp_unop_dst(I)), + io:format(Dev, " <- ", []), + io:format(Dev, " ~w ", [fp_unop_op(I)]), + pp_arg(Dev, fp_unop_src(I)), + io:format(Dev, "~n", []); + #fmove{} -> + io:format(Dev, " ", []), + pp_arg(Dev, fmove_dst(I)), + io:format(Dev, " <- ", []), + pp_arg(Dev, fmove_src(I)), + io:format(Dev, "~n", []); + #fconv{} -> + io:format(Dev, " ", []), + pp_arg(Dev, fconv_dst(I)), + io:format(Dev, " <-fconv ", []), + pp_arg(Dev, fconv_src(I)), + io:format(Dev, "~n", []); + Other -> + exit({?MODULE,pp_instr,{"unknown RTL instruction",Other}}) + end. + +pp_args(_Dev, []) -> + ok; +pp_args(Dev, [A]) -> + pp_arg(Dev, A); +pp_args(Dev, [A|As]) -> + pp_arg(Dev, A), + io:format(Dev, ", ", []), + pp_args(Dev, As). + +pp_phi_args(_Dev, []) -> ok; +pp_phi_args(Dev, [{Pred,A}]) -> + io:format(Dev, "{~w, ", [Pred]), + pp_arg(Dev, A), + io:format(Dev, "}", []); +pp_phi_args(Dev, [{Pred,A}|Args]) -> + io:format(Dev, "{~w, ", [Pred]), + pp_arg(Dev, A), + io:format(Dev, "}, ", []), + pp_phi_args(Dev, Args); +pp_phi_args(Dev, Args) -> + pp_args(Dev, Args). + +pp_hard_reg(Dev, N) -> + io:format(Dev, "~s", [hipe_rtl_arch:reg_name(N)]). + +pp_reg(Dev, Arg) -> + case hipe_rtl_arch:is_precoloured(Arg) of + true -> + pp_hard_reg(Dev, reg_index(Arg)); + false -> + io:format(Dev, "r~w", [reg_index(Arg)]) + end. + +pp_var(Dev, Arg) -> + case hipe_rtl_arch:is_precoloured(Arg) of + true -> + pp_hard_reg(Dev, var_index(Arg)); + false -> + io:format(Dev, "v~w", [var_index(Arg)]) + end. + +pp_arg(Dev, A) -> + case is_var(A) of + true -> + pp_var(Dev, A); + false -> + case is_reg(A) of + true -> + pp_reg(Dev, A); + false -> + case is_imm(A) of + true -> + io:format(Dev, "~w", [imm_value(A)]); + false -> + case is_fpreg(A) of + true -> + io:format(Dev, "f~w", [fpreg_index(A)]); + false -> + case is_const_label(A) of + true -> + io:format(Dev, "DL~w", [const_label_label(A)]); + false -> + exit({?MODULE,pp_arg,{"bad RTL arg",A}}) + end + end + end + end + end. + +pp_switch_labels(Dev,Lbls) -> + pp_switch_labels(Dev,Lbls,1). + +pp_switch_labels(Dev, [L], _Pos) -> + io:format(Dev, "L~w", [L]); +pp_switch_labels(Dev, [L|Ls], Pos) -> + io:format(Dev, "L~w, ", [L]), + NewPos = + case Pos of + 5 -> io:format(Dev, "\n ",[]), + 0; + N -> N + 1 + end, + pp_switch_labels(Dev, Ls, NewPos); +pp_switch_labels(_Dev, [], _) -> + ok. |