aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/beam_jump.erl76
-rw-r--r--lib/compiler/src/beam_validator.erl2
-rw-r--r--lib/compiler/src/erl_bifs.erl1
-rwxr-xr-xlib/compiler/src/genop.tab3
-rw-r--r--lib/compiler/src/sys_core_fold.erl42
5 files changed, 91 insertions, 33 deletions
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 9eee56d604..43084ad588 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -156,41 +156,51 @@ function({function,Name,Arity,CLabel,Asm0}) ->
%%%
share(Is0) ->
- %% We will get more sharing if we never fall through to a label.
- Is = eliminate_fallthroughs(Is0, []),
- share_1(Is, #{}, [], []).
+ Is1 = eliminate_fallthroughs(Is0, []),
+ Is2 = find_fixpoint(fun(Is) ->
+ share_1(Is, #{}, #{}, [], [])
+ end, Is1),
+ reverse(Is2).
-share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) ->
+share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) ->
case maps:find(Seq, Dict0) of
- error ->
- Dict = maps:put(Seq, L, Dict0),
- share_1(Is, Dict, [], [Lbl|Seq ++ Acc]);
- {ok,Label} ->
- share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc])
+ error ->
+ Dict = maps:put(Seq, L, Dict0),
+ share_1(Is, Dict, Lbls0, [], [[Lbl|Seq]|Acc]);
+ {ok,Label} ->
+ Lbls = maps:put(L, Label, Lbls0),
+ share_1(Is, Dict0, Lbls, [], [[Lbl,{jump,{f,Label}}]|Acc])
end;
-share_1([{func_info,_,_,_}=I|Is], _, [], Acc) ->
- reverse(Is, [I|Acc]);
-share_1([{'catch',_,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{catch_end,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([I|Is], Dict, Seq, Acc) ->
+share_1([{func_info,_,_,_}|_]=Is0, _, Lbls, [], Acc0) when Lbls =/= #{} ->
+ lists:foldl(fun(Is, Acc) ->
+ beam_utils:replace_labels(Is, Acc, Lbls, fun(Old) -> Old end)
+ end, Is0, Acc0);
+share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} ->
+ lists:foldl(fun lists:reverse/2, Is, Acc);
+share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{jump,{f,To}}=I,{label,L}=Lbl|Is], Dict0, Lbls0, _Seq, Acc) ->
+ Lbls = maps:put(L, To, Lbls0),
+ share_1(Is, Dict0, Lbls, [], [[Lbl,I]|Acc]);
+share_1([I|Is], Dict, Lbls, Seq, Acc) ->
case is_unreachable_after(I) of
false ->
- share_1(Is, Dict, [I|Seq], Acc);
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
true ->
- share_1(Is, Dict, [I], Acc)
+ share_1(Is, Dict, Lbls, [I], Acc)
end.
-clean_non_sharable(Dict) ->
+clean_non_sharable(Dict0, Lbls0) ->
%% We are passing in or out of a 'catch' or 'try' block. Remove
%% sequences that should not be shared over the boundaries of the
%% block. Since the end of the sequence must match, the only
@@ -198,7 +208,17 @@ clean_non_sharable(Dict) ->
%% the 'catch'/'try' block is a sequence that ends with an
%% instruction that causes an exception. Any sequence that causes
%% an exception must contain a line/1 instruction.
- maps:filter(fun(K, _V) -> sharable_with_try(K) end, Dict).
+ Dict1 = maps:to_list(Dict0),
+ Lbls1 = maps:to_list(Lbls0),
+ {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) ->
+ case sharable_with_try(K) of
+ true ->
+ {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)};
+ false ->
+ {Dict,Lbls}
+ end
+ end, {[],Lbls1}, Dict1),
+ {maps:from_list(Dict2),maps:from_list(Lbls2)}.
sharable_with_try([{line,_}|_]) ->
%% This sequence may cause an exception and may potentially
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index a0eef826ce..c09dbadd7f 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -280,7 +280,7 @@ valfun_1({try_case_end,Src}, Vst) ->
verify_y_init(Vst),
assert_term(Src, Vst),
kill_state(Vst);
-%% Instructions that can not cause exceptions
+%% Instructions that cannot cause exceptions
valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) ->
case Ctx of
{Tag,X} when Tag =:= x; Tag =:= y ->
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 68489a0122..71ab0e872a 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -91,6 +91,7 @@ is_pure(erlang, is_bitstring, 1) -> true;
%% erlang:is_builtin/3 depends on the state (i.e. the version of the emulator).
is_pure(erlang, is_float, 1) -> true;
is_pure(erlang, is_function, 1) -> true;
+is_pure(erlang, is_function, 2) -> true;
is_pure(erlang, is_integer, 1) -> true;
is_pure(erlang, is_list, 1) -> true;
is_pure(erlang, is_map, 1) -> true;
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 02dead9e92..f35ae09fe7 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -142,8 +142,7 @@ BEAM_FORMAT_NUMBER=0
20: send/0
## @spec remove_message
-## @doc Unlink the current message from the message queue and store a
-## pointer to the message in x(0). Remove any timeout.
+## @doc Unlink the current message from the message queue. Remove any timeout.
21: remove_message/0
## @spec timeout
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 3a65b40fa5..d848cd8f19 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -99,7 +99,7 @@
t=#{} :: map(), %Types
in_guard=false}). %In guard or not.
--type type_info() :: cerl:cerl() | 'bool' | 'integer'.
+-type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}.
-type yes_no_maybe() :: 'yes' | 'no' | 'maybe'.
-type sub() :: #sub{}.
@@ -478,9 +478,20 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0)
false ->
{Evs1,Sub2} = var_list(Evs0, Sub0),
H1 = body(H0, value, Sub2),
- Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1}
+ H2 = opt_try_handler(H1, lists:last(Evs1)),
+ Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H2}
end.
+%% Attempts to convert old erlang:get_stacktrace/0 calls into the new
+%% three-argument catch, with possibility of further optimisations.
+opt_try_handler(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=get_stacktrace},args=[]}, Var) ->
+ #c_primop{anno=A,name=#c_literal{val=build_stacktrace},args=[Var]};
+opt_try_handler(#c_case{clauses=Cs0} = Case, Var) ->
+ Cs = [C#c_clause{body=opt_try_handler(B, Var)} || #c_clause{body=B} = C <- Cs0],
+ Case#c_case{clauses=Cs};
+opt_try_handler(#c_let{arg=Arg} = Let, Var) ->
+ Let#c_let{arg=opt_try_handler(Arg, Var)};
+opt_try_handler(X, _) -> X.
%% If a fun or its application is used as an argument, then it's unsafe to
%% handle it in effect context as the side-effects may rely on its return
@@ -561,6 +572,7 @@ ifes_list(FVar, [E|Es], Safe) ->
ifes_list(_FVar, [], _Safe) ->
true.
+
expr_list(Es, Ctxt, Sub) ->
[expr(E, Ctxt, Sub) || E <- Es].
@@ -961,6 +973,10 @@ fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) ->
eval_setelement(Call, Arg1, Arg2, Arg3);
fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) ->
eval_is_record(Call, Arg1, Arg2, Arg3, Sub);
+fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) ->
+ eval_is_function_1(Call, Arg1, Sub);
+fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) ->
+ eval_is_function_2(Call, Arg1, Arg2, Sub);
fold_non_lit_args(Call, erlang, N, Args, Sub) ->
NumArgs = length(Args),
case erl_internal:comp_op(N, NumArgs) of
@@ -976,6 +992,22 @@ fold_non_lit_args(Call, erlang, N, Args, Sub) ->
end;
fold_non_lit_args(Call, _, _, _, _) -> Call.
+eval_is_function_1(Call, Arg1, Sub) ->
+ case get_type(Arg1, Sub) of
+ none -> Call;
+ {'fun',_} -> #c_literal{anno=cerl:get_ann(Call),val=true};
+ _ -> #c_literal{anno=cerl:get_ann(Call),val=false}
+ end.
+
+eval_is_function_2(Call, Arg1, #c_literal{val=Arity}, Sub)
+ when is_integer(Arity), Arity > 0 ->
+ case get_type(Arg1, Sub) of
+ none -> Call;
+ {'fun',Arity} -> #c_literal{anno=cerl:get_ann(Call),val=true};
+ _ -> #c_literal{anno=cerl:get_ann(Call),val=false}
+ end;
+eval_is_function_2(Call, _Arg1, _Arg2, _Sub) -> Call.
+
%% Evaluate a relational operation using type information.
eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) ->
Bool = erlang:Op(same, same),
@@ -3183,6 +3215,10 @@ update_types_2(V, [#c_tuple{}=P], Types) ->
Types#{V=>P};
update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
Types#{V=>bool};
+update_types_2(V, [#c_fun{vars=Vars}], Types) ->
+ Types#{V=>{'fun',length(Vars)}};
+update_types_2(V, [#c_var{name={_,Arity}}], Types) ->
+ Types#{V=>{'fun',Arity}};
update_types_2(V, [Type], Types) when is_atom(Type) ->
Types#{V=>Type};
update_types_2(_, _, Types) -> Types.
@@ -3201,6 +3237,8 @@ kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) ->
false -> [Entry|kill_types2(V, Tdb)];
true -> kill_types2(V, Tdb)
end;
+kill_types2(V, [{_, {'fun',_}}=Entry|Tdb]) ->
+ [Entry|kill_types2(V, Tdb)];
kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) ->
[Entry|kill_types2(V, Tdb)];
kill_types2(_, []) -> [].
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-02 21:58:53 +0000