aboutsummaryrefslogblamecommitdiffstats
path: root/lib/hipe/icode/hipe_beam_to_icode.erl
blob: 7ff9fd83eb6b9c4d4746fbf9cdcad7b99cb0eb5c (plain) (tree)
1
2
3
4
5
6
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995

                                 


                                                                   
  






                                                                           
  




                                                                         








                                                                         
                    








                                                                         


                                     









                                               




















                                                                  















                                                                                                                    


        

                                                                         
        



                                                                         
































                                                                             















                                                                         
                                                                       

                                                

                                                                   






                                    















                                                              

                                                                
 
                                     
           
                                        











                                                                      
                                           






                                                       
                                                                              



                                                     
                                                      

















                                                                          

                                                                 


                      
                                          






                                                              
                     





                          






                                                                                








                                                                         


                                                                  



                                                                       
                    










































































                                                                            
                                        


                                                                      
                                           


                                                                        
                                           


                                                                          
                                           



























































                                                                              
                                  
                                                   

                                               
                                                  

                                             







































































                                                                        




















                                                                       












                                                                                



                                                             
























































































































































































                                                                                    
                                                 






























































                                                                                                         
                             
                     

                                                                  










                                                                           
                              









                                                                           
                              































                                                                            
                                                         




                                                                           
                              














                                                                               
                              










                                                                       


                                                                        








                                                                     








                                                                     




                                                                        

                        


                                                                    

                        
               

                                                      
        



                                                                         






































































































































                                                                                                 
                                                 














                                                                               
                                               





                                                                      
                                                                  





                                                                         
                                                        
















                                                                             
                                               





                                                                      
                                                         





                                                                      
                                             



                                                                      















                                                                               

























                                                                                 




                                                       
                                                                      








































































































































                                                                                                 
                                                                   




























































                                                                                          
                                                                

















































                                                                                                      
                                                             































































































                                                                                    



                                              







                                                                         
                                                          










                                                                         
                                                                  









                                                                      


















                                                                               

















                                                                                       
                          






                                                                     
                                                   

                                                                  
                                                      




























                                                                         






                                                                               













                                                                                

                                                                         
                                        























































































































































































































































































































































                                                                                       

                            




                                                                 







































































































































                                                                          





                                        








































































































































































                                                                              





                                                                          

































































































































                                                                         
%% -*- erlang-indent-level: 2 -*-
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%%=======================================================================
%% File        : hipe_beam_to_icode.erl
%% Author      : Kostis Sagonas
%% Description : Translates symbolic BEAM code to Icode
%%=======================================================================
%% @doc
%%    This file translates symbolic BEAM code to Icode which is HiPE's
%%    intermediate code representation.  Either the code of an entire
%%    module, or the code of a specified function can be translated.
%% @end
%%=======================================================================

-module(hipe_beam_to_icode).

-export([module/2]).

%%-----------------------------------------------------------------------

%% Uncomment the following lines to turn on debugging for this module
%% or comment them to it turn off.  Debug-level 6 inserts a print in
%% each compiled function.
%%
%%-ifndef(DEBUG).
%%-define(DEBUG,6).
%% Choose one of two tracing methods
%%-define(DEBUG_BIF_CALL_TRACE,true).
%%-define(IO_FORMAT_CALL_TRACE,true).
%%-endif.

-include("../main/hipe.hrl").
-include("hipe_icode.hrl").
-include("hipe_icode_primops.hrl").
-include("../../compiler/src/beam_disasm.hrl").

-define(no_debug_msg(Str,Xs),ok).
%%-define(no_debug_msg(Str,Xs),msg(Str,Xs)).

-ifdef(DEBUG_BIF_CALL_TRACE).

%% Use BIF hipe_bifs_debug_native_called_2 to trace function calls
mk_debug_calltrace({_M,_F,A}=MFA, Env, Code) ->
    MFAVar = mk_var(new),
    Ignore = mk_var(new),    
    MkMfa = hipe_icode:mk_move(MFAVar,hipe_icode:mk_const(MFA)),
    Args = [mk_var({x,I-1}) || I <- lists:seq(1,A)],
    ArgTup = mk_var(new),
    MkArgTup = hipe_icode:mk_primop([ArgTup], mktuple, Args),
    Call = hipe_icode:mk_primop([Ignore], debug_native_called,
				[MFAVar,ArgTup]),
    {[MkMfa,MkArgTup,Call | Code], Env}.

-endif.

-ifdef(IO_FORMAT_CALL_TRACE).

%% Use io:format to trace function calls
mk_debug_calltrace(MFA, Env, Code) ->
    case MFA of
	  {io,_,_} ->
	    %% We do not want to loop infinitely if we are compiling
	    %% the module io.
	    {Code,Env};
	  {M,F,A} ->
	    MFAVar = mk_var(new),
	    StringVar = mk_var(new),
	    Ignore = mk_var(new),
	    MkMfa = hipe_icode:mk_move(MFAVar,hipe_icode:mk_const([MFA])),
	    MkString = hipe_icode:mk_move(StringVar,
					  hipe_icode:mk_const(
					    atom_to_list(M) ++ ":" ++ atom_to_list(F) ++"/"++ integer_to_list(A) ++ 
					    " Native enter fun ~w\n")),
	    Call =
	      hipe_icode:mk_call([Ignore],io,format,[StringVar,MFAVar],remote),
	    {[MkMfa,MkString,Call | Code], Env}
    end.
-endif.


%%-----------------------------------------------------------------------
%% Types
%%-----------------------------------------------------------------------

-type hipe_beam_to_icode_ret() :: [{mfa(),#icode{}}].

%%-----------------------------------------------------------------------
%% Internal data structures
%%-----------------------------------------------------------------------

-record(beam_const, {value :: simple_const()}). % defined in hipe_icode.hrl

-record(closure_info, {mfa :: mfa(), arity :: arity(), fv_arity :: arity()}).

-record(environment, {mfa :: mfa(), entry :: non_neg_integer()}).


%%-----------------------------------------------------------------------
%% @doc
%% Translates the code of a whole module into Icode.
%%   Returns a tuple whose first argument is a list of {{M,F,A}, ICode} 
%%   pairs, and its second argument is the list of HiPE compiler options.
%% @end
%%-----------------------------------------------------------------------

-spec module([#function{}], comp_options()) -> hipe_beam_to_icode_ret().

module(BeamFuns, Options) ->
  BeamCode0 = [beam_disasm:function__code(F) || F <- BeamFuns],
  {ModCode, ClosureInfo} = preprocess_code(BeamCode0),
  pp_beam(ModCode, Options),
  [trans_beam_function_chunk(FunCode, ClosureInfo) || FunCode <- ModCode].

trans_beam_function_chunk(FunBeamCode, ClosureInfo) ->
  {M,F,A} = MFA = find_mfa(FunBeamCode),
  Icode = trans_mfa_code(M,F,A, FunBeamCode, ClosureInfo),
  {MFA,Icode}.

%%-----------------------------------------------------------------------
%% The main translation function.
%%-----------------------------------------------------------------------

trans_mfa_code(M,F,A, FunBeamCode, ClosureInfo) ->
  ?no_debug_msg("disassembling: {~p,~p,~p} ...", [M,F,A]),
  hipe_gensym:init(icode),
  %% Extract the function arguments
  FunArgs = extract_fun_args(A),
  %% Record the function arguments
  FunLbl = mk_label(new),
  Env1 = env__mk_env(M, F, A, hipe_icode:label_name(FunLbl)),
  Code1 = lists:flatten(trans_fun(FunBeamCode,Env1)),
  Code2 = fix_fallthroughs(fix_catches(Code1)),
  MFA = {M,F,A},
  %% Debug code
  ?IF_DEBUG_LEVEL(5,
		  {Code3,_Env3} = mk_debug_calltrace(MFA, Env1, Code2),
		  {Code3,_Env3} = {Code2,Env1}),
  %% For stack optimization
  IsClosure = get_closure_info(MFA, ClosureInfo) =/= not_a_closure,
  Leafness = leafness(Code3, IsClosure),
  IsLeaf = is_leaf_code(Leafness),
  Code4 =
    [FunLbl |
     case needs_redtest(Leafness) of
       false -> Code3;
       true -> [mk_redtest()|Code3]
     end],
  Code5 = hipe_icode:mk_icode(MFA, FunArgs, IsClosure, IsLeaf,
			      remove_dead_code(Code4),
			      hipe_gensym:var_range(icode),
			      hipe_gensym:label_range(icode)),
  Icode = %% If this function is the code for a closure ...
    case get_closure_info(MFA, ClosureInfo) of
      not_a_closure -> Code5;
      CI -> %% ... then patch the code to 
	%% get the free_vars from the closure
	patch_closure_entry(Code5, CI)
    end,
  ?no_debug_msg("ok~n", []),
  Icode.

mk_redtest() -> hipe_icode:mk_primop([], redtest, []).

leafness(Is, IsClosure) -> % -> true, selfrec, closure, or false
  leafness(Is, IsClosure, true).

leafness([], _IsClosure, Leafness) ->
  Leafness;
leafness([I|Is], IsClosure, Leafness) ->
  case I of
    #icode_comment{} ->
      %% BEAM self-tailcalls become gotos, but they leave
      %% a trace behind in comments. Check those to ensure
      %% that the computed leafness is correct. Needed to
      %% prevent redtest elimination in those cases.
      NewLeafness =
	case hipe_icode:comment_text(I) of
	  'tail_recursive' -> selfrec;		% call_last to selfrec
	  'self_tail_recursive' -> selfrec;	% call_only to selfrec
	  _ -> Leafness
	end,
      leafness(Is, IsClosure, NewLeafness);
    #icode_call{} ->
      case hipe_icode:call_type(I) of
	'primop' -> 
	  case hipe_icode:call_fun(I) of
	    call_fun -> false;		% Calls closure
	    enter_fun -> false;		% Calls closure
	    #apply_N{} -> false;
	    _ -> leafness(Is, IsClosure, Leafness) % Other primop calls are ok
	  end;
	T when T =:= 'local' orelse T =:= 'remote' ->
	  {M,F,A} = hipe_icode:call_fun(I),
	  case erlang:is_builtin(M, F, A) of
	    true -> leafness(Is, IsClosure, Leafness);
	    false -> false
	  end
      end;
    #icode_enter{} ->
      case hipe_icode:enter_type(I) of
	'primop' ->
	  case hipe_icode:enter_fun(I) of
	    enter_fun -> false;
	    #apply_N{} -> false;
	    _ ->
	      %% All primops should be ok except those excluded above,
	      %% except we don't actually tailcall them...
	      io:format("leafness: unexpected enter to primop ~w\n", [I]),
	      true
	  end;
	T when T =:= 'local' orelse T =:= 'remote' ->
	  {M,F,A} = hipe_icode:enter_fun(I),
	  case erlang:is_builtin(M, F, A) of
	    true -> leafness(Is, IsClosure, Leafness);
	    _ when IsClosure -> leafness(Is, IsClosure, closure);
	    _ -> false
	  end
      end;
    _ -> leafness(Is, IsClosure, Leafness)
  end.

%% XXX: this old stuff is passed around but essentially unused
is_leaf_code(Leafness) ->
  case Leafness of
    true -> true;
    selfrec -> true;
    closure -> false;
    false -> false
  end.

needs_redtest(Leafness) ->
  case Leafness of
    true -> false;
    %% A "leaf" closure may contain tailcalls to non-closures in addition to
    %% what other leaves may contain. Omitting the redtest is useful to generate
    %% shorter code for closures generated by (fun F/A), and is safe since
    %% control flow cannot return to a "leaf" closure again without a reduction
    %% being consumed. This is true since no function that can call a closure
    %% will ever have its redtest omitted.
    closure -> false;
    selfrec -> true;
    false -> true
  end.

%%-----------------------------------------------------------------------
%% The main translation switch.
%%-----------------------------------------------------------------------

%%--- label & func_info combo ---
trans_fun([{label,_}=F,{func_info,_,_,_}=FI|Instructions], Env) ->
  %% Handle old code without a line instruction.
  trans_fun([F,{line,[]},FI|Instructions], Env);
trans_fun([{label,B},{label,_},
	   {func_info,M,F,A},{label,L}|Instructions], Env) ->
  trans_fun([{label,B},{func_info,M,F,A},{label,L}|Instructions], Env);
trans_fun([{label,B},
	   {line,_},
	   {func_info,{atom,_M},{atom,_F},_A},
	   {label,L}|Instructions], Env) ->
  %% Emit code to handle function_clause errors.  The BEAM test instructions
  %% branch to this label if they fail during function clause selection.
  %% Obviously, we must goto past this error point on normal entry.
  Begin = mk_label(B),
  V = mk_var(new),
  EntryPt = mk_label(L),
  Goto = hipe_icode:mk_goto(hipe_icode:label_name(EntryPt)),
  Mov = hipe_icode:mk_move(V, hipe_icode:mk_const(function_clause)),
  Fail = hipe_icode:mk_fail([V],error),
  [Goto, Begin, Mov, Fail, EntryPt | trans_fun(Instructions, Env)];
%%--- label ---
trans_fun([{label,L1},{label,L2}|Instructions], Env) ->
  %% Old BEAM code can have two consecutive labels.
  Lab1 = mk_label(L1),
  Lab2 = mk_label(L2),
  Goto = hipe_icode:mk_goto(map_label(L2)),
  [Lab1, Goto, Lab2 | trans_fun(Instructions, Env)];
trans_fun([{label,L}|Instructions], Env) ->
  [mk_label(L) | trans_fun(Instructions, Env)];
%%--- int_code_end --- SHOULD NEVER OCCUR HERE
%%--- call ---
trans_fun([{call,_N,{_M,_F,A}=MFA}|Instructions], Env) ->
  Args = extract_fun_args(A),
  Dst = [mk_var({r,0})],
  I = trans_call(MFA, Dst, Args, local),
  [I | trans_fun(Instructions, Env)];
%%--- call_last ---
%% Differs from call_only in that it deallocates the environment
trans_fun([{call_last,_N,{_M,_F,A}=MFA,_}|Instructions], Env) ->
  %% IS IT OK TO IGNORE LAST ARG ??
  ?no_debug_msg("  translating call_last: ~p ...~n", [Env]),
  case env__get_mfa(Env) of
    MFA ->
      %% Does this case really happen, or is it covered by call_only?
      Entry = env__get_entry(Env),
      [hipe_icode:mk_comment('tail_recursive'), % needed by leafness/2
       hipe_icode:mk_goto(Entry) | trans_fun(Instructions,Env)];
    _ ->
      Args = extract_fun_args(A),
      I = trans_enter(MFA, Args, local),
      [I | trans_fun(Instructions, Env)]
  end;
%%--- call_only ---
%% Used when the body contains only one call in which case 
%% an environment is not needed/created.
trans_fun([{call_only,_N,{_M,_F,A}=MFA}|Instructions], Env) ->
  ?no_debug_msg("  translating call_only: ~p ...~n", [Env]),
  case env__get_mfa(Env) of
    MFA ->
      Entry = env__get_entry(Env),
      [hipe_icode:mk_comment('self_tail_recursive'), % needed by leafness/2
       hipe_icode:mk_goto(Entry) | trans_fun(Instructions,Env)];
    _ ->
      Args = extract_fun_args(A),
      I = trans_enter(MFA,Args,local),
      [I |  trans_fun(Instructions,Env)]
  end;
%%--- call_ext ---
trans_fun([{call_ext,_N,{extfunc,M,F,A}}|Instructions], Env) ->
  Args = extract_fun_args(A),
  Dst = [mk_var({r,0})],
  I = trans_call({M,F,A},Dst,Args,remote),
  [hipe_icode:mk_comment('call_ext'),I | trans_fun(Instructions,Env)];
%%--- call_ext_last ---
trans_fun([{call_ext_last,_N,{extfunc,M,F,A},_}|Instructions], Env) ->
  %% IS IT OK TO IGNORE LAST ARG ??
  Args = extract_fun_args(A),
  %% Dst = [mk_var({r,0})],
  I = trans_enter({M,F,A},Args,remote),
  [hipe_icode:mk_comment('call_ext_last'), I | trans_fun(Instructions,Env)];
%%--- bif0 ---
trans_fun([{bif,BifName,nofail,[],Reg}|Instructions], Env) ->
  BifInst = trans_bif0(BifName,Reg),
  [BifInst|trans_fun(Instructions,Env)];
%%--- bif1 ---
trans_fun([{bif,BifName,{f,Lbl},[_] = Args,Reg}|Instructions], Env) ->
  {BifInsts,Env1} = trans_bif(1,BifName,Lbl,Args,Reg,Env),
  BifInsts ++ trans_fun(Instructions,Env1);
%%--- bif2 ---
trans_fun([{bif,BifName,{f,Lbl},[_,_] = Args,Reg}|Instructions], Env) ->
  {BifInsts,Env1} = trans_bif(2,BifName,Lbl,Args,Reg,Env),
  BifInsts ++ trans_fun(Instructions,Env1);
%%--- bif3 ---
trans_fun([{bif,BifName,{f,Lbl},[_,_,_] = Args,Reg}|Instructions], Env) ->
  {BifInsts,Env1} = trans_bif(3,BifName,Lbl,Args,Reg,Env),
  BifInsts ++ trans_fun(Instructions,Env1);
%%--- allocate
trans_fun([{allocate,StackSlots,_}|Instructions], Env) ->
  trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
%%--- allocate_heap
trans_fun([{allocate_heap,StackSlots,_,_}|Instructions], Env) ->
  trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
%%--- allocate_zero
trans_fun([{allocate_zero,StackSlots,_}|Instructions], Env) ->
  trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
%%--- allocate_heap_zero
trans_fun([{allocate_heap_zero,StackSlots,_,_}|Instructions], Env) ->
  trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
%%--- test_heap --- IGNORED ON PURPOSE
trans_fun([{test_heap,_,_}|Instructions], Env) ->
  trans_fun(Instructions,Env);
%%--- init --- IGNORED - CORRECT??
trans_fun([{init,_}|Instructions], Env) ->
  trans_fun(Instructions,Env);
%%--- deallocate --- IGNORED ON PURPOSE
trans_fun([{deallocate,_}|Instructions], Env) ->
  trans_fun(Instructions,Env);
%%--- return ---
trans_fun([return|Instructions], Env) ->
  [hipe_icode:mk_return([mk_var({r,0})]) | trans_fun(Instructions,Env)];
%%--- send ---
trans_fun([send|Instructions], Env) ->
  I = hipe_icode:mk_call([mk_var({r,0})], erlang, send,
			 [mk_var({x,0}),mk_var({x,1})], remote),
  [I | trans_fun(Instructions,Env)];
%%--- remove_message ---
trans_fun([remove_message|Instructions], Env) ->
  [hipe_icode:mk_primop([],select_msg,[]) | trans_fun(Instructions,Env)];
%%--- timeout --- 
trans_fun([timeout|Instructions], Env) ->
  [hipe_icode:mk_primop([],clear_timeout,[]) | trans_fun(Instructions,Env)];
%%--- loop_rec ---
trans_fun([{loop_rec,{_,Lbl},Reg}|Instructions], Env) ->
  {Movs,[Temp],Env1} = get_constants_in_temps([Reg],Env),
  GotitLbl = mk_label(new),
  ChkGetMsg = hipe_icode:mk_primop([Temp],check_get_msg,[],
				   hipe_icode:label_name(GotitLbl),
				   map_label(Lbl)),
  Movs ++ [ChkGetMsg, GotitLbl | trans_fun(Instructions,Env1)];
%%--- loop_rec_end ---
trans_fun([{loop_rec_end,{_,Lbl}}|Instructions], Env) ->
  Loop = hipe_icode:mk_goto(map_label(Lbl)),
  [hipe_icode:mk_primop([],next_msg,[]), Loop | trans_fun(Instructions,Env)];
%%--- wait ---
trans_fun([{wait,{_,Lbl}}|Instructions], Env) ->
  Susp = hipe_icode:mk_primop([],suspend_msg,[]),
  Loop = hipe_icode:mk_goto(map_label(Lbl)),
  [Susp, Loop | trans_fun(Instructions,Env)];
%%--- wait_timeout ---
trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) ->
  {Movs,[_]=Temps,Env1} = get_constants_in_temps([Reg],Env),
  SetTmout = hipe_icode:mk_primop([],set_timeout,Temps),
  DoneLbl = mk_label(new),
  SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[],
			       map_label(Lbl),hipe_icode:label_name(DoneLbl)),
  Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)];
