diff options
Diffstat (limited to 'lib/compiler/src/beam_bool.erl')
| -rw-r--r-- | lib/compiler/src/beam_bool.erl | 751 |
1 files changed, 751 insertions, 0 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl new file mode 100644 index 0000000000..d8c201a194 --- /dev/null +++ b/lib/compiler/src/beam_bool.erl @@ -0,0 +1,751 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-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% +%% +%% Purpose: Optimizes booleans in guards. + +-module(beam_bool). + +-export([module/2]). + +-import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]). + +-define(MAXREG, 1024). + +-record(st, + {next, %Next label number. + ll %Live regs at labels. + }). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + %%io:format("~p:\n", [Mod]), + {Fs,_} = mapfoldl(fun(Fn, Lbl) -> function(Fn, Lbl) end, 100000000, Fs0), + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}, Lbl0) -> + try + {Is,#st{next=Lbl}} = bool_opt(Is0, Lbl0), + {{function,Name,Arity,CLabel,Is},Lbl} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%% +%% Optimize boolean expressions that use guard bifs. Rewrite to +%% use test instructions if possible. +%% + +bool_opt(Asm, Lbl) -> + LiveInfo = beam_utils:index_labels(Asm), + bopt(Asm, [], #st{next=Lbl,ll=LiveInfo}). + +bopt([{block,Bl0}=Block| + [{jump,{f,Succ}}, + {label,Fail}, + {block,[{set,[Dst],[{atom,false}],move}]}, + {label,Succ}|Is]=Is0], Acc0, St) -> + case split_block(Bl0, Dst, Fail, Acc0, true) of + failed -> + bopt(Is0, [Block|Acc0], St); + {Bl,PreBlock} -> + Acc1 = case PreBlock of + [] -> Acc0; + _ -> [{block,PreBlock}|Acc0] + end, + Acc = [{protected,[Dst],Bl,{Fail,Succ}}|Acc1], + bopt(Is, Acc, St) + end; +bopt([{test,is_eq_exact,{f,Fail},[Reg,{atom,true}]}=I|Is], [{block,_}|_]=Acc0, St0) -> + case bopt_block(Reg, Fail, Is, Acc0, St0) of + failed -> bopt(Is, [I|Acc0], St0); + {Acc,St} -> bopt(Is, Acc, St) + end; +bopt([I|Is], Acc, St) -> + bopt(Is, [I|Acc], St); +bopt([], Acc, St) -> + {bopt_reverse(Acc, []),St}. + +bopt_reverse([{protected,[Dst],Block,{Fail,Succ}}|Is], Acc0) -> + Acc = [{block,Block},{jump,{f,Succ}}, + {label,Fail}, + {block,[{set,[Dst],[{atom,false}],move}]}, + {label,Succ}|Acc0], + bopt_reverse(Is, Acc); +bopt_reverse([I|Is], Acc) -> + bopt_reverse(Is, [I|Acc]); +bopt_reverse([], Acc) -> Acc. + +%% bopt_block(Reg, Fail, OldIs, Accumulator, St) -> failed | {NewAcc,St} +%% Attempt to optimized a block of guard BIFs followed by a test +%% instruction. +bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> + case split_block(Bl0, Reg, Fail, Acc0, false) of + failed -> + %% Reason for failure: The block either contained no + %% guard BIFs with the failure label Fail, or the final + %% instruction in the block did not assign the Reg register. + + %%io:format("split ~p: ~P\n", [Reg,Bl0,20]), + failed; + {Bl1,BlPre} -> + %% The block has been splitted. Bl1 is a non-empty list + %% of guard BIF instructions having the failure label Fail. + %% BlPre is a (possibly empty list) of instructions preceeding + %% Bl1. + Acc1 = make_block(BlPre, Acc0), + {Bl,Acc} = extend_block(Bl1, Fail, Acc1), + try + {NewCode,St} = bopt_tree_cg(Bl, Fail, St0), + ensure_opt_safe(Bl, NewCode, OldIs, Fail, Acc, St), + {NewCode++Acc,St} + catch + %% Not possible to rewrite because a boolean value is + %% passed to another guard bif, e.g. 'abs(A > B)' + %% (in this case, obviously nonsense code). Rare in + %% practice. + throw:mixed -> + failed; + + %% The 'xor' operator was used. We currently don't + %% find it worthwile to translate 'xor' operators + %% (the code would be clumsy). + throw:'xor' -> + failed; + + %% The block does not contain a boolean expression, + %% but only a call to a guard BIF. + %% For instance: ... when element(1, T) -> + throw:not_boolean_expr -> + failed; + + %% The block contains a 'move' instruction that could + %% not be handled. + throw:move -> + failed; + + %% The optimization is not safe. (A register + %% used by the instructions following the + %% optimized code is either not assigned a + %% value at all or assigned a different value.) + throw:all_registers_not_killed -> + failed; + throw:registers_used -> + failed; + + %% A protected block refered to the value + %% returned by another protected block, + %% probably because the Core Erlang code + %% used nested try/catches in the guard. + %% (v3_core never produces nested try/catches + %% in guards, so it must have been another + %% Core Erlang translator.) + throw:protected_violation -> + failed + end + end. + +%% ensure_opt_safe(OriginalCode, OptCode, FollowingCode, Fail, +%% ReversedPreceedingCode, State) -> ok +%% Comparing the original code to the optimized code, determine +%% whether the optimized code is guaranteed to work in the same +%% way as the original code. +%% +%% Throws an exception if the optmization is not safe. +%% +ensure_opt_safe(Bl, NewCode, OldIs, Fail, PreceedingCode, St) -> + %% Here are the conditions that must be true for the + %% optimization to be safe. + %% + %% 1. If a register is INITIALIZED by PreceedingCode, + %% then if that register assigned a value in the original + %% code, but not in the optimized code, it must be UNUSED or KILLED + %% in the code that follows. + %% + %% 2. If a register is not known to be INITIALIZED by PreccedingCode, + %% then if that register assigned a value in the original + %% code, but not in the optimized code, it must be KILLED + %% by the code that follows. + %% + %% 3. Any register that is assigned a value in the optimized + %% code must be UNUSED or KILLED in the following code. + %% (Possible future improvement: Registers that are known + %% to be assigned the SAME value in the original and optimized + %% code don't need to be unused in the following code.) + + InitInPreceeding = initialized_regs(PreceedingCode), + + PrevDst = dst_regs(Bl), + NewDst = dst_regs(NewCode), + NotSet = ordsets:subtract(PrevDst, NewDst), + MustBeKilled = ordsets:subtract(NotSet, InitInPreceeding), + MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), MustBeKilled), + + case all_killed(MustBeKilled, OldIs, Fail, St) of + false -> throw(all_registers_not_killed); + true -> ok + end, + case none_used(MustBeUnused, OldIs, Fail, St) of + false -> throw(registers_used); + true -> ok + end, + ok. + +update_fail_label([{set,_,_,move}=I|Is], Fail, Acc) -> + update_fail_label(Is, Fail, [I|Acc]); +update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> + update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); +update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> + update_fail_label(Is, Fail, + [{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,Fail}}}}|Acc]); +update_fail_label([], _, Acc) -> reverse(Acc). + +make_block(Bl) -> + make_block(Bl, []). + +make_block([], Acc) -> Acc; +make_block(Bl, Acc) -> [{block,Bl}|Acc]. + +extend_block(BlAcc, Fail, [{protected,_,_,_}=Prot|OldAcc]) -> + extend_block([Prot|BlAcc], Fail, OldAcc); +extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]) -> + case extend_block_1(reverse(Is0), Fail, BlAcc0) of + {BlAcc,[]} -> extend_block(BlAcc, Fail, OldAcc); + {BlAcc,Is} -> {BlAcc,[{block,Is}|OldAcc]} + end; +extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}. + +extend_block_1([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> + extend_block_1(Is, Fail, [I|Acc]); +extend_block_1([{set,[_],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) -> + case safe_bool_op(Bif, length(As)) of + false -> {Acc,reverse(Is0)}; + true -> extend_block_1(Is, Fail, [I|Acc]) + end; +extend_block_1([_|_]=Is, _, Acc) -> {Acc,reverse(Is)}; +extend_block_1([], _, Acc) -> {Acc,[]}. + +%% split_block([Instruction], Destination, FailLabel, [PreInstruction], +%% ProhibitFailLabelInPreBlock) -> failed | {Block,PreBlock} +%% Split a sequence of instructions into two blocks - one containing +%% all guard bif instructions and a pre-block all instructions before +%% the guard BIFs. + +split_block(Is0, Dst, Fail, PreIs, ProhibitFailLabel) -> + case ProhibitFailLabel andalso beam_jump:is_label_used_in(Fail, PreIs) of + true -> + %% The failure label was used in one of the instructions (most + %% probably bit syntax construction) preceeding the block, + %% the caller might eliminate the label. + failed; + false -> + case reverse(Is0) of + [{set,[Dst],_,_}|_]=Is -> + split_block_1(Is, Fail, ProhibitFailLabel); + _ -> failed + end + end. + +split_block_1(Is, Fail, ProhibitFailLabel) -> + case split_block_2(Is, Fail, []) of + {[],_} -> failed; + {_,PreBlock}=Res -> + case ProhibitFailLabel andalso + split_block_label_used(PreBlock, Fail) of + true -> + %% The failure label was used in the pre-block; + %% not allowed, because the label may be removed. + failed; + false -> + Res + end + end. + +split_block_2([{set,_,_,move}=I|Is], Fail, Acc) -> + split_block_2(Is, Fail, [I|Acc]); +split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> + split_block_2(Is, Fail, [I|Acc]); +split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> + split_block_2(Is, Fail, [I|Acc]); +split_block_2(Is0, _, Acc) -> + Is = reverse(Is0), + {Acc,Is}. + +split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) -> + true; +split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) -> + true; +split_block_label_used([_|Is], Fail) -> + split_block_label_used(Is, Fail); +split_block_label_used([], _) -> false. + +dst_regs(Is) -> + dst_regs(Is, []). + +dst_regs([{block,Bl}|Is], Acc) -> + dst_regs(Bl, dst_regs(Is, Acc)); +dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> + dst_regs(Is, [D|Acc]); +dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> + dst_regs(Is, [D|Acc]); +dst_regs([_|Is], Acc) -> + dst_regs(Is, Acc); +dst_regs([], Acc) -> ordsets:from_list(Acc). + +all_killed([R|Rs], OldIs, Fail, St) -> + case is_killed(R, OldIs, Fail, St) of + false -> false; + true -> all_killed(Rs, OldIs, Fail, St) + end; +all_killed([], _, _, _) -> true. + +none_used([R|Rs], OldIs, Fail, St) -> + case is_not_used(R, OldIs, Fail, St) of + false -> false; + true -> none_used(Rs, OldIs, Fail, St) + end; +none_used([], _, _, _) -> true. + +bopt_tree_cg(Block0, Fail, St) -> + Free = free_variables(Block0), + Block = ssa_block(Block0), +%% io:format("~p\n", [Block0]), +%% io:format("~p\n", [Block]), +%% io:format("~p\n", [gb_trees:to_list(Free)]), + case bopt_tree(Block, Free, []) of + {Pre0,[{_,Tree}]} -> + Pre1 = update_fail_label(Pre0, Fail, []), + Regs0 = init_regs(gb_trees:keys(Free)), +%% io:format("~p\n", [dst_regs(Block0)]), +%% io:format("~p\n", [Pre1]), +%% io:format("~p\n", [Tree]), +%% io:nl(), + {Pre,Regs} = rename_regs(Pre1, Regs0), +%% io:format("~p\n", [Regs0]), +%% io:format("~p\n", [Pre]), + bopt_cg(Tree, Fail, Regs, make_block(Pre), St); + _Res -> + throw(not_boolean_expr) + end. + +bopt_tree([{set,[Dst],As0,{bif,'not',_}}|Is], Forest0, Pre) -> + {[Arg],Forest1} = bopt_bool_args(As0, Forest0), + Forest = gb_trees:enter(Dst, {'not',Arg}, Forest1), + bopt_tree(Is, Forest, Pre); +bopt_tree([{set,[Dst],As0,{bif,'and',_}}|Is], Forest0, Pre) -> + {As,Forest1} = bopt_bool_args(As0, Forest0), + Node = make_and_node(As), + Forest = gb_trees:enter(Dst, Node, Forest1), + bopt_tree(Is, Forest, Pre); +bopt_tree([{set,[Dst],As0,{bif,'or',_}}|Is], Forest0, Pre) -> + {As,Forest1} = bopt_bool_args(As0, Forest0), + Node = make_or_node(As), + Forest = gb_trees:enter(Dst, Node, Forest1), + bopt_tree(Is, Forest, Pre); +bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) -> + throw('xor'); +bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> + ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]), + {ProtPre,[{_,ProtTree}]} = bopt_tree(Code, ProtForest0, []), + Prot = {prot,ProtPre,ProtTree}, + Forest = gb_trees:enter(Dst, Prot, Forest0), + bopt_tree(Is, Forest, Pre); +bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> + case {Src,Dst} of + {{tmp,_},_} -> throw(move); + {_,{tmp,_}} -> throw(move); + _ -> ok + end, + bopt_tree(Is, Forest, [Move|Pre]); +bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> + Ar = length(As), + case safe_bool_op(N, Ar) of + false -> + bopt_good_args(As, Forest0), + Forest = gb_trees:enter(Dst, any, Forest0), + bopt_tree(Is, Forest, [Bif|Pre]); + true -> + bopt_good_args(As, Forest0), + Test = bif_to_test(Dst, N, As), + Forest = gb_trees:enter(Dst, Test, Forest0), + bopt_tree(Is, Forest, Pre) + end; +bopt_tree([{set,[Dst],As,{alloc,_,{gc_bif,_,_}}}=Bif|Is], Forest0, Pre) -> + bopt_good_args(As, Forest0), + Forest = gb_trees:enter(Dst, any, Forest0), + bopt_tree(Is, Forest, [Bif|Pre]); +bopt_tree([], Forest, Pre) -> + {reverse(Pre),[R || {_,V}=R <- gb_trees:to_list(Forest), V =/= any]}. + +safe_bool_op(N, Ar) -> + erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar). + +bopt_bool_args(As, Forest) -> + mapfoldl(fun bopt_bool_arg/2, Forest, As). + +bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp -> + Val = case gb_trees:get(R, Forest) of + any -> {test,is_eq_exact,fail,[R,{atom,true}]}; + Val0 -> Val0 + end, + {Val,gb_trees:delete(R, Forest)}; +bopt_bool_arg(Term, Forest) -> + {Term,Forest}. + +bopt_good_args([A|As], Regs) -> + bopt_good_arg(A, Regs), + bopt_good_args(As, Regs); +bopt_good_args([], _) -> ok. + +bopt_good_arg({Tag,_}=X, Regs) when Tag =:= x; Tag =:= tmp -> + case gb_trees:get(X, Regs) of + any -> ok; + _Other -> + %%io:format("not any: ~p: ~p\n", [X,_Other]), + throw(mixed) + end; +bopt_good_arg(_, _) -> ok. + +bif_to_test(_, N, As) -> + beam_utils:bif_to_test(N, As, fail). + +make_and_node(Is) -> + AndList0 = make_and_list(Is), + case simplify_and_list(AndList0) of + [] -> {atom,true}; + [Op] -> Op; + AndList -> {'and',AndList} + end. + +make_and_list([{'and',As}|Is]) -> + make_and_list(As++Is); +make_and_list([I|Is]) -> + [I|make_and_list(Is)]; +make_and_list([]) -> []. + +simplify_and_list([{atom,true}|T]) -> + simplify_and_list(T); +simplify_and_list([{atom,false}=False|_]) -> + [False]; +simplify_and_list([H|T]) -> + [H|simplify_and_list(T)]; +simplify_and_list([]) -> []. + +make_or_node(Is) -> + OrList0 = make_or_list(Is), + case simplify_or_list(OrList0) of + [] -> {atom,false}; + [Op] -> Op; + OrList -> {'or',OrList} + end. + +make_or_list([{'or',As}|Is]) -> + make_or_list(As++Is); +make_or_list([I|Is]) -> + [I|make_or_list(Is)]; +make_or_list([]) -> []. + +simplify_or_list([{atom,false}|T]) -> + simplify_or_list(T); +simplify_or_list([{atom,true}=True|_]) -> + [True]; +simplify_or_list([H|T]) -> + [H|simplify_or_list(T)]; +simplify_or_list([]) -> []. + +%% Code generation for a boolean tree. + +bopt_cg({'not',Arg}, Fail, Rs, Acc, St) -> + I = bopt_cg_not(Arg), + bopt_cg(I, Fail, Rs, Acc, St); +bopt_cg({'and',As}, Fail, Rs, Acc, St) -> + bopt_cg_and(As, Fail, Rs, Acc, St); +bopt_cg({'or',As}, Fail, Rs, Acc, St0) -> + {Succ,St} = new_label(St0), + bopt_cg_or(As, Succ, Fail, Rs, Acc, St); +bopt_cg({test,N,fail,As0}, Fail, Rs, Acc, St) -> + As = rename_sources(As0, Rs), + Test = {test,N,{f,Fail},As}, + {[Test|Acc],St}; +bopt_cg({inverted_test,N,fail,As0}, Fail, Rs, Acc, St0) -> + As = rename_sources(As0, Rs), + {Lbl,St} = new_label(St0), + {[{label,Lbl},{jump,{f,Fail}},{test,N,{f,Lbl},As}|Acc],St}; +bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) -> + Pre1 = update_fail_label(Pre0, Fail, []), + {Pre,Rs} = rename_regs(Pre1, Rs0), + bopt_cg(Tree, Fail, Rs, make_block(Pre, Acc), St0); +bopt_cg({atom,true}, _Fail, _Rs, Acc, St) -> + {Acc,St}; +bopt_cg({atom,false}, Fail, _Rs, Acc, St) -> + {[{jump,{f,Fail}}|Acc],St}. + +bopt_cg_not({'and',As0}) -> + As = [bopt_cg_not(A) || A <- As0], + {'or',As}; +bopt_cg_not({'or',As0}) -> + As = [bopt_cg_not(A) || A <- As0], + {'and',As}; +bopt_cg_not({'not',Arg}) -> + bopt_cg_not_not(Arg); +bopt_cg_not({test,Test,Fail,As}) -> + {inverted_test,Test,Fail,As}; +bopt_cg_not({atom,Bool}) when is_boolean(Bool) -> + {atom,not Bool}. + +bopt_cg_not_not({'and',As}) -> + {'and',[bopt_cg_not_not(A) || A <- As]}; +bopt_cg_not_not({'or',As}) -> + {'or',[bopt_cg_not_not(A) || A <- As]}; +bopt_cg_not_not({'not',Arg}) -> + bopt_cg_not(Arg); +bopt_cg_not_not(Leaf) -> Leaf. + +bopt_cg_and([I|Is], Fail, Rs, Acc0, St0) -> + {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0), + bopt_cg_and(Is, Fail, Rs, Acc, St); +bopt_cg_and([], _, _, Acc, St) -> {Acc,St}. + +bopt_cg_or([I], Succ, Fail, Rs, Acc0, St0) -> + {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0), + {[{label,Succ}|Acc],St}; +bopt_cg_or([I|Is], Succ, Fail, Rs, Acc0, St0) -> + {Lbl,St1} = new_label(St0), + {Acc,St} = bopt_cg(I, Lbl, Rs, Acc0, St1), + bopt_cg_or(Is, Succ, Fail, Rs, [{label,Lbl},{jump,{f,Succ}}|Acc], St). + +new_label(#st{next=LabelNum}=St) when is_integer(LabelNum) -> + {LabelNum,St#st{next=LabelNum+1}}. + +free_variables(Is) -> + E = gb_sets:empty(), + free_vars_1(Is, E, E, E). + +free_vars_1([{set,Ds,As,move}|Is], F0, N0, A) -> + F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), + N = gb_sets:union(N0, var_list(Ds)), + free_vars_1(Is, F, N, A); +free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> + F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), + N = gb_sets:union(N0, var_list(Ds)), + free_vars_1(Is, F, N, A); +free_vars_1([{set,Ds,As,{alloc,Regs,{gc_bif,_,_}}}|Is], F0, N0, A0) -> + A = gb_sets:union(A0, gb_sets:from_list(free_vars_regs(Regs))), + F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), + N = gb_sets:union(N0, var_list(Ds)), + free_vars_1(Is, F, N, A); +free_vars_1([{protected,_,Pa,_}|Is], F, N, A) -> + free_vars_1(Pa++Is, F, N, A); +free_vars_1([], F0, N, A) -> + F = case gb_sets:is_empty(A) of + true -> + %% No GC BIFs. + {x,X} = gb_sets:smallest(N), + P = ordsets:from_list(free_vars_regs(X)), + ordsets:union(gb_sets:to_list(F0), P); + false -> + %% At least one GC BIF. + gb_sets:to_list(gb_sets:union(F0, gb_sets:difference(A, N))) + end, + gb_trees:from_orddict([{K,any} || K <- F]). + +var_list(Is) -> + var_list_1(Is, gb_sets:empty()). + +var_list_1([{Tag,_}=X|Is], D) when Tag =:= x; Tag =:= y -> + var_list_1(Is, gb_sets:add(X, D)); +var_list_1([_|Is], D) -> + var_list_1(Is, D); +var_list_1([], D) -> D. + +free_vars_regs(0) -> []; +free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. + +rename_regs(Is, Regs) -> + rename_regs(Is, Regs, []). + +rename_regs([{set,_,_,move}=I|Is], Regs, Acc) -> + rename_regs(Is, Regs, [I|Acc]); +rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> + Live = live_regs(Regs0), + Ss = rename_sources(Ss0, Regs0), + Regs = put_reg(Dst0, Regs0), + Dst = fetch_reg(Dst0, Regs), + rename_regs(Is, Regs, [{set,[Dst],Ss,{alloc,Live,Info}}|Acc]); +rename_regs([{set,[Dst0],Ss0,Info}|Is], Regs0, Acc) -> + Ss = rename_sources(Ss0, Regs0), + Regs = put_reg(Dst0, Regs0), + Dst = fetch_reg(Dst0, Regs), + rename_regs(Is, Regs, [{set,[Dst],Ss,Info}|Acc]); +rename_regs([], Regs, Acc) -> {reverse(Acc),Regs}. + +rename_sources(Ss, Regs) -> + map(fun({x,_}=R) -> fetch_reg(R, Regs); + ({tmp,_}=R) -> fetch_reg(R, Regs); + (E) -> E + end, Ss). + +%%% +%%% Keeping track of register assignments. +%%% + +init_regs(Free) -> + init_regs_1(Free, 0). + +init_regs_1([{x,I}=V|T], I) -> + [{I,V}|init_regs_1(T, I+1)]; +init_regs_1([{x,X}|_]=T, I) when I < X -> + [{I,reserved}|init_regs_1(T, I+1)]; +init_regs_1([{y,_}|_], _) -> []; +init_regs_1([], _) -> []. + +put_reg(V, Rs) -> put_reg_1(V, Rs, 0). + +put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)]; +put_reg_1(V, [], I) -> [{I,V}]. + +fetch_reg(V, [{I,V}|_]) -> {x,I}; +fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). + +live_regs(Regs) -> + foldl(fun ({I,_}, _) -> I; + ([], Max) -> Max end, + -1, Regs)+1. + + +%%% +%%% Convert a block to Static Single Assignment (SSA) form. +%%% + +-record(ssa, + {live=0, %Variable counter. + sub=gb_trees:empty(), %Substitution table. + prot=gb_sets:empty(), %Targets assigned by protecteds. + in_prot=false %Inside a protected. + }). + +ssa_block(Is0) -> + {Is,_} = ssa_block_1(Is0, #ssa{}, []), + Is. + +ssa_block_1([{protected,[_],Pa0,Pb}|Is], Sub0, Acc) -> + {Pa,Sub1} = ssa_block_1(Pa0, Sub0#ssa{in_prot=true}, []), + Dst = ssa_last_target(Pa), + Sub = Sub1#ssa{prot=gb_sets:insert(Dst, Sub1#ssa.prot), + in_prot=Sub0#ssa.in_prot}, + ssa_block_1(Is, Sub, [{protected,[Dst],Pa,Pb}|Acc]); +ssa_block_1([{set,[Dst],As,Bif}|Is], Sub0, Acc0) -> + Sub1 = ssa_in_use_list(As, Sub0), + Sub = ssa_assign(Dst, Sub1), + Acc = [{set,[ssa_sub(Dst, Sub)],ssa_sub_list(As, Sub0),Bif}|Acc0], + ssa_block_1(Is, Sub, Acc); +ssa_block_1([], Sub, Acc) -> {reverse(Acc),Sub}. + +ssa_in_use_list(As, Sub) -> + foldl(fun ssa_in_use/2, Sub, As). + +ssa_in_use({x,_}=R, #ssa{sub=Sub0}=Ssa) -> + case gb_trees:is_defined(R, Sub0) of + true -> Ssa; + false -> + Sub = gb_trees:insert(R, R, Sub0), + Ssa#ssa{sub=Sub} + end; +ssa_in_use(_, Ssa) -> Ssa. + +ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> + {NewReg,Ssa} = ssa_new_reg(Ssa0), + case gb_trees:is_defined(R, Sub0) of + false -> + Sub = gb_trees:insert(R, NewReg, Sub0), + Ssa#ssa{sub=Sub}; + true -> + Sub1 = gb_trees:update(R, NewReg, Sub0), + Sub = gb_trees:insert(NewReg, NewReg, Sub1), + Ssa#ssa{sub=Sub} + end; +ssa_assign(_, Ssa) -> Ssa. + +ssa_sub_list(List, Sub) -> + [ssa_sub(E, Sub) || E <- List]. + +ssa_sub(R0, #ssa{sub=Sub,prot=Prot,in_prot=InProt}) -> + case gb_trees:lookup(R0, Sub) of + none -> R0; + {value,R} -> + case InProt andalso gb_sets:is_element(R, Prot) of + true -> + throw(protected_violation); + false -> + R + end + end. + +ssa_new_reg(#ssa{live=Reg}=Ssa) -> + {{tmp,Reg},Ssa#ssa{live=Reg+1}}. + +ssa_last_target([{set,[Dst],_,_}]) -> Dst; +ssa_last_target([_|Is]) -> ssa_last_target(Is). + +%% is_killed(Register, [Instruction], FailLabel, State) -> true|false +%% Determine whether a register is killed in the instruction sequence. +%% The state is used to allow us to determine the kill state +%% across branches. + +is_killed(R, Is, Label, #st{ll=Ll}) -> + beam_utils:is_killed(R, Is, Ll) andalso + beam_utils:is_killed_at(R, Label, Ll). + +%% is_not_used(Register, [Instruction], FailLabel, State) -> true|false +%% Determine whether a register is never used in the instruction sequence +%% (it could still referenced by an allocate instruction, meaning that +%% it MUST be initialized). +%% The state is used to allow us to determine the usage state +%% across branches. + +is_not_used(R, Is, Label, #st{ll=Ll}) -> + beam_utils:is_not_used(R, Is, Ll) andalso + beam_utils:is_not_used_at(R, Label, Ll). + +%% initialized_regs([Instruction]) -> [Register]) +%% Given a REVERSED instruction sequence, return a list of the registers +%% that are guaranteed to be initialized (not contain garbage). + +initialized_regs(Is) -> + initialized_regs(Is, ordsets:new()). + +initialized_regs([{set,Dst,Src,_}|Is], Regs) -> + initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs))); +initialized_regs([{test,_,_,Src}|Is], Regs) -> + initialized_regs(Is, add_init_regs(Src, Regs)); +initialized_regs([{block,Bl}|Is], Regs) -> + initialized_regs(reverse(Bl, Is), Regs); +initialized_regs([{bs_context_to_binary,Src}|Is], Regs) -> + initialized_regs(Is, add_init_regs([Src], Regs)); +initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) -> + InitRegs = free_vars_regs(Arity), + add_init_regs(InitRegs, Regs); +initialized_regs([_|_], Regs) -> Regs; +initialized_regs([], Regs) -> Regs. + +add_init_regs([{x,_}=X|T], Regs) -> + add_init_regs(T, ordsets:add_element(X, Regs)); +add_init_regs([_|T], Regs) -> + add_init_regs(T, Regs); +add_init_regs([], Regs) -> Regs. |