diff options
Diffstat (limited to 'lib/compiler/src/sys_core_bsm.erl')
-rw-r--r-- | lib/compiler/src/sys_core_bsm.erl | 312 |
1 files changed, 25 insertions, 287 deletions
diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl index 62657933ee..685e807e65 100644 --- a/lib/compiler/src/sys_core_bsm.erl +++ b/lib/compiler/src/sys_core_bsm.erl @@ -24,223 +24,52 @@ -export([module/2,format_error/1]). -include("core_parse.hrl"). --import(lists, [member/2,reverse/1,usort/1]). -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}. -module(#c_module{defs=Ds0}=Mod, Opts) -> - {Ds,Ws0} = function(Ds0, [], []), - case member(bin_opt_info, Opts) of - false -> - {ok,Mod#c_module{defs=Ds}}; - true -> - Ws1 = [make_warning(Where, What) || {Where,What} <- Ws0], - Ws = usort(Ws1), - {ok,Mod#c_module{defs=Ds},Ws} - end. +module(#c_module{defs=Ds}=Mod, _Opts) -> + {ok,Mod#c_module{defs=function(Ds)}}. -function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) -> - try cerl_trees:mapfold(fun bsm_an/2, Ws0, B0) of - {B,Ws} -> - function(Fs, [{Name,B}|FsAcc], Ws) +function([{#c_var{name={F,Arity}}=Name,B0}|Fs]) -> + try cerl_trees:map(fun bsm_reorder/1, B0) of + B -> [{Name,B} | function(Fs)] catch - throw:unsafe_bs_context_to_binary -> - %% Unsafe bs_context_to_binary (in the sense that the - %% contents of the binary will probably be wrong). - %% Disable binary optimizations for the entire function. - %% We don't generate an INFO message, because this happens - %% very infrequently and it would be hard to explain in - %% a comprehensible way in an INFO message. - function(Fs, [{Name,B0}|FsAcc], Ws0); Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [F,Arity]), - erlang:raise(Class, Error, Stack) + io:fwrite("Function: ~w/~w\n", [F,Arity]), + erlang:raise(Class, Error, Stack) end; -function([], Fs, Ws) -> - {reverse(Fs),Ws}. +function([]) -> + []. -type error() :: atom(). -spec format_error(error()) -> nonempty_string(). -format_error(bin_opt_alias) -> - "INFO: the '=' operator will prevent delayed sub binary optimization"; -format_error(bin_partition) -> - "INFO: matching non-variables after a previous clause matching a variable " - "will prevent delayed sub binary optimization"; -format_error(bin_var_used) -> - "INFO: using a matched out sub binary will prevent " - "delayed sub binary optimization"; -format_error(orig_bin_var_used_in_guard) -> - "INFO: using the original binary variable in a guard will prevent " - "delayed sub binary optimization"; -format_error(bin_var_used_in_guard) -> - "INFO: using a matched out sub binary in a guard will prevent " - "delayed sub binary optimization". - +format_error(_) -> error(badarg). -%%% -%%% Annotate bit syntax matching to faciliate optimization in further passes. -%%% +%%% Reorder bit syntax matching to faciliate optimization in further passes. -bsm_an(Core0, Ws0) -> - case bsm_an(Core0) of - {ok,Core} -> - {Core,Ws0}; - {ok,Core,W} -> - {Core,[W|Ws0]} - end. +bsm_reorder(#c_case{arg=#c_var{}=V}=Case) -> + bsm_reorder_1([V], Case); +bsm_reorder(#c_case{arg=#c_values{es=Es}}=Case) -> + bsm_reorder_1(Es, Case); +bsm_reorder(Core) -> + Core. -bsm_an(#c_case{arg=#c_var{}=V}=Case) -> - bsm_an_1([V], Case); -bsm_an(#c_case{arg=#c_values{es=Es}}=Case) -> - bsm_an_1(Es, Case); -bsm_an(Other) -> - {ok,Other}. - -bsm_an_1(Vs0, #c_case{clauses=Cs0}=Case) -> +bsm_reorder_1(Vs0, #c_case{clauses=Cs0}=Case) -> case bsm_leftmost(Cs0) of - none -> - {ok,Case}; - 1 -> - bsm_an_2(Vs0, Cs0, Case); - Pos -> - Vs = move_from_col(Pos, Vs0), - Cs = [C#c_clause{pats=move_from_col(Pos, Ps)} || - #c_clause{pats=Ps}=C <- Cs0], - bsm_an_2(Vs, Cs, Case) - end. - -bsm_an_2(Vs, Cs, Case) -> - try - bsm_ensure_no_partition(Cs), - {ok,bsm_do_an(Vs, Cs, Case)} - catch - throw:{problem,Where,What} -> - {ok,Case,{Where,What}} + Pos when Pos > 0, Pos =/= none -> + Vs = core_lib:make_values(move_from_col(Pos, Vs0)), + Cs = [C#c_clause{pats=move_from_col(Pos, Ps)} + || #c_clause{pats=Ps}=C <- Cs0], + Case#c_case{arg=Vs,clauses=Cs}; + _ -> + Case end. move_from_col(Pos, L) -> {First,[Col|Rest]} = lists:split(Pos - 1, L), [Col|First] ++ Rest. -bsm_do_an([#c_var{name=Vname}=V0|Vs0], Cs0, Case) -> - bsm_inner_context_to_binary(Cs0), - Cs = bsm_do_an_var(Vname, Cs0), - V = bsm_annotate_for_reuse(V0), - Vs = core_lib:make_values([V|Vs0]), - Case#c_case{arg=Vs,clauses=Cs}; -bsm_do_an(_Vs, _Cs, Case) -> Case. - -bsm_inner_context_to_binary([#c_clause{body=B}|Cs]) -> - %% Consider: - %% - %% foo(<<Length, Data/binary>>) -> %Line 1 - %% case {Data, Length} of %Line 2 - %% {_, 0} -> Data; %Line 3 - %% {<<...>>, 4} -> ... %Line 4 - %% end. - %% - %% No sub binary will be created for Data in line 1. The match - %% context will be passed on to the `case` in line 2. In line 3, - %% this pass inserts a `bs_context_to_binary` instruction to - %% convert the match context representing Data to a binary before - %% returning it. The problem is that the binary created will be - %% the original binary (including the matched out Length field), - %% not the tail of the binary as it is supposed to be. - %% - %% Here follows a heuristic to disable the binary optimizations - %% for the entire function if this code kind of code is found. - - case cerl_trees:free_variables(B) of - [] -> - %% Since there are no free variables in the body of - %% this clause, there can't be any troublesome - %% bs_context_to_binary instructions. - bsm_inner_context_to_binary(Cs); - [_|_]=Free -> - %% One of the free variables could refer to a match context - %% created by the outer binary match. - F = fun(#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}, _) -> - case member(V, Free) of - true -> - %% This bs_context_to_binary instruction will - %% make a binary of the match context from an - %% outer binary match. It is very likely that - %% the contents of the binary will be wrong - %% (the original binary as opposed to only - %% the tail binary). - throw(unsafe_bs_context_to_binary); - false -> - %% Safe. This bs_context_to_binary instruction - %% will make a binary from a match context - %% defined in the body of the clause. - ok - end; - (_, _) -> - ok - end, - cerl_trees:fold(F, ok, B) - end; -bsm_inner_context_to_binary([]) -> ok. - -bsm_do_an_var(V, [#c_clause{pats=[P|_],guard=G,body=B0}=C0|Cs]) -> - case P of - #c_var{name=VarName} -> - case core_lib:is_var_used(V, G) of - true -> bsm_problem(C0, orig_bin_var_used_in_guard); - false -> ok - end, - case core_lib:is_var_used(VarName, G) of - true -> bsm_problem(C0, bin_var_used_in_guard); - false -> ok - end, - B1 = bsm_maybe_ctx_to_binary(VarName, B0), - B = bsm_maybe_ctx_to_binary(V, B1), - C = C0#c_clause{body=B}, - [C|bsm_do_an_var(V, Cs)]; - #c_alias{} -> - case bsm_could_match_binary(P) of - false -> - [C0|bsm_do_an_var(V, Cs)]; - true -> - bsm_problem(C0, bin_opt_alias) - end; - _ -> - case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of - false -> - [C0|bsm_do_an_var(V, Cs)]; - true -> - bsm_problem(C0, bin_var_used) - end - end; -bsm_do_an_var(_, []) -> []. - -bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) -> - Var#c_var{anno=[reuse_for_context|Anno]}. - -bsm_is_var_used(V, G, B) -> - core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B). - -bsm_maybe_ctx_to_binary(V, B) -> - case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of - false -> - B; - true -> - #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}, - body=B} - end. - -previous_ctx_to_binary(V, Core) -> - case Core of - #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}} -> - true; - _ -> - false - end. - %% bsm_leftmost(Cs) -> none | ArgumentNumber %% Find the leftmost argument that matches a nonempty binary. %% Return either 'none' or the argument number (1-N). @@ -262,94 +91,3 @@ bsm_leftmost_2([_|Ps], Cs, N, Pos) -> bsm_leftmost_2(Ps, Cs, N+1, Pos); bsm_leftmost_2([], Cs, _, Pos) -> bsm_leftmost_1(Cs, Pos). - -%% bsm_ensure_no_partition(Cs) -> ok (exception if problem) -%% There must only be a single bs_start_match2 instruction if we -%% are to reuse the binary variable for the match context. -%% -%% To make sure that there is only a single bs_start_match2 -%% instruction, we will check for partitions such as: -%% -%% foo(<<...>>) -> ... -%% foo(<Variable>) when ... -> ... -%% foo(<Non-variable pattern>) -> -%% -%% If there is such partition, we reject the optimization. - -bsm_ensure_no_partition(Cs) -> - bsm_ensure_no_partition_1(Cs, before). - -%% Loop through each clause. -bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], State0) -> - State = bsm_ensure_no_partition_2(Ps, G, State0), - case State of - 'after' -> - bsm_ensure_no_partition_after(Cs); - _ -> - ok - end, - bsm_ensure_no_partition_1(Cs, State); -bsm_ensure_no_partition_1([], _) -> ok. - -bsm_ensure_no_partition_2([#c_binary{}|_], _, _State) -> - within; -bsm_ensure_no_partition_2([#c_alias{}=Alias|_], N, State) -> - %% Retrieve the real pattern that the alias refers to and check that. - P = bsm_real_pattern(Alias), - bsm_ensure_no_partition_2([P], N, State); -bsm_ensure_no_partition_2([_|_], _, before=State) -> - %% No binary matching yet - therefore no partition. - State; -bsm_ensure_no_partition_2([P|_], _, State) -> - case bsm_could_match_binary(P) of - false -> - State; - true -> - %% The pattern P *may* match a binary, so we must update the state. - %% (P must be a variable.) - 'after' - end. - -bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs]) -> - case Ps of - [#c_var{}|_] -> - bsm_ensure_no_partition_after(Cs); - _ -> - bsm_problem(C, bin_partition) - end; -bsm_ensure_no_partition_after([]) -> ok. - -bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); -bsm_could_match_binary(#c_cons{}) -> false; -bsm_could_match_binary(#c_tuple{}) -> false; -bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit); -bsm_could_match_binary(_) -> true. - -bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P); -bsm_real_pattern(P) -> P. - -bsm_problem(Where, What) -> - throw({problem,Where,What}). - -make_warning(Core, Term) -> - case should_suppress_warning(Core) of - true -> - ok; - false -> - Anno = cerl:get_ann(Core), - Line = get_line(Anno), - File = get_file(Anno), - {File,[{Line,?MODULE,Term}]} - end. - -should_suppress_warning(Core) -> - Ann = cerl:get_ann(Core), - member(compiler_generated, Ann). - -get_line([Line|_]) when is_integer(Line) -> Line; -get_line([_|T]) -> get_line(T); -get_line([]) -> none. - -get_file([{file,File}|_]) -> File; -get_file([_|T]) -> get_file(T); -get_file([]) -> "no_file". % should not happen |