%%--- recv_mark/1 & recv_set/1 ---
trans_fun([{recv_mark,{f,_}}|Instructions], Env) ->
  Mark = hipe_icode:mk_primop([],recv_mark,[]),
  [Mark | trans_fun(Instructions,Env)];
trans_fun([{recv_set,{f,_}}|Instructions], Env) ->
  Set = hipe_icode:mk_primop([],recv_set,[]),
  [Set | trans_fun(Instructions,Env)];
%%--------------------------------------------------------------------
%%--- Translation of arithmetics {bif,ArithOp, ...} ---
%%--------------------------------------------------------------------
trans_fun([{arithbif,ArithOp,{f,L},SrcRs,DstR}|Instructions], Env) ->
  {ICode,NewEnv} = trans_arith(ArithOp,SrcRs,DstR,L,Env),
  ICode ++ trans_fun(Instructions,NewEnv);
%%--------------------------------------------------------------------
%%--- Translation of arithmetic tests {test,is_ARITHTEST, ...} ---
%%--------------------------------------------------------------------
%%--- is_lt ---
trans_fun([{test,is_lt,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
  {ICode,Env1} = trans_test_guard('<',Lbl,Arg1,Arg2,Env),
  ICode ++ trans_fun(Instructions,Env1);
%%--- is_ge ---
trans_fun([{test,is_ge,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
  {ICode,Env1} = trans_test_guard('>=',Lbl,Arg1,Arg2,Env),
  ICode ++ trans_fun(Instructions,Env1);
%%--- is_eq ---
trans_fun([{test,is_eq,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
  {ICode,Env1} = trans_is_eq(Lbl,Arg1,Arg2,Env),
  ICode ++ trans_fun(Instructions,Env1);
%%--- is_ne ---
trans_fun([{test,is_ne,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
  {ICode,Env1} = trans_is_ne(Lbl,Arg1,Arg2,Env),
  ICode ++ trans_fun(Instructions,Env1);
%%--- is_eq_exact ---
trans_fun([{test,is_eq_exact,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
  {ICode,Env1} = trans_is_eq_exact(Lbl,Arg1,Arg2,Env),
  ICode ++ trans_fun(Instructions,Env1);
%%--- is_ne_exact ---
trans_fun([{test,is_ne_exact,{f,Lbl},[Arg1,Arg2]}|Instructions], Env) ->
  {ICode,Env1} = trans_is_ne_exact(Lbl,Arg1,Arg2,Env),
  ICode ++ trans_fun(Instructions,Env1);
%%--------------------------------------------------------------------
%%--- Translation of type tests {test,is_TYPE, ...} ---
%%--------------------------------------------------------------------
%%--- is_integer ---
trans_fun([{test,is_integer,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(integer,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_float ---
trans_fun([{test,is_float,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(float,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_number ---
trans_fun([{test,is_number,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(number,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_atom ---
trans_fun([{test,is_atom,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(atom,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_pid ---
trans_fun([{test,is_pid,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(pid,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_ref ---
trans_fun([{test,is_reference,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(reference,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_port ---
trans_fun([{test,is_port,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(port,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_nil ---
trans_fun([{test,is_nil,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(nil,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_binary ---
trans_fun([{test,is_binary,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(binary,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_list ---
trans_fun([{test,is_list,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(list,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_nonempty_list ---
trans_fun([{test,is_nonempty_list,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(cons,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- is_tuple ---
trans_fun([{test,is_tuple,{f,_Lbl}=FLbl,[Xreg]},
	   {test,test_arity,FLbl,[Xreg,_]=Args}|Instructions], Env) ->
  trans_fun([{test,test_arity,FLbl,Args}|Instructions],Env);
trans_fun([{test,is_tuple,{_,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(tuple,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- test_arity ---
trans_fun([{test,test_arity,{f,Lbl},[Reg,N]}|Instructions], Env) ->
  True = mk_label(new),
  I = hipe_icode:mk_type([trans_arg(Reg)],{tuple,N}, 
			 hipe_icode:label_name(True),map_label(Lbl)),
  [I,True | trans_fun(Instructions,Env)];
%%--- test_is_tagged_tuple  ---
trans_fun([{test,is_tagged_tuple,{f,Lbl},[Reg,N,Atom]}|Instructions], Env) ->
  TrueArity = mk_label(new),
  IArity = hipe_icode:mk_type([trans_arg(Reg)],{tuple,N},
			       hipe_icode:label_name(TrueArity),map_label(Lbl)),
  Var = hipe_icode:mk_new_var(),
  IGet = hipe_icode:mk_primop([Var],
			      #unsafe_element{index=1},
			      [trans_arg(Reg)]),
  TrueAtom = mk_label(new),
  IEQ = hipe_icode:mk_type([Var], Atom, hipe_icode:label_name(TrueAtom),
			   map_label(Lbl)),
  [IArity,TrueArity,IGet,IEQ,TrueAtom | trans_fun(Instructions,Env)];
%%--- is_map ---
trans_fun([{test,is_map,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(map,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--------------------------------------------------------------------
%%--- select_val ---
trans_fun([{select_val,Reg,{f,Lbl},{list,Cases}}|Instructions], Env) ->
  {SwVar,CasePairs} = trans_select_stuff(Reg,Cases),
  Len = length(CasePairs),
  I = hipe_icode:mk_switch_val(SwVar,map_label(Lbl),Len,CasePairs),
  ?no_debug_msg("switch_val instr is ~p~n",[I]),
  [I | trans_fun(Instructions,Env)];
%%--- select_tuple_arity ---
trans_fun([{select_tuple_arity,Reg,{f,Lbl},{list,Cases}}|Instructions],Env) ->
  {SwVar,CasePairs} = trans_select_stuff(Reg,Cases),
  Len = length(CasePairs),
  I = hipe_icode:mk_switch_tuple_arity(SwVar,map_label(Lbl),Len,CasePairs),
  ?no_debug_msg("switch_tuple_arity instr is ~p~n",[I]),
  [I | trans_fun(Instructions,Env)];    
%%--- jump ---
trans_fun([{jump,{_,L}}|Instructions], Env) ->
  Label = mk_label(L),
  I = hipe_icode:mk_goto(hipe_icode:label_name(Label)),
  [I | trans_fun(Instructions,Env)];
%%--- move ---
trans_fun([{move,Src,Dst}|Instructions], Env) ->
  Dst1 = mk_var(Dst),
  Src1 = trans_arg(Src),
  [hipe_icode:mk_move(Dst1,Src1) | trans_fun(Instructions,Env)];
%%--- catch --- ITS PROCESSING IS POSTPONED
trans_fun([{'catch',N,{_,EndLabel}}|Instructions], Env) ->
  NewContLbl = mk_label(new),
  [{'catch',N,EndLabel},NewContLbl | trans_fun(Instructions,Env)];
%%--- catch_end --- ITS PROCESSING IS POSTPONED
trans_fun([{catch_end,_N}=I|Instructions], Env) ->
  [I | trans_fun(Instructions,Env)];
%%--- try --- ITS PROCESSING IS POSTPONED
trans_fun([{'try',N,{_,EndLabel}}|Instructions], Env) ->
  NewContLbl = mk_label(new),
  [{'try',N,EndLabel},NewContLbl | trans_fun(Instructions,Env)];
%%--- try_end ---
trans_fun([{try_end,_N}|Instructions], Env) ->
  [hipe_icode:mk_end_try() | trans_fun(Instructions,Env)];
%%--- try_case --- ITS PROCESSING IS POSTPONED
trans_fun([{try_case,_N}=I|Instructions], Env) ->
  [I | trans_fun(Instructions,Env)];
%%--- try_case_end ---
trans_fun([{try_case_end,Arg}|Instructions], Env) ->
  BadArg = trans_arg(Arg),
  ErrVar = mk_var(new),
  Vs = [mk_var(new)],
  Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(try_clause)),
  Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadArg]),
  Fail = hipe_icode:mk_fail(Vs,error),
  [Atom,Tuple,Fail | trans_fun(Instructions,Env)];
%%--- raise ---
trans_fun([{raise,{f,0},[Reg1,Reg2],{x,0}}|Instructions], Env) ->
  V1 = trans_arg(Reg1),
  V2 = trans_arg(Reg2),
  Fail = hipe_icode:mk_fail([V1,V2],rethrow),
  [Fail | trans_fun(Instructions,Env)];
%%--- get_list ---
trans_fun([{get_list,List,Head,Tail}|Instructions], Env) ->
  TransList = [trans_arg(List)],
  I1 = hipe_icode:mk_primop([mk_var(Head)],unsafe_hd,TransList),
  I2 = hipe_icode:mk_primop([mk_var(Tail)],unsafe_tl,TransList),
  %% Handle the cases where the dest overwrites the src!!
  if 
    Head =/= List ->
      [I1, I2 | trans_fun(Instructions,Env)];
    Tail =/= List ->
      [I2, I1 | trans_fun(Instructions,Env)];
    true ->
      %% XXX: We should take care of this case!!!!!
      ?error_msg("hd and tl regs identical in get_list~n",[]),
      erlang:error(not_handled)
  end;
%%--- get_tuple_element ---
trans_fun([{get_tuple_element,Xreg,Index,Dst}|Instructions], Env) ->
  I = hipe_icode:mk_primop([mk_var(Dst)],
			   #unsafe_element{index=Index+1},
			   [trans_arg(Xreg)]),
  [I | trans_fun(Instructions,Env)];
%%--- set_tuple_element ---
trans_fun([{set_tuple_element,Elem,Tuple,Index}|Instructions], Env) ->
  Elem1 = trans_arg(Elem),
  I = hipe_icode:mk_primop([mk_var(Tuple)],
			   #unsafe_update_element{index=Index+1},
			   [mk_var(Tuple),Elem1]),
  [I | trans_fun(Instructions,Env)];
%%--- put_string ---
trans_fun([{put_string,_Len,String,Dst}|Instructions], Env) ->
  Mov = hipe_icode:mk_move(mk_var(Dst),trans_const(String)),
  [Mov | trans_fun(Instructions,Env)];
%%--- put_list ---
trans_fun([{put_list,Car,Cdr,Dest}|Instructions], Env) ->
  {M1,V1,Env2} = mk_move_and_var(Car,Env),
  {M2,V2,Env3} = mk_move_and_var(Cdr,Env2),
  D = mk_var(Dest),
  M1 ++ M2 ++ [hipe_icode:mk_primop([D],cons,[V1,V2])
	       | trans_fun(Instructions,Env3)];
%%--- put_tuple ---
trans_fun([{put_tuple,_Size,Reg}|Instructions], Env) ->
  {Moves,Instructions2,Vars,Env2} = trans_puts(Instructions,Env),
  Dest = [mk_var(Reg)],
  Src = lists:reverse(Vars),
  Primop = hipe_icode:mk_primop(Dest,mktuple,Src),
  Moves ++ [Primop | trans_fun(Instructions2,Env2)];
%%--- put --- SHOULD NOT REALLY EXIST HERE; put INSTRUCTIONS ARE HANDLED ABOVE.
%%--- badmatch ---
trans_fun([{badmatch,Arg}|Instructions], Env) ->
  BadVar = trans_arg(Arg),
  ErrVar = mk_var(new),
  Vs = [mk_var(new)],
  Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(badmatch)),
  Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadVar]),
  Fail = hipe_icode:mk_fail(Vs,error),
  [Atom,Tuple,Fail | trans_fun(Instructions,Env)];
%%--- if_end ---
trans_fun([if_end|Instructions], Env) ->
  V = mk_var(new),
  Mov = hipe_icode:mk_move(V,hipe_icode:mk_const(if_clause)),
  Fail = hipe_icode:mk_fail([V],error),
  [Mov,Fail | trans_fun(Instructions, Env)];
%%--- case_end ---
trans_fun([{case_end,Arg}|Instructions], Env) ->
  BadArg = trans_arg(Arg),
  ErrVar = mk_var(new),
  Vs = [mk_var(new)],
  Atom = hipe_icode:mk_move(ErrVar,hipe_icode:mk_const(case_clause)),
  Tuple = hipe_icode:mk_primop(Vs,mktuple,[ErrVar,BadArg]),
  Fail = hipe_icode:mk_fail(Vs,error),
  [Atom,Tuple,Fail | trans_fun(Instructions,Env)];
%%--- enter_fun ---
trans_fun([{call_fun,N},{deallocate,_},return|Instructions], Env) ->
  Args = extract_fun_args(N+1), %% +1 is for the fun itself
  [hipe_icode:mk_comment('enter_fun'),
   hipe_icode:mk_enter_primop(enter_fun,Args) | trans_fun(Instructions,Env)];
%%--- call_fun ---
trans_fun([{call_fun,N}|Instructions], Env) ->
  Args = extract_fun_args(N+1), %% +1 is for the fun itself
  Dst = [mk_var({r,0})],
  [hipe_icode:mk_comment('call_fun'),
   hipe_icode:mk_primop(Dst,call_fun,Args) | trans_fun(Instructions,Env)];
%%--- patched_make_fun --- make_fun/make_fun2 after fixes
trans_fun([{patched_make_fun,MFA,Magic,FreeVarNum,Index}|Instructions], Env) ->
  Args = extract_fun_args(FreeVarNum),
  Dst = [mk_var({r,0})],
  Fun = hipe_icode:mk_primop(Dst,
			     #mkfun{mfa=MFA,magic_num=Magic,index=Index},
			     Args),
  ?no_debug_msg("mkfun translates to: ~p~n",[Fun]),
  [Fun | trans_fun(Instructions,Env)];
%%--- is_function ---
trans_fun([{test,is_function,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(function,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--- call_ext_only ---
trans_fun([{call_ext_only,_N,{extfunc,M,F,A}}|Instructions], Env) ->
  Args = extract_fun_args(A),
  I = trans_enter({M,F,A}, Args, remote),
  [hipe_icode:mk_comment('call_ext_only'), I | trans_fun(Instructions,Env)];
%%--------------------------------------------------------------------
%%--- Translation of binary instructions ---
%%--------------------------------------------------------------------
%% This code uses a somewhat unorthodox translation:
%%   Since we do not want non-erlang values as arguments to Icode
%%   instructions some compile time constants are coded into the
%%   name of the function (or rather the primop).
%% TODO: Make sure all cases of argument types are covered.
%%--------------------------------------------------------------------
trans_fun([{test,bs_start_match2,{f,Lbl},[X,_Live,Max,Ms]}|Instructions], Env) ->
  Bin = trans_arg(X),
  MsVar = mk_var(Ms),
  trans_op_call({hipe_bs_primop, {bs_start_match, Max}}, Lbl, [Bin],
		[MsVar], Env, Instructions);
trans_fun([{test,bs_get_float2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags0},X]}|
	   Instructions], Env) ->  
  Dst = mk_var(X),
  MsVar = mk_var(Ms),
  Flags = resolve_native_endianess(Flags0),
  {Name, Args} = 
    case Size of
      {integer, NoBits} when is_integer(NoBits), NoBits >= 0 -> 
	{{bs_get_float,NoBits*Unit,Flags}, [MsVar]};
      {integer, NoBits} when is_integer(NoBits), NoBits < 0 ->
	?EXIT({bad_bs_size_constant,Size});
      BitReg ->
	Bits = mk_var(BitReg),
	{{bs_get_float,Unit,Flags}, [MsVar,Bits]}
    end,
  trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [Dst,MsVar], Env, Instructions);
trans_fun([{test,bs_get_integer2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags0},X]}|
	   Instructions], Env) ->
  Dst = mk_var(X),
  MsVar = mk_var(Ms),
  Flags = resolve_native_endianess(Flags0),
  {Name, Args} = 
    case Size of
      {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> 
	{{bs_get_integer,NoBits*Unit,Flags}, [MsVar]};
      {integer,NoBits} when is_integer(NoBits), NoBits < 0 ->
	?EXIT({bad_bs_size_constant,Size});
      BitReg ->
	Bits = mk_var(BitReg),
	{{bs_get_integer,Unit,Flags}, [MsVar,Bits]}
    end,
  trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [Dst,MsVar], Env, Instructions);
trans_fun([{test,bs_get_binary2,{f,Lbl},[Ms,_Live,Size,Unit,{field_flags,Flags},X]}| 
	   Instructions], Env) ->
  MsVar = mk_var(Ms),
  {Name, Args, Dsts} =
    case Size of
      {atom, all} -> %% put all bits
	if Ms =:= X ->
	    {{bs_get_binary_all,Unit,Flags},[MsVar],[mk_var(X)]};
	   true ->
	    {{bs_get_binary_all_2,Unit,Flags},[MsVar],[mk_var(X),MsVar]}
	end;
      {integer, NoBits} when is_integer(NoBits), NoBits >= 0 ->
	{{bs_get_binary,NoBits*Unit,Flags}, [MsVar], [mk_var(X),MsVar]};%% Create a N*Unit bits subbinary
      {integer, NoBits} when is_integer(NoBits), NoBits < 0 ->
	?EXIT({bad_bs_size_constant,Size});
      BitReg -> % Use a number of bits only known at runtime.
	Bits = mk_var(BitReg),
	{{bs_get_binary,Unit,Flags}, [MsVar,Bits], [mk_var(X),MsVar]}
    end,
  trans_op_call({hipe_bs_primop,Name}, Lbl, Args, Dsts, Env, Instructions);
trans_fun([{test,bs_skip_bits2,{f,Lbl},[Ms,Size,NumBits,{field_flags,Flags}]}|
	   Instructions], Env) -> 
  %% the current match buffer
  MsVar = mk_var(Ms),
  {Name, Args} = 
    case Size of
      {atom, all} -> %% Skip all bits
	{{bs_skip_bits_all,NumBits,Flags},[MsVar]};
      {integer, BitSize} when is_integer(BitSize), BitSize >= 0-> %% Skip N bits
	{{bs_skip_bits,BitSize*NumBits}, [MsVar]};
      {integer, BitSize} when is_integer(BitSize), BitSize < 0 ->
	?EXIT({bad_bs_size_constant,Size});
      X -> % Skip a number of bits only known at runtime.
	Src = mk_var(X),
	{{bs_skip_bits,NumBits},[MsVar,Src]}
    end,
  trans_op_call({hipe_bs_primop,Name}, Lbl, Args, [MsVar], Env, Instructions);
trans_fun([{test,bs_test_unit,{f,Lbl},[Ms,Unit]}|
	   Instructions], Env) -> 
  %% the current match buffer
  MsVar = mk_var(Ms),
  trans_op_call({hipe_bs_primop,{bs_test_unit,Unit}}, Lbl, 
		[MsVar], [], Env, Instructions);
trans_fun([{test,bs_match_string,{f,Lbl},[Ms,BitSize,Bin]}|
	   Instructions], Env) -> 
  %% the current match buffer
  MsVar = mk_var(Ms),
  Primop = {hipe_bs_primop, {bs_match_string, Bin, BitSize}},
  trans_op_call(Primop, Lbl, [MsVar], [MsVar], Env, Instructions);
trans_fun([{bs_context_to_binary,Var}|Instructions], Env) -> 
  %% the current match buffer
  IVars = [trans_arg(Var)],
  [hipe_icode:mk_primop(IVars,{hipe_bs_primop,bs_context_to_binary},IVars)|
   trans_fun(Instructions, Env)];
trans_fun([{bs_append,{f,Lbl},Size,W,R,U,Binary,{field_flags,F},Dst}| 
	   Instructions], Env) -> 
  %% the current match buffer
  SizeArg = trans_arg(Size),
  BinArg = trans_arg(Binary),
  IcodeDst = mk_var(Dst),
  Offset = mk_var(reg_gcsafe),
  Base = mk_var(reg),
  trans_bin_call({hipe_bs_primop,{bs_append,W,R,U,F}},Lbl,[SizeArg,BinArg],
		[IcodeDst,Base,Offset],
		 Base, Offset, Env, Instructions);
trans_fun([{bs_private_append,{f,Lbl},Size,U,Binary,{field_flags,F},Dst}| 
	   Instructions], Env) -> 
  %% the current match buffer
  SizeArg = trans_arg(Size),
  BinArg = trans_arg(Binary),
  IcodeDst = mk_var(Dst),
  Offset = mk_var(reg_gcsafe),
  Base = mk_var(reg),
  trans_bin_call({hipe_bs_primop,{bs_private_append,U,F}},
		 Lbl,[SizeArg,BinArg],
		 [IcodeDst,Base,Offset],
		 Base, Offset, Env, Instructions);
trans_fun([bs_init_writable|Instructions], Env) -> 
  Vars = [mk_var({x,0})], %{x,0} is implict arg and dst
  [hipe_icode:mk_primop(Vars,{hipe_bs_primop,bs_init_writable},Vars),
   trans_fun(Instructions, Env)];
trans_fun([{bs_save2,Ms,IndexName}|Instructions], Env) ->
  Index =
    case IndexName of
      {atom, start} -> 0;
      _ -> IndexName+1
    end,
  MsVars = [mk_var(Ms)],
  [hipe_icode:mk_primop(MsVars,{hipe_bs_primop,{bs_save,Index}},MsVars) |
   trans_fun(Instructions, Env)];
trans_fun([{bs_restore2,Ms,IndexName}|Instructions], Env) ->
  Index =
    case IndexName of
      {atom, start} -> 0;
      _ -> IndexName+1
    end,
  MsVars = [mk_var(Ms)],
  [hipe_icode:mk_primop(MsVars,{hipe_bs_primop,{bs_restore,Index}},MsVars) |
   trans_fun(Instructions, Env)];
trans_fun([{test,bs_test_tail2,{f,Lbl},[Ms,Numbits]}| Instructions], Env) ->
  MsVar = mk_var(Ms),
  trans_op_call({hipe_bs_primop,{bs_test_tail,Numbits}}, 
		Lbl, [MsVar], [], Env, Instructions);
%%--------------------------------------------------------------------
%% bit syntax instructions added in February 2004 (R10B).
%%--------------------------------------------------------------------
trans_fun([{bs_init2,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
	   Instructions], Env) ->
  Dst = mk_var(X),
  Flags = resolve_native_endianess(Flags0),
  Offset = mk_var(reg_gcsafe),
  Base = mk_var(reg),
  {Name, Args} =
    case Size of
      NoBytes when is_integer(NoBytes) ->
	{{bs_init, Size, Flags}, []};
      BitReg ->
	Bits = mk_var(BitReg),
	{{bs_init, Flags}, [Bits]}
    end,
  trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset],
		 Base, Offset, Env, Instructions);
trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
	   Instructions], Env) ->
  Dst = mk_var(X),
  Flags = resolve_native_endianess(Flags0),
  Offset = mk_var(reg_gcsafe),
  Base = mk_var(reg),
  {Name, Args} =
    case Size of
      NoBits when is_integer(NoBits) ->
	{{bs_init_bits, NoBits, Flags}, []};
      BitReg ->
	Bits = mk_var(BitReg),
	{{bs_init_bits, Flags}, [Bits]}
    end,
  trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset],
		 Base, Offset, Env, Instructions);
trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) ->
  Dst = mk_var(Res),
  Temp = mk_var(new),
  {FailLblName, FailCode} =
    if Lbl =:= 0 ->
	FailLbl = mk_label(new),
	{hipe_icode:label_name(FailLbl),
	 [FailLbl,
	  hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]};
       true ->
	{map_label(Lbl), []}
    end,
  MultIs =
    case {New,Unit} of
      {{integer, NewInt}, _} ->
	[hipe_icode:mk_move(Temp, hipe_icode:mk_const(NewInt*Unit))];
      {_, 1} ->
	NewVar = mk_var(New),
	[hipe_icode:mk_move(Temp, NewVar)];
      _ ->
	NewVar = mk_var(New),
	Succ = mk_label(new),
	[hipe_icode:mk_primop([Temp], '*',
			      [NewVar, hipe_icode:mk_const(Unit)],
			      hipe_icode:label_name(Succ), FailLblName),
	 Succ]
    end,
  Succ2 = mk_label(new),
  IsPos = 
    [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], 
		      hipe_icode:label_name(Succ2), FailLblName)] ++
    FailCode ++ [Succ2],
  AddRhs =
    case Old of
      {integer,OldInt} -> hipe_icode:mk_const(OldInt);
      _ -> mk_var(Old)
    end,
  Succ3 = mk_label(new),
  AddI = hipe_icode:mk_primop([Dst], '+', [Temp, AddRhs],
			      hipe_icode:label_name(Succ3), FailLblName),
  MultIs ++ IsPos ++ [AddI,Succ3|trans_fun(Instructions, Env)];
%%--------------------------------------------------------------------
%% Bit syntax instructions added in R12B-5 (Fall 2008)
%%--------------------------------------------------------------------
trans_fun([{bs_utf8_size,{f,Lbl},A2,A3}|Instructions], Env) ->
  Bin = trans_arg(A2),
  Dst = mk_var(A3),
  trans_op_call({hipe_bs_primop, bs_utf8_size}, Lbl, [Bin], [Dst], Env, Instructions);
trans_fun([{test,bs_get_utf8,{f,Lbl},[Ms,_Live,{field_flags,_Flags},X]} |
	   Instructions], Env) ->
  trans_bs_get_or_skip_utf8(Lbl, Ms, X, Instructions, Env);
trans_fun([{test,bs_skip_utf8,{f,Lbl},[Ms,_Live,{field_flags,_Flags}]} |
	   Instructions], Env) ->
  trans_bs_get_or_skip_utf8(Lbl, Ms, 'new', Instructions, Env);
trans_fun([{bs_utf16_size,{f,Lbl},A2,A3}|Instructions], Env) ->
  Bin = trans_arg(A2),
  Dst = mk_var(A3),
  trans_op_call({hipe_bs_primop, bs_utf16_size}, Lbl, [Bin], [Dst], Env, Instructions);
trans_fun([{test,bs_get_utf16,{f,Lbl},[Ms,_Live,{field_flags,Flags0},X]} |
	   Instructions], Env) ->
  trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, X, Instructions, Env);
trans_fun([{test,bs_skip_utf16,{f,Lbl},[Ms,_Live,{field_flags,Flags0}]} |
	   Instructions], Env) ->
  trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, 'new', Instructions, Env);
trans_fun([{test,bs_get_utf32,{f,Lbl},[Ms,_Live,{field_flags,Flags0},X]} | Instructions], Env) ->
  trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, X, Instructions, Env);
trans_fun([{test,bs_skip_utf32,{f,Lbl},[Ms,_Live,{field_flags,Flags0}]} | Instructions], Env) ->
  trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, 'new', Instructions, Env);
%%--------------------------------------------------------------------
%%--- Translation of floating point instructions ---
%%--------------------------------------------------------------------
%%--- fclearerror ---
trans_fun([fclearerror|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->  
      [hipe_icode:mk_primop([], fclearerror, []) | 
       trans_fun(Instructions,Env)];
    _ ->
      trans_fun(Instructions,Env)
  end;
%%--- fcheckerror ---
trans_fun([{fcheckerror,{_,Fail}}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      ContLbl = mk_label(new),
      case Fail of
	0 -> 
	  [hipe_icode:mk_primop([], fcheckerror, [],
				hipe_icode:label_name(ContLbl), []),
	   ContLbl | trans_fun(Instructions,Env)];
	_ -> %% Can this happen?
	  {Guard,Env1} =
	    make_guard([], fcheckerror, [],
		       hipe_icode:label_name(ContLbl), map_label(Fail), Env),
	  [Guard, ContLbl | trans_fun(Instructions,Env1)]
      end;
    _ ->
      trans_fun(Instructions, Env)
  end;
%%--- fmove ---
trans_fun([{fmove,Src,Dst}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      Dst1 = mk_var(Dst),
      Src1 = trans_arg(Src),
      case{hipe_icode:is_fvar(Dst1),
	   hipe_icode:is_fvar(Src1)} of
	{true, true} -> %% fvar := fvar 
	  [hipe_icode:mk_move(Dst1,Src1) | trans_fun(Instructions,Env)];
	{false, true} -> %% var := fvar
	  [hipe_icode:mk_primop([Dst1], unsafe_tag_float, [Src1]) |
	   trans_fun(Instructions,Env)];
	{true, false} -> %% fvar := var or fvar := constant
	  [hipe_icode:mk_primop([Dst1], unsafe_untag_float, [Src1]) |
	   trans_fun(Instructions,Env)]      
      end;
    _ ->
      trans_fun([{move,Src,Dst}|Instructions], Env)
  end;
%%--- fconv ---
trans_fun([{fconv,Eterm,FReg}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      Src = trans_arg(Eterm),
      ContLbl = mk_label(new),
      Dst = mk_var(FReg),
      [hipe_icode:mk_primop([Dst], conv_to_float, [Src], 
			    hipe_icode:label_name(ContLbl), []),
       ContLbl| trans_fun(Instructions, Env)];
    _ ->
      trans_fun([{fmove,Eterm,FReg}|Instructions], Env)
  end;
%%--- fadd ---
trans_fun([{arithfbif,fadd,Lab,SrcRs,DstR}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      trans_fun([{arithbif,fp_add,Lab,SrcRs,DstR}|Instructions], Env);
    _ ->
      trans_fun([{arithbif,'+',Lab,SrcRs,DstR}|Instructions], Env)
  end;
%%--- fsub ---
trans_fun([{arithfbif,fsub,Lab,SrcRs,DstR}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      trans_fun([{arithbif,fp_sub,Lab,SrcRs,DstR}|Instructions], Env);
    _ ->
      trans_fun([{arithbif,'-',Lab,SrcRs,DstR}|Instructions], Env)
  end;
%%--- fmult ---
trans_fun([{arithfbif,fmul,Lab,SrcRs,DstR}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      trans_fun([{arithbif,fp_mul,Lab,SrcRs,DstR}|Instructions], Env);
    _ ->
      trans_fun([{arithbif,'*',Lab,SrcRs,DstR}|Instructions], Env)
  end;
%%--- fdiv ---
trans_fun([{arithfbif,fdiv,Lab,SrcRs,DstR}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      trans_fun([{arithbif,fp_div,Lab,SrcRs,DstR}|Instructions], Env);
    _ ->
      trans_fun([{arithbif,'/',Lab,SrcRs,DstR}|Instructions], Env)
  end;
%%--- fnegate ---
trans_fun([{arithfbif,fnegate,Lab,[SrcR],DestR}|Instructions], Env) ->
  case get(hipe_inline_fp) of
    true ->
      Src = trans_arg(SrcR),
      Dst = mk_var(DestR),
      [hipe_icode:mk_primop([Dst], fnegate, [Src])| 
       trans_fun(Instructions,Env)];
    _ ->
      trans_fun([{arithbif,'-',Lab,[{float,0.0},SrcR],DestR}|Instructions], Env)
  end;
%%--------------------------------------------------------------------
%% apply instructions added in April 2004 (R10B).
%%--------------------------------------------------------------------
trans_fun([{apply,Arity}|Instructions], Env) ->
  BeamArgs = extract_fun_args(Arity+2), %% +2 is for M and F
  {Args,[M,F]} = lists:split(Arity,BeamArgs),
  Dst = [mk_var({r,0})],
  [hipe_icode:mk_comment('apply'),
   hipe_icode:mk_primop(Dst, #apply_N{arity=Arity}, [M,F|Args])
   | trans_fun(Instructions,Env)];
trans_fun([{apply_last,Arity,_N}|Instructions], Env) -> % N is StackAdjustment?
  BeamArgs = extract_fun_args(Arity+2), %% +2 is for M and F
  {Args,[M,F]} = lists:split(Arity,BeamArgs),
  [hipe_icode:mk_comment('apply_last'),
   hipe_icode:mk_enter_primop(#apply_N{arity=Arity}, [M,F|Args])
   | trans_fun(Instructions,Env)];
%%--------------------------------------------------------------------
%% test for boolean added in April 2004 (R10B).
%%--------------------------------------------------------------------
%%--- is_boolean ---
trans_fun([{test,is_boolean,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(boolean,Lbl,Arg,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--------------------------------------------------------------------
%% test for function with specific arity added in June 2005 (R11).
%%--------------------------------------------------------------------
%%--- is_function2 ---
trans_fun([{test,is_function2,{f,Lbl},[Arg,Arity]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test2(function2,Lbl,Arg,Arity,Env),
  [Code | trans_fun(Instructions,Env1)];
%%--------------------------------------------------------------------
%% garbage collecting BIFs added in January 2006 (R11B).
%%--------------------------------------------------------------------
trans_fun([{gc_bif,'-',Fail,_Live,[SrcR],DstR}|Instructions], Env) ->
  %% Unary minus. Change this to binary minus.
  trans_fun([{arithbif,'-',Fail,[{integer,0},SrcR],DstR}|Instructions], Env);
trans_fun([{gc_bif,'+',Fail,_Live,[SrcR],DstR}|Instructions], Env) ->
  %% Unary plus. Change this to a bif call.
  trans_fun([{bif,'+',Fail,[SrcR],DstR}|Instructions], Env);
trans_fun([{gc_bif,Name,Fail,_Live,SrcRs,DstR}|Instructions], Env) ->
  case erl_internal:guard_bif(Name, length(SrcRs)) of
    false ->
      %% Arithmetic instruction.
      trans_fun([{arithbif,Name,Fail,SrcRs,DstR}|Instructions], Env);
    true ->
      %% A guard BIF.
      trans_fun([{bif,Name,Fail,SrcRs,DstR}|Instructions], Env)
  end;
%%--------------------------------------------------------------------
%% test for bitstream added in July 2007 (R12).
%%--------------------------------------------------------------------
%%--- is_bitstr ---
trans_fun([{test,is_bitstr,{f,Lbl},[Arg]}|Instructions], Env) ->
  {Code,Env1} = trans_type_test(bitstr, Lbl, Arg, Env),
  [Code | trans_fun(Instructions, Env1)];
%%--------------------------------------------------------------------
%% stack triming instruction added in October 2007 (R12).
%%--------------------------------------------------------------------
trans_fun([{trim,N,NY}|Instructions], Env) ->
  %% trim away N registers leaving NY registers
  Moves = trans_trim(N, NY),
  Moves ++ trans_fun(Instructions, Env);
%%--------------------------------------------------------------------
%% line instruction added in Fall 2012 (R15).
%%--------------------------------------------------------------------
trans_fun([{line,_}|Instructions], Env) ->
  trans_fun(Instructions,Env);
%%--------------------------------------------------------------------
%% Map instructions added in Spring 2014 (17.0).
%%--------------------------------------------------------------------
trans_fun([{test,has_map_fields,{f,Lbl},Map,{list,Keys}}|Instructions], Env) ->
  {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
  %% We assume that hipe_icode:mk_call has no side-effects, and reuse
  %% the help function of get_map_elements below, discarding the value
  %% assignment instruction list.
  {TestInstructions, _GetInstructions, Env2} =
    trans_map_query(MapVar, map_label(Lbl), Env1,
		    lists:flatten([[K, {r, 0}] || K <- Keys])),
  [MapMove, TestInstructions | trans_fun(Instructions, Env2)];
trans_fun([{get_map_elements,{f,Lbl},Map,{list,KVPs}}|Instructions], Env) ->
  {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
  {TestInstructions, GetInstructions, Env2} =
    trans_map_query(MapVar, map_label(Lbl), Env1, KVPs),
  [MapMove, TestInstructions, GetInstructions | trans_fun(Instructions, Env2)];
%%--- put_map_assoc ---
trans_fun([{put_map_assoc,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) ->
  {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
  TempMapVar = mk_var(new),
  TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar),
  {PutInstructions, Env2}
    = case Lbl > 0 of
	true ->
	  gen_put_map_instrs(exists, assoc, TempMapVar, Dst, Lbl, Pairs, Env1);
	false ->
	  gen_put_map_instrs(new, assoc, TempMapVar, Dst, new, Pairs, Env1)
      end,
  [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
%%--- put_map_exact ---
trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) ->
  {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
  TempMapVar = mk_var(new),
  TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar),
  {PutInstructions, Env2}
    = case Lbl > 0 of
	true ->
	  gen_put_map_instrs(exists, exact, TempMapVar, Dst, Lbl, Pairs, Env1);
	false ->
	  gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1)
      end,
  [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
%%--- build_stacktrace ---
trans_fun([build_stacktrace|Instructions], Env) ->
  Vars = [mk_var({x,0})], %{x,0} is implict arg and dst
  [hipe_icode:mk_primop(Vars,build_stacktrace,Vars),
   trans_fun(Instructions, Env)];
%%--------------------------------------------------------------------
%%--- ERROR HANDLING ---
%%--------------------------------------------------------------------
trans_fun([X|_], _) ->
  ?EXIT({'trans_fun/2',X});
trans_fun([], _) ->
  [].

%%--------------------------------------------------------------------
%% trans_call and trans_enter generate correct Icode calls/tail-calls,
%% recognizing explicit fails.
%%--------------------------------------------------------------------

trans_call(MFA={M,F,_A}, Dst, Args, Type) ->
  handle_fail(MFA, Args, fun () -> hipe_icode:mk_call(Dst,M,F,Args,Type) end).

trans_enter(MFA={M,F,_A}, Args, Type) ->
  handle_fail(MFA, Args, fun () -> hipe_icode:mk_enter(M,F,Args,Type) end).

handle_fail(MFA, Args, F) ->
  case MFA of
    {erlang,exit,1} ->
      hipe_icode:mk_fail(Args,exit);
    {erlang,throw,1} ->
      hipe_icode:mk_fail(Args,throw);
    {erlang,fault,1} ->
      hipe_icode:mk_fail(Args,error);
    {erlang,fault,2} ->
      hipe_icode:mk_fail(Args,error);
    {erlang,error,1} ->
      hipe_icode:mk_fail(Args,error);
    {erlang,error,2} ->
      hipe_icode:mk_fail(Args,error);
    _ ->
      F()
  end.

%%-----------------------------------------------------------------------
%% trans_bif0(BifName, DestReg)
%% trans_bif(Arity, BifName, FailLab, Args, DestReg, Environment)
%%-----------------------------------------------------------------------

trans_bif0(BifName, DestReg) ->
  ?no_debug_msg("  found BIF0: ~p() ...~n", [BifName]),
  BifRes = mk_var(DestReg),
  hipe_icode:mk_call([BifRes],erlang,BifName,[],remote).

trans_bif(Arity, BifName, Lbl, Args, DestReg, Env) ->
  ?no_debug_msg("  found BIF: ~p(~p) ...~n", [BifName,Args]),
  BifRes = mk_var(DestReg),
  {Movs, SrcVars, Env1} = get_constants_in_temps(Args,Env),
  case Lbl of
    0 -> % Bif is not in a guard
      I = hipe_icode:mk_call([BifRes],erlang,BifName,SrcVars,remote),
      {Movs ++ [I], Env1};
    _ -> % Bif occurs in a guard - fail silently to Lbl
      {GuardI,Env2} =
	make_fallthrough_guard([BifRes],{erlang,BifName,Arity},SrcVars,
			       map_label(Lbl),Env1),
      {[Movs,GuardI], Env2}
  end.

trans_op_call(Name, Lbl, Args, Dests, Env, Instructions) ->
  {Code, Env1} = trans_one_op_call(Name, Lbl, Args, Dests, Env),
  [Code|trans_fun(Instructions, Env1)].

trans_one_op_call(Name, Lbl, Args, Dests, Env) ->
  case Lbl of
      0 -> % Op is not in a guard
	I = hipe_icode:mk_primop(Dests, Name, Args),
	{[I], Env};
      _ -> % op occurs in a guard - fail silently to Lbl
	make_fallthrough_guard(Dests, Name, Args, map_label(Lbl), Env)
    end.

%%-----------------------------------------------------------------------
%% trans_bin_call
%%-----------------------------------------------------------------------

trans_bin_call(Name, Lbl, Args, Dests, Base, Offset, Env, Instructions) ->
  {Code, Env1} =
    case Lbl of
      0 -> % Op is not in a guard
	I = hipe_icode:mk_primop(Dests, Name, Args),
	{[I], Env};
      _ -> % op occurs in a guard - fail silently to Lbl
	make_fallthrough_guard(Dests, Name, Args, map_label(Lbl), Env)
    end,
  [Code|trans_bin(Instructions, Base, Offset, Env1)].

%% Translate instructions for building binaries separately to give
%% them an appropriate state

trans_bin([{bs_put_float,{f,Lbl},Size,Unit,{field_flags,Flags0},Source}|
	   Instructions], Base, Offset, Env) ->
  Flags = resolve_native_endianess(Flags0),
  %% Get source
  {Src,SourceInstrs,ConstInfo} = 
    case is_var(Source) of
      true ->
	{mk_var(Source),[], var};
      false ->
	case Source of
	  {float, X} when is_float(X) ->
	    C = trans_const(Source),
	    SrcVar = mk_var(new),
	    I = hipe_icode:mk_move(SrcVar, C),
	    {SrcVar,[I],pass};
	  _ -> 
	    C = trans_const(Source),
	    SrcVar = mk_var(new),
	    I = hipe_icode:mk_move(SrcVar, C),
	    {SrcVar,[I],fail}
	end
    end,
  %% Get type of put_float
  {Name,Args,Env2} = 
    case Size of
      {integer,NoBits} when is_integer(NoBits), NoBits >= 0 ->
	%% Create a N*Unit bits float
	{{bs_put_float, NoBits*Unit, Flags, ConstInfo}, [Src, Base, Offset], Env};
      {integer,NoBits} when is_integer(NoBits), NoBits < 0 ->
	?EXIT({bad_bs_size_constant,Size});
      BitReg -> % Use a number of bits only known at runtime.
	Bits = mk_var(BitReg),
	{{bs_put_float, Unit, Flags, ConstInfo}, [Src,Bits,Base,Offset], Env}
    end,
  %% Generate code for calling the bs-op. 
  SourceInstrs ++ 
    trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Offset], Base, Offset, Env2, Instructions);
trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}|
	   Instructions], Base, Offset, Env) ->
  %% Get the source of the binary.
  Src = trans_arg(Source), 
  %% Get type of put_binary
  {Name, Args, Env2} =
    case Size of
      {atom,all} -> %% put all bits
	{{bs_put_binary_all, Unit, Flags}, [Src,Base,Offset], Env};
      {integer,NoBits} when is_integer(NoBits), NoBits >= 0 ->
	%% Create a N*Unit bits subbinary
	{{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env};
      {integer,NoBits} when is_integer(NoBits), NoBits < 0 ->
	?EXIT({bad_bs_size_constant,Size});
      BitReg -> % Use a number of bits only known at runtime.
	Bits = mk_var(BitReg),
	{{bs_put_binary, Unit, Flags}, [Src, Bits,Base,Offset], Env}
    end,
  %% Generate code for calling the bs-op.
  trans_bin_call({hipe_bs_primop, Name}, 
		 Lbl, Args, [Offset],
		 Base, Offset, Env2, Instructions);
%%--- bs_put_string ---
trans_bin([{bs_put_string,SizeInBytes,{string,String}}|Instructions], Base, 
	  Offset, Env) ->
  [hipe_icode:mk_primop([Offset],
			{hipe_bs_primop,{bs_put_string, String, SizeInBytes}},
			[Base, Offset]) |
   trans_bin(Instructions, Base, Offset, Env)];
trans_bin([{bs_put_integer,{f,Lbl},Size,Unit,{field_flags,Flags0},Source}|
	   Instructions], Base, Offset, Env) ->
  Flags = resolve_native_endianess(Flags0),
  %% Get size-type 
  
  %% Get the source of the binary.
  {Src, SrcInstrs, ConstInfo} = 
    case is_var(Source) of
      true ->
	{mk_var(Source), [], var};
      false ->
	case Source of
	  {integer, X} when is_integer(X) ->
	    C = trans_const(Source),
	    SrcVar = mk_var(new),
	    I = hipe_icode:mk_move(SrcVar, C),
	    {SrcVar,[I], pass};
	  _ ->
	    C = trans_const(Source),
	    SrcVar = mk_var(new),
	    I = hipe_icode:mk_move(SrcVar, C),
	    {SrcVar,[I], fail}
	    
	end
    end,
  {Name, Args, Env2} = 
    case is_var(Size) of
      true ->
	SVar = mk_var(Size),
	{{bs_put_integer,Unit,Flags,ConstInfo}, [SVar, Base, Offset], Env};
      false ->
	case Size of
	  {integer, NoBits} when NoBits >= 0 -> 
	    {{bs_put_integer,NoBits*Unit,Flags,ConstInfo}, [Base, Offset], Env};
	  _ -> 
	    ?EXIT({bad_bs_size_constant,Size})
	end
    end,
  SrcInstrs ++ trans_bin_call({hipe_bs_primop, Name}, 
			     Lbl, [Src|Args], [Offset], Base, Offset, Env2, Instructions);
%%----------------------------------------------------------------
%% binary construction instructions added in Fall 2008 (R12B-5).
%%----------------------------------------------------------------
trans_bin([{bs_put_utf8,{f,Lbl},_FF,A3}|Instructions], Base, Offset, Env) ->
  Src = trans_arg(A3),
  Args = [Src, Base, Offset],
  trans_bin_call({hipe_bs_primop, bs_put_utf8}, Lbl, Args, [Offset], Base, Offset, Env, Instructions);
trans_bin([{bs_put_utf16,{f,Lbl},{field_flags,Flags0},A3}|Instructions], Base, Offset, Env) ->
  Src = trans_arg(A3),
  Args = [Src, Base, Offset],
  Flags = resolve_native_endianess(Flags0),
  Name = {bs_put_utf16, Flags},
  trans_bin_call({hipe_bs_primop, Name}, Lbl, Args, [Offset], Base, Offset, Env, Instructions);
trans_bin([{bs_put_utf32,F={f,Lbl},FF={field_flags,_Flags0},A3}|Instructions], Base, Offset, Env) ->
  Src = trans_arg(A3),
  trans_bin_call({hipe_bs_primop,bs_validate_unicode}, Lbl, [Src], [], Base, Offset, Env,
		 [{bs_put_integer,F,{integer,32},1,FF,A3} | Instructions]);
%%----------------------------------------------------------------
%% Base cases for the end of a binary construction sequence.
%%----------------------------------------------------------------
trans_bin([{bs_final2,Src,Dst}|Instructions], _Base, Offset, Env) ->
  [hipe_icode:mk_primop([mk_var(Dst)], {hipe_bs_primop, bs_final}, 
			[trans_arg(Src),Offset])
   |trans_fun(Instructions, Env)];
trans_bin(Instructions, _Base, _Offset, Env) ->
  trans_fun(Instructions, Env).

%% this translates bs_get_utf8 and bs_skip_utf8 (get with new unused dst)
trans_bs_get_or_skip_utf8(Lbl, Ms, X, Instructions, Env) ->
  Dst = mk_var(X),
  MsVar = mk_var(Ms),
  trans_op_call({hipe_bs_primop,bs_get_utf8}, Lbl, [MsVar], [Dst,MsVar], Env, Instructions).

%% this translates bs_get_utf16 and bs_skip_utf16 (get with new unused dst)
trans_bs_get_or_skip_utf16(Lbl, Ms, Flags0, X, Instructions, Env) ->
  Dst = mk_var(X),
  MsVar = mk_var(Ms),
  Flags = resolve_native_endianess(Flags0),
  Name = {bs_get_utf16,Flags},
  trans_op_call({hipe_bs_primop,Name}, Lbl, [MsVar], [Dst,MsVar], Env, Instructions).

%% this translates bs_get_utf32 and bs_skip_utf32 (get with new unused dst)
trans_bs_get_or_skip_utf32(Lbl, Ms, Flags0, X, Instructions, Env) ->
  Dst = mk_var(X),
  MsVar = mk_var(Ms),
  Flags = resolve_native_endianess(Flags0),
  {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,32,Flags}},
				Lbl, [MsVar], [Dst,MsVar], Env),
  I1 ++ trans_op_call({hipe_bs_primop,bs_validate_unicode_retract},
		      Lbl, [Dst,MsVar], [MsVar], Env1, Instructions).

%%-----------------------------------------------------------------------
%% trans_arith(Op, SrcVars, Des, Lab, Env) -> {Icode, NewEnv}
%%     A failure label of type {f,0} means in a body.
%%     A failure label of type {f,L} where L>0 means in a guard.
%%        Within a guard a failure should branch to the next guard and
%%        not trigger an exception!!
%%     Handles body arithmetic with Icode primops!
%%     Handles guard arithmetic with Icode guardops!
%%-----------------------------------------------------------------------

trans_arith(Op, SrcRs, DstR, Lbl, Env) ->
  {Movs,SrcVars,Env1} = get_constants_in_temps(SrcRs,Env),
  DstVar = mk_var(DstR),
  %%io:format("~w:trans_arith()\n ~w := ~w ~w\n",
  %%		[?MODULE,DstVar,SrcVars,Op]),
  case Lbl of
    0 ->  % Body arithmetic
      Primop = hipe_icode:mk_primop([DstVar], arith_op_name(Op), SrcVars),
      {Movs++[Primop], Env1};
    _ ->  % Guard arithmetic
      {Guard,Env2} = 
	make_fallthrough_guard([DstVar], arith_op_name(Op), SrcVars,
			       map_label(Lbl), Env1),
      {[Movs,Guard], Env2}
  end.

%% Prevent arbitrary names from leaking into Icode from BEAM.
arith_op_name('+') -> '+';
arith_op_name('-') -> '-';
arith_op_name('*') -> '*';
arith_op_name('/') -> '/';
arith_op_name('div') -> 'div';
arith_op_name('fp_add') -> 'fp_add';
arith_op_name('fp_sub') -> 'fp_sub';
arith_op_name('fp_mul') -> 'fp_mul';
arith_op_name('fp_div') -> 'fp_div';
arith_op_name('rem') -> 'rem';
arith_op_name('bsl') -> 'bsl';
arith_op_name('bsr') -> 'bsr';
arith_op_name('band') -> 'band';
arith_op_name('bor') -> 'bor';
arith_op_name('bxor') -> 'bxor';
arith_op_name('bnot') -> 'bnot'.

%%-----------------------------------------------------------------------
%%-----------------------------------------------------------------------

trans_test_guard(TestOp,F,Arg1,Arg2,Env) ->
  {Movs,Vars,Env1} = get_constants_in_temps([Arg1,Arg2],Env),
  True = mk_label(new),
  I = hipe_icode:mk_if(TestOp,Vars,hipe_icode:label_name(True),map_label(F)),
  {[Movs,I,True], Env1}.

%%-----------------------------------------------------------------------
%%-----------------------------------------------------------------------

make_fallthrough_guard(DstVar,GuardOp,Args,FailLName,Env) ->
  ContL = mk_label(new),
  ContLName = hipe_icode:label_name(ContL),
  {Instrs, NewDsts} = clone_dsts(DstVar),
  {Guard,Env1} = make_guard(NewDsts,GuardOp,Args,ContLName,FailLName,Env),
  {[Guard,ContL]++Instrs,Env1}.

%% Make sure DstVar gets initialised to a dummy value after a fail:
%make_guard(Dests,{hipe_bs_primop,Primop},Args,ContLName,FailLName,Env) ->
%  {[hipe_icode:mk_guardop(Dests,{hipe_bs_primop,Primop},Args,ContLName,FailLName)],
%   Env};
make_guard(Dests=[_|_],GuardOp,Args,ContLName,FailLName,Env) ->
  TmpFailL = mk_label(new),
  TmpFailLName = hipe_icode:label_name(TmpFailL),
  GuardOpIns = hipe_icode:mk_guardop(Dests,GuardOp,Args,
				     ContLName,TmpFailLName),
  FailCode = [TmpFailL,
	      nillify_all(Dests),
	      hipe_icode:mk_goto(FailLName)],
  {[GuardOpIns|FailCode], Env};
%% A guard that does not return anything:
make_guard([],GuardOp,Args,ContLName,FailLName,Env) ->
  {[hipe_icode:mk_guardop([],GuardOp,Args,ContLName,FailLName)],
   Env}.

nillify_all([Var|Vars]) ->
  [hipe_icode:mk_move(Var,hipe_icode:mk_const([]))|nillify_all(Vars)];
nillify_all([]) -> [].

clone_dsts(Dests) ->
  clone_dsts(Dests, [],[]).

clone_dsts([Dest|Dests], Instrs, NewDests) -> 
  {I,ND} = clone_dst(Dest),
  clone_dsts(Dests, [I|Instrs], [ND|NewDests]);
clone_dsts([], Instrs, NewDests) ->
  {lists:reverse(Instrs), lists:reverse(NewDests)}.

clone_dst(Dest) -> 
  New = 
    case hipe_icode:is_reg(Dest) of
      true ->
	case hipe_icode:reg_is_gcsafe(Dest) of
	  true -> mk_var(reg_gcsafe);
	  false -> mk_var(reg)
	end;
      false ->
	true = hipe_icode:is_var(Dest),	      
	mk_var(new)
    end,
  {hipe_icode:mk_move(Dest, New), New}.


%%-----------------------------------------------------------------------
%% trans_type_test(Test, Lbl, Arg, Env) -> {Icode, NewEnv}
%%     Handles all unary type tests like is_integer etc. 
%%-----------------------------------------------------------------------

trans_type_test(Test, Lbl, Arg, Env) ->
  True = mk_label(new),
  {Move,Var,Env1} = mk_move_and_var(Arg,Env),
  I = hipe_icode:mk_type([Var], Test,
			 hipe_icode:label_name(True), map_label(Lbl)),
  {[Move,I,True],Env1}.

%%
%% This handles binary type tests. Currently, the only such is the
%% is_function/2 BIF.
%%
trans_type_test2(function2, Lbl, Arg, Arity, Env) ->
  True = mk_label(new),
  {Move1,Var1,Env1} = mk_move_and_var(Arg, Env),
  {Move2,Var2,Env2} = mk_move_and_var(Arity, Env1),
  I = hipe_icode:mk_type([Var1,Var2], function2,
			 hipe_icode:label_name(True), map_label(Lbl)),
  {[Move1,Move2,I,True],Env2}.

%%
%% Handles the get_map_elements instruction and the has_map_fields
%% test instruction.
%%
trans_map_query(_MapVar, _FailLabel, Env, []) ->
  {[], [], Env};
trans_map_query(MapVar, FailLabel, Env, [Key,Val|KVPs]) ->
  {Move,KeyVar,Env1} = mk_move_and_var(Key,Env),
  PassLabel = mk_label(new),
  BoolVar = hipe_icode:mk_new_var(),
  ValVar = mk_var(Val),
  IsKeyCall = hipe_icode:mk_call([BoolVar], maps, is_key, [KeyVar, MapVar],
				 remote),
  TrueTest = hipe_icode:mk_if('=:=', [BoolVar, hipe_icode:mk_const(true)],
			      hipe_icode:label_name(PassLabel), FailLabel),
  GetCall = hipe_icode:mk_call([ValVar], maps, get,  [KeyVar, MapVar], remote),
  {TestList, GetList, Env2} = trans_map_query(MapVar, FailLabel, Env1, KVPs),
  {[Move, IsKeyCall, TrueTest, PassLabel|TestList], [GetCall|GetList], Env2}.

%%
%% Generates a fail label if necessary when translating put_map_* instructions.
%%
gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) ->
  TrueLabel = mk_label(new),
  IsMapCode = hipe_icode:mk_type([TempMapVar], map,
				 hipe_icode:label_name(TrueLabel), map_label(FailLbl)),
  DstMapVar = mk_var(Dst),
  {ReturnLbl, PutInstructions, Env1}
    = case Op of
	assoc ->
	  trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []);
	exact ->
	  trans_put_map_exact(TempMapVar, DstMapVar,
			      map_label(FailLbl), Pairs, Env, [])
      end,
  {[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1};
gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) ->
  FailLbl = mk_label(new),
  DstMapVar = mk_var(Dst),
  {ReturnLbl, PutInstructions, Env1}
    = case Op of
	assoc ->
	  trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []);
	exact ->
	  trans_put_map_exact(TempMapVar, DstMapVar,
			      none, Pairs, Env, [])
      end,
  Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error),
  {[PutInstructions, FailLbl, Fail, ReturnLbl], Env1}.

%%-----------------------------------------------------------------------
%% This function generates the instructions needed to insert several
%% (Key, Value) pairs into an existing map, each recursive call inserts
%% one (Key, Value) pair.
%%-----------------------------------------------------------------------
trans_put_map_assoc(MapVar, DestMapVar, [], Env, Acc) ->
  MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar),
  ReturnLbl = mk_label(new),
  GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)),
  {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env};
trans_put_map_assoc(MapVar, DestMapVar, [Key, Value | Rest], Env, Acc) ->
  {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
  {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
  BifCall = hipe_icode:mk_call([MapVar], maps, put,
			       [KeyVar, ValVar, MapVar], remote),
  trans_put_map_assoc(MapVar, DestMapVar, Rest, Env2,
		      [BifCall, MoveVal, MoveKey | Acc]).

%%-----------------------------------------------------------------------
%% This function generates the instructions needed to update several
%% (Key, Value) pairs in an existing map, each recursive call inserts
%% one (Key, Value) pair.
%%-----------------------------------------------------------------------
trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) ->
  MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar),
  ReturnLbl = mk_label(new),
  GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)),
  {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env};
trans_put_map_exact(MapVar, DestMapVar, none, [Key, Value | Rest], Env, Acc) ->
  {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
  {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
  BifCallPut = hipe_icode:mk_call([MapVar], maps, update,
				  [KeyVar, ValVar, MapVar], remote),
  Acc1 = [BifCallPut, MoveVal, MoveKey | Acc],
  trans_put_map_exact(MapVar, DestMapVar, none, Rest, Env2, Acc1);
trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) ->
  SuccLbl = mk_label(new),
  {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
  {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
  IsKey = hipe_icode:mk_new_var(),
  BifCallIsKey = hipe_icode:mk_call([IsKey], maps, is_key,
				    [KeyVar, MapVar], remote),
  IsKeyTest = hipe_icode:mk_if('=:=', [IsKey, hipe_icode:mk_const(true)],
			       hipe_icode:label_name(SuccLbl), FLbl),
  BifCallPut = hipe_icode:mk_call([MapVar], maps, put,
				  [KeyVar, ValVar, MapVar], remote),
  Acc1 = [BifCallPut, SuccLbl, IsKeyTest, BifCallIsKey, MoveVal, MoveKey | Acc],
  trans_put_map_exact(MapVar, DestMapVar, FLbl, Rest, Env2, Acc1).

%%-----------------------------------------------------------------------
%% trans_puts(Code, Environment) -> 
%%            {Movs, Code, Vars, NewEnv}
%%-----------------------------------------------------------------------

trans_puts(Code, Env) ->
  trans_puts(Code, [], [], Env).

trans_puts([{put,X}|Code], Vars, Moves, Env) ->
  case type(X) of
    var ->
      Var = mk_var(X),
      trans_puts(Code, [Var|Vars], Moves, Env);
    #beam_const{value=C} ->
      Var = mk_var(new),
      Move = hipe_icode:mk_move(Var, hipe_icode:mk_const(C)),
      trans_puts(Code, [Var|Vars], [Move|Moves], Env)
  end;
trans_puts(Code, Vars, Moves, Env) ->    %% No more put operations
  {Moves, Code, Vars, Env}.

%%-----------------------------------------------------------------------
%% The code for this instruction is a bit large because we are treating
%% different cases differently.  We want to use the icode `type' 
%% instruction when it is applicable to take care of match expressions.
%%-----------------------------------------------------------------------

trans_is_eq_exact(Lbl, Arg1, Arg2, Env) ->
  case {is_var(Arg1),is_var(Arg2)} of
    {true,true} ->
      True = mk_label(new),
      I = hipe_icode:mk_if('=:=',
			   [mk_var(Arg1),mk_var(Arg2)],
			   hipe_icode:label_name(True), map_label(Lbl)),
      {[I,True], Env};
    {true,false} -> %% right argument is a constant -- use type()!
      trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env);
    {false,true} -> %% mirror of the case above; swap args
      trans_is_eq_exact_var_const(Lbl, Arg2, Arg1, Env);
    {false,false} -> %% both arguments are constants !!!
      case Arg1 =:= Arg2 of
	true ->
	  {[], Env};
	false ->   
	  Never = mk_label(new),
	  I = hipe_icode:mk_goto(map_label(Lbl)),
	  {[I,Never], Env}
      end
  end.

trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env) -> % var =:= const
  True = mk_label(new),
  NewArg1 = mk_var(Arg1),
  TrueLabName = hipe_icode:label_name(True),
  FalseLabName = map_label(Lbl),
  I = case Arg2 of
	{float,Float} ->
	  hipe_icode:mk_if('=:=',
			   [NewArg1, hipe_icode:mk_const(Float)],
			   TrueLabName, FalseLabName);
	{literal,Literal} ->
	  hipe_icode:mk_if('=:=',
			   [NewArg1, hipe_icode:mk_const(Literal)],
			   TrueLabName, FalseLabName);
	_ ->
	  hipe_icode:mk_type([NewArg1], Arg2, TrueLabName, FalseLabName)
      end,
  {[I,True], Env}.

%%-----------------------------------------------------------------------
%% ... and this is analogous to the above
%%-----------------------------------------------------------------------

trans_is_ne_exact(Lbl, Arg1, Arg2, Env) ->
  case {is_var(Arg1),is_var(Arg2)} of
    {true,true} ->
      True = mk_label(new),
      I = hipe_icode:mk_if('=/=',
			   [mk_var(Arg1),mk_var(Arg2)],
			   hipe_icode:label_name(True), map_label(Lbl)),
      {[I,True], Env};
    {true,false} -> %% right argument is a constant -- use type()!
      trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env);
    {false,true} -> %% mirror of the case above; swap args
      trans_is_ne_exact_var_const(Lbl, Arg2, Arg1, Env);
    {false,false} -> %% both arguments are constants !!!
      case Arg1 =/= Arg2 of
	true ->
	  {[], Env};
	false ->   
	  Never = mk_label(new),
	  I = hipe_icode:mk_goto(map_label(Lbl)),
	  {[I,Never], Env}
      end
  end.

trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env) -> % var =/= const
  True = mk_label(new),
  NewArg1 = mk_var(Arg1),
  TrueLabName = hipe_icode:label_name(True),
  FalseLabName = map_label(Lbl),
  I = case Arg2 of
	{float,Float} ->
	  hipe_icode:mk_if('=/=',
			   [NewArg1, hipe_icode:mk_const(Float)],
			   TrueLabName, FalseLabName);
	{literal,Literal} ->
	  hipe_icode:mk_if('=/=',
			   [NewArg1, hipe_icode:mk_const(Literal)],
			   TrueLabName, FalseLabName);
	_ ->
	  hipe_icode:mk_type([NewArg1], Arg2, FalseLabName, TrueLabName)
      end,
  {[I,True], Env}.

%%-----------------------------------------------------------------------
%% Try to do a relatively straightforward optimization: if equality with
%% an atom is used, then convert this test to use of exact equality test
%% with the same atom (which in turn will be translated to a `type' test
%% instruction by the code of trans_is_eq_exact_var_const/4 above).
%%-----------------------------------------------------------------------

trans_is_eq(Lbl, Arg1, Arg2, Env) ->
  case {is_var(Arg1),is_var(Arg2)} of
    {true,true} ->   %% not much can be done in this case
      trans_test_guard('==', Lbl, Arg1, Arg2, Env);
    {true,false} ->  %% optimize this case, if possible
      case Arg2 of
	{atom,_SomeAtom} ->
	  trans_is_eq_exact_var_const(Lbl, Arg1, Arg2, Env);
	_ ->
	  trans_test_guard('==', Lbl, Arg1, Arg2, Env)
      end;
    {false,true} ->  %% probably happens rarely; hence the recursive call
      trans_is_eq(Lbl, Arg2, Arg1, Env);
    {false,false} -> %% both arguments are constants !!!
      case Arg1 == Arg2 of
	true ->
	  {[], Env};
	false ->   
	  Never = mk_label(new),
	  I = hipe_icode:mk_goto(map_label(Lbl)),
	  {[I,Never], Env}
      end
  end.

%%-----------------------------------------------------------------------
%% ... and this is analogous to the above
%%-----------------------------------------------------------------------

trans_is_ne(Lbl, Arg1, Arg2, Env) ->
  case {is_var(Arg1),is_var(Arg2)} of
    {true,true} ->   %% not much can be done in this case
      trans_test_guard('/=', Lbl, Arg1, Arg2, Env);
    {true,false} ->  %% optimize this case, if possible
      case Arg2 of
	{atom,_SomeAtom} ->
	  trans_is_ne_exact_var_const(Lbl, Arg1, Arg2, Env);
	_ ->
	  trans_test_guard('/=', Lbl, Arg1, Arg2, Env)
      end;
    {false,true} ->  %% probably happens rarely; hence the recursive call
      trans_is_ne(Lbl, Arg2, Arg1, Env);
    {false,false} -> %% both arguments are constants !!!
      case Arg1 /= Arg2 of
	true ->
	  {[], Env};
	false ->   
	  Never = mk_label(new),
	  I = hipe_icode:mk_goto(map_label(Lbl)),
	  {[I,Never], Env}
      end
  end.


%%-----------------------------------------------------------------------
%% Translates an allocate instruction into a sequence of initializations
%%-----------------------------------------------------------------------

trans_allocate(N) ->
  trans_allocate(N, []).

trans_allocate(0, Acc) ->
  Acc;
trans_allocate(N, Acc) ->
  Move = hipe_icode:mk_move(mk_var({y,N-1}), 
			    hipe_icode:mk_const('dummy_value')),
  trans_allocate(N-1, [Move|Acc]).

%%-----------------------------------------------------------------------
%% Translates a trim instruction into a sequence of moves
%%-----------------------------------------------------------------------

trans_trim(N, NY) ->
  lists:reverse(trans_trim(N, NY, 0, [])).

trans_trim(_, 0, _, Acc) ->
  Acc;
trans_trim(N, NY, Y, Acc) ->
  Move = hipe_icode:mk_move(mk_var({y,Y}), mk_var({y,N})),
  trans_trim(N+1, NY-1, Y+1, [Move|Acc]).

%%-----------------------------------------------------------------------
%%-----------------------------------------------------------------------

mk_move_and_var(Var, Env) ->
  case type(Var) of
    var ->
      V = mk_var(Var),
      {[], V, Env};
    #beam_const{value=C} ->
      V = mk_var(new),
      {[hipe_icode:mk_move(V,hipe_icode:mk_const(C))], V, Env}
  end.

%%-----------------------------------------------------------------------
%% Find names of closures and number of free vars.
%%-----------------------------------------------------------------------

closure_info_mfa(#closure_info{mfa=MFA}) -> MFA.
closure_info_arity(#closure_info{arity=Arity}) -> Arity.
%% closure_info_fv_arity(#closure_info{fv_arity=Arity}) -> Arity.

find_closure_info(Code) -> mod_find_closure_info(Code, []).

mod_find_closure_info([FunCode|Fs], CI) ->
  mod_find_closure_info(Fs, find_closure_info(FunCode, CI));
mod_find_closure_info([], CI) ->
  CI.

find_closure_info([{patched_make_fun,MFA={_M,_F,A},_Magic,FreeVarNum,_Index}|BeamCode],
		  ClosureInfo) ->
  NewClosure = %% A-FreeVarNum+1 (The real arity + 1 for the closure)
    #closure_info{mfa=MFA, arity=A-FreeVarNum+1, fv_arity=FreeVarNum},
  find_closure_info(BeamCode, [NewClosure|ClosureInfo]);
find_closure_info([_Inst|BeamCode], ClosureInfo) ->
  find_closure_info(BeamCode, ClosureInfo);
find_closure_info([], ClosureInfo) ->
  ClosureInfo.

%%-----------------------------------------------------------------------
%% Is closure
%%-----------------------------------------------------------------------

get_closure_info(MFA, [CI|Rest]) ->
  case closure_info_mfa(CI) of
    MFA -> CI;
    _ -> get_closure_info(MFA, Rest)
  end;
get_closure_info(_, []) ->
  not_a_closure.

%%-----------------------------------------------------------------------
%% Patch closure entry.
%%-----------------------------------------------------------------------

%% NOTE: this changes the number of parameters in the ICode function,
%% but does *not* change the arity in the function name. Thus, all
%% closure-functions have the exact same names in Beam and in native
%% code, although they have different calling conventions.

patch_closure_entry(Icode, ClosureInfo)->
  Arity = closure_info_arity(ClosureInfo), 
  %% ?msg("Arity ~w\n",[Arity]),
  {Args, Closure, FreeVars} = 
    split_params(Arity, hipe_icode:icode_params(Icode), []),
  [Start|_] = hipe_icode:icode_code(Icode),
  {_LMin, LMax} = hipe_icode:icode_label_range(Icode),
  hipe_gensym:set_label(icode,LMax+1),
  {_VMin, VMax} = hipe_icode:icode_var_range(Icode),
  hipe_gensym:set_var(icode,VMax+1),
  MoveCode = gen_get_free_vars(FreeVars, Closure,
			       hipe_icode:label_name(Start)),
  Icode1 = hipe_icode:icode_code_update(Icode, MoveCode ++
					hipe_icode:icode_code(Icode)),
  Icode2 = hipe_icode:icode_params_update(Icode1, Args),
  %% Arity - 1 since the original arity did not have the closure argument.
  Icode3 = hipe_icode:icode_closure_arity_update(Icode2, Arity-1),
  Icode3.

%%-----------------------------------------------------------------------

gen_get_free_vars(Vars, Closure, StartName) ->
  [hipe_icode:mk_new_label()] ++ 
    get_free_vars(Vars, Closure, 1, []) ++ [hipe_icode:mk_goto(StartName)].

get_free_vars([V|Vs], Closure, No, MoveCode) ->
  %% TempV = hipe_icode:mk_new_var(),
  get_free_vars(Vs, Closure, No+1,
		[%% hipe_icode:mk_move(TempV,hipe_icode:mk_const(No)),
		 hipe_icode:mk_primop([V], #closure_element{n=No}, [Closure])
		 |MoveCode]);
get_free_vars([],_,_,MoveCode) ->
  MoveCode.

%%-----------------------------------------------------------------------

split_params(1, [Closure|_OrgArgs] = Params, Args) ->
  {lists:reverse([Closure|Args]), Closure, Params};
split_params(1, [], Args) ->
  Closure = hipe_icode:mk_new_var(),
  {lists:reverse([Closure|Args]), Closure, []};
split_params(N, [ArgN|OrgArgs], Args) ->
  split_params(N-1, OrgArgs, [ArgN|Args]).

%%-----------------------------------------------------------------------

preprocess_code(ModuleCode) ->
  PatchedCode = patch_R7_funs(ModuleCode),
  ClosureInfo = find_closure_info(PatchedCode),
  {PatchedCode, ClosureInfo}.

%%-----------------------------------------------------------------------
%% Patches the "make_fun" BEAM instructions of R7 so that they also
%% contain the index that the BEAM loader generates for funs.
%% 
%% The index starts from 0 and is incremented by 1 for each make_fun
%% instruction encountered.
%%
%% Retained only for compatibility with BEAM code prior to R8.
%%
%% Temporarily, it also rewrites R8-PRE-RELEASE "make_fun2"
%% instructions, since their embedded indices don't work.
%%-----------------------------------------------------------------------

patch_R7_funs(ModuleCode) ->
  patch_make_funs(ModuleCode, 0).

patch_make_funs([FunCode0|Fs], FunIndex0) ->
  {PatchedFunCode,FunIndex} = patch_make_funs(FunCode0, FunIndex0, []),
  [PatchedFunCode|patch_make_funs(Fs, FunIndex)];
patch_make_funs([], _) -> [].

patch_make_funs([{make_fun,MFA,Magic,FreeVarNum}|Is], FunIndex, Acc) ->
  Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex},
  patch_make_funs(Is, FunIndex+1, [Patched|Acc]);
patch_make_funs([{make_fun2,MFA,_BogusIndex,Magic,FreeVarNum}|Is], FunIndex, Acc) ->
  Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex},
  patch_make_funs(Is, FunIndex+1, [Patched|Acc]);
patch_make_funs([I|Is], FunIndex, Acc) ->
  patch_make_funs(Is, FunIndex, [I|Acc]);
patch_make_funs([], FunIndex, Acc) ->
  {lists:reverse(Acc),FunIndex}.

%%-----------------------------------------------------------------------

find_mfa([{label,_}|Code]) ->
  find_mfa(Code);
find_mfa([{line,_}|Code]) ->
  find_mfa(Code);
find_mfa([{func_info,{atom,M},{atom,F},A}|_]) 
  when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 ->
  {M, F, A}.


%%-----------------------------------------------------------------------
%% Takes a list of arguments and returns the constants of them into
%% fresh temporaries.  Return a triple consisting of a list of move
%% instructions, a list of proper icode arguments and the new environment.
%%-----------------------------------------------------------------------

get_constants_in_temps(Args, Env) ->
  get_constants_in_temps(Args, [], [], Env).

get_constants_in_temps([Arg|Args], Instrs, Temps, Env) ->
  case get_constant_in_temp(Arg, Env) of
    {none,ArgVar,Env1} ->
      get_constants_in_temps(Args, Instrs, [ArgVar|Temps], Env1);
    {Instr,Temp,Env1} ->
      get_constants_in_temps(Args, [Instr|Instrs], [Temp|Temps], Env1)
  end;
get_constants_in_temps([], Instrs, Temps, Env) ->
  {lists:reverse(Instrs), lists:reverse(Temps), Env}.

%%  If Arg is a constant then put Arg in a fresh temp!
get_constant_in_temp(Arg, Env) ->
  case is_var(Arg) of
    true ->  % Convert into Icode variable format before return
      {none, mk_var(Arg), Env};
    false -> % Create a new temp and move the constant into it
      Temp = mk_var(new),
      Const = trans_const(Arg),
      {hipe_icode:mk_move(Temp, Const), Temp, Env}
  end.

%%-----------------------------------------------------------------------
%% Makes a list of function arguments.
%%-----------------------------------------------------------------------

extract_fun_args(A) ->
  lists:reverse(extract_fun_args1(A)).

extract_fun_args1(0) ->
  [];
extract_fun_args1(1) ->
  [mk_var({r,0})];
extract_fun_args1(N) ->
  [mk_var({x,N-1}) | extract_fun_args1(N-1)].

%%-----------------------------------------------------------------------
%% Auxiliary translation for arguments of select_val & select_tuple_arity
%%-----------------------------------------------------------------------

trans_select_stuff(Reg, CaseList) ->
  SwVar = case is_var(Reg) of
	    true ->
	      mk_var(Reg);
	    false ->
	      trans_const(Reg)
	  end,
  CasePairs = trans_case_list(CaseList),
  {SwVar,CasePairs}.

trans_case_list([Symbol,{f,Lbl}|L]) ->
  [{trans_const(Symbol),map_label(Lbl)} | trans_case_list(L)];
trans_case_list([]) ->
  [].

%%-----------------------------------------------------------------------
%% Makes an Icode argument from a BEAM argument.
%%-----------------------------------------------------------------------

trans_arg(Arg) ->
  case is_var(Arg) of
    true ->
      mk_var(Arg);
    false ->
      trans_const(Arg)
  end.

%%-----------------------------------------------------------------------
%% Makes an Icode constant from a BEAM constant.
%%-----------------------------------------------------------------------

trans_const(Const) ->
  case Const of
    {atom,Atom} when is_atom(Atom) ->
      hipe_icode:mk_const(Atom);
    {integer,N} when is_integer(N) ->
      hipe_icode:mk_const(N);
    {float,Float} when is_float(Float) ->
      hipe_icode:mk_const(Float);
    {string,String} ->
      hipe_icode:mk_const(String);
    {literal,Literal} ->
      hipe_icode:mk_const(Literal);
    nil ->
      hipe_icode:mk_const([]);
    Int when is_integer(Int) ->
      hipe_icode:mk_const(Int)
  end.

%%-----------------------------------------------------------------------
%% Make an icode variable of proper type
%%   (Variables mod 5) =:= 0  are X regs
%%   (Variables mod 5) =:= 1  are Y regs
%%   (Variables mod 5) =:= 2  are FR regs
%%   (Variables mod 5) =:= 3  are new temporaries
%%   (Variables mod 5) =:= 4  are new register temporaries
%% Tell hipe_gensym to update its state for each new thing created!!
%%-----------------------------------------------------------------------

mk_var({r,0}) ->
  hipe_icode:mk_var(0);
mk_var({x,R}) when is_integer(R) ->
  V = 5*R,
  hipe_gensym:update_vrange(icode,V),
  hipe_icode:mk_var(V);
mk_var({y,R}) when is_integer(R) ->
  V = (5*R)+1,
  hipe_gensym:update_vrange(icode,V),
  hipe_icode:mk_var(V);
mk_var({fr,R}) when is_integer(R) ->
  V = (5*R)+2,
  hipe_gensym:update_vrange(icode,V),
  case get(hipe_inline_fp) of
    true ->
      hipe_icode:mk_fvar(V);
    _ ->
      hipe_icode:mk_var(V)
  end;
mk_var(new) ->
  T = hipe_gensym:new_var(icode),
  V = (5*T)+3,
  hipe_gensym:update_vrange(icode,V),
  hipe_icode:mk_var(V);
mk_var(reg) ->
  T = hipe_gensym:new_var(icode),
  V = (5*T)+4,
  hipe_gensym:update_vrange(icode,V),
  hipe_icode:mk_reg(V);
mk_var(reg_gcsafe) ->
  T = hipe_gensym:new_var(icode),
  V = (5*T)+4, % same namespace as 'reg'
  hipe_gensym:update_vrange(icode,V),
  hipe_icode:mk_reg_gcsafe(V).

%%-----------------------------------------------------------------------
%% Make an icode label of proper type
%%   (Labels mod 2) =:= 0  are actually occuring in the BEAM code
%%   (Labels mod 2) =:= 1  are new labels generated by the translation
%%-----------------------------------------------------------------------

mk_label(L) when is_integer(L) ->
  LL = 2 * L,
  hipe_gensym:update_lblrange(icode, LL),
  hipe_icode:mk_label(LL);
mk_label(new) ->
  L = hipe_gensym:new_label(icode),
  LL = (2 * L) + 1,
  hipe_gensym:update_lblrange(icode, LL),
  hipe_icode:mk_label(LL).

%% Maps from the BEAM's labelling scheme to our labelling scheme.
%% See mk_label to understand how it works.

map_label(L) ->
  L bsl 1.  % faster and more type-friendly version of 2 * L

%%-----------------------------------------------------------------------
%% Returns the type of the given variables.
%%-----------------------------------------------------------------------

type({x,_}) ->
  var;
type({y,_}) ->
  var;
type({fr,_}) ->
  var;
type({atom,A}) when is_atom(A) ->
  #beam_const{value=A};
type(nil) ->
  #beam_const{value=[]};
type({integer,X}) when is_integer(X) ->
  #beam_const{value=X};
type({float,X}) when is_float(X) ->
  #beam_const{value=X};
type({literal,X}) ->
  #beam_const{value=X}.

%%-----------------------------------------------------------------------
%% Returns true iff the argument is a variable.
%%-----------------------------------------------------------------------

is_var({x,_}) ->
  true;
is_var({y,_}) ->
  true;
is_var({fr,_}) ->
  true;
is_var({atom,A}) when is_atom(A) ->
  false;
is_var(nil) ->
  false;
is_var({integer,N}) when is_integer(N) ->
  false;
is_var({float,F}) when is_float(F) ->
  false;
is_var({literal,_Literal}) ->
  false.

%%-----------------------------------------------------------------------
%% Fixes the code for catches by adding some code.
%%-----------------------------------------------------------------------

fix_catches(Code) ->
  fix_catches(Code, gb_trees:empty()).

%% We need to handle merged catch blocks, that is multiple 'catch' with
%% only one 'catch_end', or multiple 'try' with one 'try_case'. (Catch
%% and try can never be merged.) All occurrences of 'catch' or 'try'
%% with a particular fail-to label are assumed to only occur before the
%% corresponding 'catch_end'/'try_end' in the Beam code.

fix_catches([{'catch',N,Lbl},ContLbl|Code], HandledCatchLbls) ->
  fix_catch('catch',Lbl,ContLbl,Code,HandledCatchLbls,{catch_end,N});
fix_catches([{'try',N,Lbl},ContLbl|Code], HandledCatchLbls) ->
  fix_catch('try',Lbl,ContLbl,Code,HandledCatchLbls,{try_case,N});
fix_catches([Instr|Code], HandledCatchLbls) ->
  [Instr|fix_catches(Code, HandledCatchLbls)];
fix_catches([], _HandledCatchLbls) ->
  [].

fix_catch(Type, Lbl, ContLbl, Code, HandledCatchLbls, Instr) ->
  TLbl = {Type, Lbl},
  case gb_trees:lookup(TLbl, HandledCatchLbls) of
    {value, Catch} when is_integer(Catch) ->
      NewCode = fix_catches(Code, HandledCatchLbls),
      Cont = hipe_icode:label_name(ContLbl),
      [hipe_icode:mk_begin_try(Catch,Cont),ContLbl | NewCode];
    none ->
      OldCatch = map_label(Lbl),
      OldCatchLbl = hipe_icode:mk_label(OldCatch),
      {CodeToCatch,RestOfCode} = split_code(Code,OldCatchLbl,Instr),
      NewCatchLbl = mk_label(new),
      NewCatch = hipe_icode:label_name(NewCatchLbl),
      %% The rest of the code cannot contain catches with the same label.
      RestOfCode1 = fix_catches(RestOfCode, HandledCatchLbls),
      %% The catched code *can* contain more catches with the same label.
      NewHandledCatchLbls = gb_trees:insert(TLbl, NewCatch, HandledCatchLbls),
      CatchedCode = fix_catches(CodeToCatch, NewHandledCatchLbls),
      %% The variables which will get the tag, value, and trace.
      Vars = [mk_var({r,0}), mk_var({x,1}), mk_var({x,2})],
      Cont = hipe_icode:label_name(ContLbl),
      [hipe_icode:mk_begin_try(NewCatch,Cont), ContLbl]
	++ CatchedCode
	++ [mk_label(new), % dummy label before the goto
	    hipe_icode:mk_goto(OldCatch),  % normal execution path
	    NewCatchLbl,  % exception handing enters here
	    hipe_icode:mk_begin_handler(Vars)]
        ++ catch_handler(Type, Vars, OldCatchLbl)
	++ RestOfCode1  % back to normal execution
  end.

catch_handler('try', _Vars, OldCatchLbl) ->
  %% A try just falls through to the old fail-to label which marked the
  %% start of the try_case block. All variables are set up as expected.
  [OldCatchLbl];
catch_handler('catch', [TagVar,ValueVar,TraceVar], OldCatchLbl) ->
  %% This basically implements a catch as a try-expression. We must jump
  %% to the given end label afterwards so we don't pass through both the
  %% begin_handler and the end_try.
  ContLbl = mk_label(new),
  Cont = hipe_icode:label_name(ContLbl),
  ThrowLbl = mk_label(new),
  NoThrowLbl = mk_label(new),
  ExitLbl = mk_label(new),
  ErrorLbl = mk_label(new),
  Dst = mk_var({r,0}),
  [hipe_icode:mk_if('=:=', [TagVar, hipe_icode:mk_const('throw')],
		    hipe_icode:label_name(ThrowLbl),
		    hipe_icode:label_name(NoThrowLbl)),
   ThrowLbl,
   hipe_icode:mk_move(Dst, ValueVar),   
   hipe_icode:mk_goto(Cont),
   NoThrowLbl,
   hipe_icode:mk_if('=:=', [TagVar, hipe_icode:mk_const('exit')],
		    hipe_icode:label_name(ExitLbl),
		    hipe_icode:label_name(ErrorLbl)),
   ExitLbl,
   hipe_icode:mk_primop([Dst],mktuple,[hipe_icode:mk_const('EXIT'),
				       ValueVar]),
   hipe_icode:mk_goto(Cont),
   ErrorLbl,
   %% We use the trace variable to hold the symbolic trace. Its previous
   %% value is just that in p->ftrace, so get_stacktrace() works fine.
   hipe_icode:mk_call([TraceVar],erlang,get_stacktrace,[],remote),
   hipe_icode:mk_primop([ValueVar],mktuple, [ValueVar, TraceVar]),
   hipe_icode:mk_goto(hipe_icode:label_name(ExitLbl)),
   OldCatchLbl,  % normal execution paths must go through end_try
   hipe_icode:mk_end_try(),
   hipe_icode:mk_goto(Cont),
   ContLbl].

%% Note that it is the fail-to label that is the important thing, but
%% for 'catch' we want to make sure that the label is followed by the
%% 'catch_end' instruction - if it is not, we might have a real problem.
%% Checking that a 'try' label is followed by 'try_case' is not as
%% important, but we get that as a bonus.

split_code([First|Code], Label, Instr) ->
  split_code(Code, Label, Instr, First, []).

split_code([Instr|Code], Label, Instr, Prev, As) when Prev =:= Label ->
  split_code_final(Code, As);  % drop both label and instruction
split_code([{icode_end_try}|_]=Code, Label, {try_case,_}, Prev, As)
  when Prev =:= Label ->
  %% The try_case has been replaced with try_end as an optimization.
  %% Keep this instruction, since it might be the only try_end instruction
  %% for this try/catch block.
  split_code_final(Code, As);  % drop label
split_code([Other|_Code], Label, Instr, Prev, _As) when Prev =:= Label ->
  ?EXIT({missing_instr_after_label, Label, Instr, [Other, Prev | _As]});
split_code([Other|Code], Label, Instr, Prev, As) ->
  split_code(Code, Label, Instr, Other, [Prev|As]);
split_code([], _Label, _Instr, Prev, As) ->
  split_code_final([], [Prev|As]).

split_code_final(Code, As) ->
  {lists:reverse(As), Code}.

%%-----------------------------------------------------------------------
%% Fixes fallthroughs
%%-----------------------------------------------------------------------

fix_fallthroughs([]) ->
  [];
fix_fallthroughs([I|Is]) ->
  fix_fallthroughs(Is, I, []).

fix_fallthroughs([I1|Is], I0, Acc) ->
  case hipe_icode:is_label(I1) of
    false ->
      fix_fallthroughs(Is, I1, [I0 | Acc]);
    true ->
      case hipe_icode:is_branch(I0) of
	true ->
	  fix_fallthroughs(Is, I1, [I0 | Acc]);
	false ->
	  %% non-branch before label - insert a goto
	  Goto = hipe_icode:mk_goto(hipe_icode:label_name(I1)),
	  fix_fallthroughs(Is, I1, [Goto, I0 | Acc])
      end
  end;
fix_fallthroughs([], I, Acc) ->
  lists:reverse([I | Acc]).

%%-----------------------------------------------------------------------
%% Removes the code between a fail instruction and the closest following
%% label.
%%-----------------------------------------------------------------------

-spec remove_dead_code(icode_instrs()) -> icode_instrs().
remove_dead_code([I|Is]) ->
  case I of
    #icode_fail{} ->
      [I|remove_dead_code(skip_to_label(Is))];
    _ ->
      [I|remove_dead_code(Is)]
  end;
remove_dead_code([]) ->
  [].

%% returns the instructions from the closest label
-spec skip_to_label(icode_instrs()) -> icode_instrs().
skip_to_label([I|Is] = Instrs) ->
  case I of
    #icode_label{} -> Instrs;
    _ -> skip_to_label(Is)
  end;
skip_to_label([]) ->
  [].

%%-----------------------------------------------------------------------
%% This needs to be extended in case new architectures are added.
%%-----------------------------------------------------------------------

resolve_native_endianess(Flags) ->
  case {Flags band 16#10, hipe_rtl_arch:endianess()} of
    {16#10, big} ->
      Flags band 5;
    {16#10, little} ->
      (Flags bor 2) band 7;  
    _ ->
      Flags band 7
  end.

%%-----------------------------------------------------------------------
%% Potentially useful for debugging.
%%-----------------------------------------------------------------------

pp_beam(BeamCode, Options) ->
  case proplists:get_value(pp_beam, Options) of
    true ->
      pp(BeamCode);
    {file,FileName} ->
      {ok,File} = file:open(FileName, [write]),
      pp(File, BeamCode);
    _ -> %% includes "false" case
      ok
  end.

pp(Code) ->
  pp(standard_io, Code).

pp(Stream, []) ->
  case Stream of  %% I am not sure whether this is necessary
    standard_io -> ok;
    _ -> ok = file:close(Stream)
  end;
pp(Stream, [FunCode|FunCodes]) ->
  pp_mfa(Stream, FunCode),
  put_nl(Stream),
  pp(Stream, FunCodes).

pp_mfa(Stream, FunCode) ->
  lists:foreach(fun(Instr) -> print_instr(Stream, Instr) end, FunCode).

print_instr(Stream, {label,Lbl}) ->
  io:format(Stream, "  label ~p:\n", [Lbl]);
print_instr(Stream, Op) ->
  io:format(Stream, "    ~p\n", [Op]).

put_nl(Stream) ->
  io:format(Stream, "\n", []).

%%-----------------------------------------------------------------------
%% Handling of environments -- used to process local tail calls.
%%-----------------------------------------------------------------------

%% Construct an environment
env__mk_env(M, F, A, Entry) ->
  #environment{mfa={M,F,A}, entry=Entry}.

%% Get current MFA
env__get_mfa(#environment{mfa=MFA}) -> MFA.

%% Get entry point of the current function
env__get_entry(#environment{entry=EP}) -> EP.

%%-----------------------------------------------------------------------