aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/rtl/hipe_rtl.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/hipe/rtl/hipe_rtl.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/hipe/rtl/hipe_rtl.erl')
-rw-r--r--lib/hipe/rtl/hipe_rtl.erl1655
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.