path: root/lib/hipe/rtl/hipe_rtl.erl

%% -*- 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]).

-export_type([alub_cond/0]).

%%
%% 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
%%

-type alub_cond() :: 'eq' | 'ne' | 'ge' | 'geu' | 'gt' | 'gtu' | 'le'
                   | 'leu' | 'lt' | 'ltu' | 'overflow' | 'not_overflow'.

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.