diff options
| author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
|---|---|---|
| committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
| commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
| tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/hipe/icode/hipe_beam_to_icode.erl | |
| download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip | |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/hipe/icode/hipe_beam_to_icode.erl')
| -rw-r--r-- | lib/hipe/icode/hipe_beam_to_icode.erl | 2326 |
1 files changed, 2326 insertions, 0 deletions
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl new file mode 100644 index 0000000000..3923e98673 --- /dev/null +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -0,0 +1,2326 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%======================================================================= +%% File : hipe_beam_to_icode.erl +%% Author : Kostis Sagonas +%% Description : Translates symbolic BEAM code to Icode +%%======================================================================= +%% $Id$ +%%======================================================================= +%% @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, mfa/3]). + +%%----------------------------------------------------------------------- + +%% 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). +%%-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)). + +-define(mk_debugcode(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). + +%%----------------------------------------------------------------------- +%% Exported 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}. + +%%----------------------------------------------------------------------- +%% @doc +%% Translates the BEAM code of a single function into Icode. +%% Returns a tuple whose first argument is list of {{M,F,A}, ICode} +%% pairs, where the first entry is that of the given MFA, and the +%% following (in undefined order) are those of the funs that are +%% defined in the function, and recursively, in the funs. The +%% second argument of the tuple is the HiPE compiler options +%% contained in the file. +%% @end +%%----------------------------------------------------------------------- + +-spec mfa(list(), mfa(), comp_options()) -> hipe_beam_to_icode_ret(). + +mfa(BeamFuns, {M,F,A} = MFA, Options) + when is_atom(M), is_atom(F), is_integer(A) -> + BeamCode0 = [beam_disasm:function__code(Fn) || Fn <- BeamFuns], + {ModCode, ClosureInfo} = preprocess_code(BeamCode0), + mfa_loop([MFA], [], sets:new(), ModCode, ClosureInfo, Options). + +mfa_loop([{M,F,A} = MFA | MFAs], Acc, Seen, ModCode, ClosureInfo, + Options) when is_atom(M), is_atom(F), is_integer(A) -> + case sets:is_element(MFA, Seen) of + true -> + mfa_loop(MFAs, Acc, Seen, ModCode, ClosureInfo, Options); + false -> + {Icode, FunMFAs} = mfa_get(M, F, A, ModCode, ClosureInfo, Options), + mfa_loop(FunMFAs ++ MFAs, [{MFA, Icode} | Acc], + sets:add_element(MFA, Seen), + ModCode, ClosureInfo, Options) + end; +mfa_loop([], Acc, _, _, _, _) -> + lists:reverse(Acc). + +mfa_get(M, F, A, ModCode, ClosureInfo, Options) -> + BeamCode = get_fun(ModCode, M,F,A), + pp_beam([BeamCode], Options), % cheat by using a list + Icode = trans_mfa_code(M,F,A, BeamCode, ClosureInfo), + FunMFAs = get_fun_mfas(BeamCode), + {Icode, FunMFAs}. + +get_fun_mfas([{patched_make_fun,{M,F,A} = MFA,_,_,_}|BeamCode]) + when is_atom(M), is_atom(F), is_integer(A) -> + [MFA|get_fun_mfas(BeamCode)]; +get_fun_mfas([_|BeamCode]) -> + get_fun_mfas(BeamCode); +get_fun_mfas([]) -> + []. + +%%----------------------------------------------------------------------- +%% 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_debugcode(MFA, Env2, Code2), + {Code3,_Env3} = {Code2,Env1}), + %% For stack optimization + Leafness = leafness(Code3), + IsLeaf = is_leaf_code(Leafness), + Code4 = + [FunLbl | + case needs_redtest(Leafness) of + false -> Code3; + true -> [mk_redtest()|Code3] + end], + IsClosure = get_closure_info(MFA, ClosureInfo) =/= not_a_closure, + 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) -> % -> true, selfrec, or false + leafness(Is, true). + +leafness([], Leafness) -> + Leafness; +leafness([I|Is], 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, 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, 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, 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, Leafness); + _ -> false + end + end; + _ -> leafness(Is, Leafness) + end. + +%% XXX: this old stuff is passed around but essentially unused +is_leaf_code(Leafness) -> + case Leafness of + true -> true; + selfrec -> true; + false -> false + end. + +needs_redtest(Leafness) -> + case Leafness of + true -> false; + selfrec -> true; + false -> true + end. + +%%----------------------------------------------------------------------- +%% The main translation switch. +%%----------------------------------------------------------------------- + +%%--- label & func_info combo --- +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}, + {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), + [hipe_icode:mk_comment({bif0,BifName}),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), + [hipe_icode:mk_comment({bif1,BifName})|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), + [hipe_icode:mk_comment({bif2,BifName})|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)]; +%%-------------------------------------------------------------------- +%%--- 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_constant --- +trans_fun([{test,is_constant,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(constant,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)]; +%%-------------------------------------------------------------------- +%%--- 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}, [Bits,MsVar]} + 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) -> + True = mk_label(new), + FalseLabName = map_label(Lbl), + TrueLabName = hipe_icode:label_name(True), + MsVar = mk_var(Ms), + TmpVar = mk_var(new), + ByteSize = BitSize div 8, + ExtraBits = BitSize rem 8, + WordSize = hipe_rtl_arch:word_size(), + if ExtraBits =:= 0 -> + trans_op_call({hipe_bs_primop,{bs_match_string,Bin,ByteSize}}, Lbl, + [MsVar], [MsVar], Env, Instructions); + BitSize =< ((WordSize * 8) - 5) -> + <<Int:BitSize, _/bits>> = Bin, + {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,BitSize,0}}, Lbl, + [MsVar], [TmpVar, MsVar], Env), + I2 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName), + I1 ++ [I2,True] ++ trans_fun(Instructions, Env1); + true -> + <<RealBin:ByteSize/binary, Int:ExtraBits, _/bits>> = Bin, + {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_match_string,RealBin,ByteSize}}, Lbl, + [MsVar], [MsVar], Env), + {I2,Env2} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,ExtraBits,0}}, Lbl, + [MsVar], [TmpVar, MsVar], Env1), + I3 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName), + I1 ++ I2 ++ [I3,True] ++ trans_fun(Instructions, Env2) + end; +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), + 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), + 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); +%%-------------------------------------------------------------------- +%% New 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), + 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), + 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_bits_to_bytes2, Bits, Bytes}|Instructions], Env) -> + Src = trans_arg(Bits), + Dst = mk_var(Bytes), + [hipe_icode:mk_primop([Dst], 'bsl', [Src, hipe_icode:mk_const(3)])| + trans_fun(Instructions,Env)]; +trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> + Dst = mk_var(Res), + Temp = mk_var(new), + 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), + if Lbl =:= 0 -> + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)])]; + true -> + Succ = mk_label(new), + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)], + hipe_icode:label_name(Succ), Lbl), + Succ] + end + end, + Succ2 = mk_label(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 -> + {Lbl, []} + end, + IsPos = + [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], + hipe_icode:label_name(Succ2), FailLblName)] ++ + FailCode ++ [Succ2], + AddI = + case Old of + {integer,OldInt} -> + hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]); + _ -> + OldVar = mk_var(Old), + hipe_icode:mk_primop([Dst], '+', [Temp, OldVar]) + end, + MultIs ++ IsPos ++ [AddI|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; +%%-------------------------------------------------------------------- +%% New 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)]; +%%-------------------------------------------------------------------- +%% New test instruction 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)]; +%%-------------------------------------------------------------------- +%% New test instruction added in June 2005 for 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)]; +%%-------------------------------------------------------------------- +%% New garbage-collecting BIFs added in January 2006 for 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; +%%-------------------------------------------------------------------- +%% Instruction for constant pool added in February 2007 for R11B-4. +%%-------------------------------------------------------------------- +trans_fun([{put_literal,{literal,Literal},DstR}|Instructions], Env) -> + DstV = mk_var(DstR), + Move = hipe_icode:mk_move(DstV, hipe_icode:mk_const(Literal)), + [Move | trans_fun(Instructions, Env)]; +%%-------------------------------------------------------------------- +%% New test instruction added in July 2007 for 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)]; +%%-------------------------------------------------------------------- +%% New stack triming instruction added in October 2007 for 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); +%%-------------------------------------------------------------------- +%%--- 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, 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); +%%---------------------------------------------------------------- +%% New binary construction instructions added in R12B-5 (Fall 2008). +%%---------------------------------------------------------------- +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 -> + mk_var(reg); + 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 new +%% 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}. + +%%----------------------------------------------------------------------- +%% 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([{func_info,{atom,M},{atom,F},A}|_]) + when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> + {M, F, A}. + +%%----------------------------------------------------------------------- + +%% Localize a particular function in a module +get_fun([[L, {func_info,{atom,M},{atom,F},A} | Is] | _], M,F,A) -> + [L, {func_info,{atom,M},{atom,F},A} | Is]; +get_fun([[_L1,_L2, {func_info,{atom,M},{atom,F},A} = MFA| _Is] | _], M,F,A) -> + ?WARNING_MSG("Consecutive labels found; please re-create the .beam file~n", []), + [_L1,_L2, MFA | _Is]; +get_fun([_|Rest], M,F,A) -> + get_fun(Rest, 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). + +%%----------------------------------------------------------------------- +%% 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([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. + +%%----------------------------------------------------------------------- |