aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/beam_dead.erl18
-rw-r--r--lib/compiler/src/beam_except.erl8
-rw-r--r--lib/compiler/src/beam_jump.erl50
-rw-r--r--lib/compiler/src/beam_receive.erl3
-rw-r--r--lib/compiler/src/beam_utils.erl20
-rw-r--r--lib/compiler/src/beam_validator.erl108
-rw-r--r--lib/compiler/src/v3_codegen.erl46
-rw-r--r--lib/compiler/test/Makefile4
-rw-r--r--lib/compiler/test/beam_except_SUITE.erl26
-rw-r--r--lib/compiler/test/beam_jump_SUITE.erl59
-rw-r--r--lib/compiler/test/beam_utils_SUITE.erl45
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl120
-rw-r--r--lib/compiler/test/bif_SUITE.erl65
-rw-r--r--lib/compiler/test/guard_SUITE.erl8
-rw-r--r--lib/compiler/test/map_SUITE.erl20
-rw-r--r--lib/compiler/test/receive_SUITE.erl6
16 files changed, 506 insertions, 100 deletions
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index dd42add433..b01f58f683 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -262,7 +262,7 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) ->
backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) ->
To = shortcut_select_label(To0, Reg, Src, D),
Jump = {jump,{f,To}},
- case beam_utils:is_killed_at(Reg, To, D) of
+ case is_killed_at(Reg, To, D) of
false -> backward([Move|Is], D, [Jump|Acc]);
true -> backward([Jump|Is], D, Acc)
end;
@@ -420,7 +420,7 @@ comp_op_find_shortcut(To0, Reg, Val, D) ->
To0 ->
not_possible();
To ->
- case beam_utils:is_killed_at(Reg, To, D) of
+ case is_killed_at(Reg, To, D) of
false -> not_possible();
true -> To
end
@@ -863,3 +863,17 @@ get_literal(nil) ->
get_literal({literal,_}=Lit) ->
Lit;
get_literal({_,_}) -> error.
+
+
+%%%
+%%% Removing stores to Y registers is not always safe
+%%% if there is an instruction that causes an exception
+%%% within a catch. In practice, there are few or no
+%%% opportunities for removing stores to Y registers anyway
+%%% if sys_core_fold has been run.
+%%%
+
+is_killed_at({x,_}=Reg, Lbl, D) ->
+ beam_utils:is_killed_at(Reg, Lbl, D);
+is_killed_at({y,_}, _, _) ->
+ false.
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index cb3a6b79de..4a181c1923 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -133,10 +133,12 @@ translate_exception(_, _, _, _) -> no.
fix_block(Is, 0) ->
reverse(Is);
fix_block(Is, Words) ->
- fix_block_1(reverse(Is), Words).
+ reverse(fix_block_1(Is, Words)).
-fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) ->
- [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is];
+fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) ->
+ Needed = Needed0 - Words,
+ true = Needed >= 0, %Assertion.
+ [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is];
fix_block_1([I|Is], Words) ->
[I|fix_block_1(Is, Words)].
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 359248c6af..09cd3aa2d4 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -266,17 +266,17 @@ extract_seq_1(_, _) -> no.
%%% (3) (4) (5) (6) Jump and unreachable code optimizations.
%%%
--record(st, {fc, %Label for function class errors.
- entry, %Entry label (must not be moved).
- mlbl, %Moved labels.
- labels :: cerl_sets:set() %Set of referenced labels.
- }).
-
-opt([{label,Fc}|_]=Is0, CLabel) ->
- Lbls = initial_labels(Is0),
+-record(st,
+ {
+ entry, %Entry label (must not be moved).
+ mlbl, %Moved labels.
+ labels :: cerl_sets:set() %Set of referenced labels.
+ }).
+
+opt(Is0, CLabel) ->
find_fixpoint(fun(Is) ->
- St = #st{fc=Fc,entry=CLabel,mlbl=#{},
- labels=Lbls},
+ Lbls = initial_labels(Is),
+ St = #st{entry=CLabel,mlbl=#{},labels=Lbls},
opt(Is, [], St)
end, Is0).
@@ -327,7 +327,8 @@ opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) ->
%% since we will rescan the inserted labels. We MUST rescan.
St = St0#st{mlbl=maps:remove(Lbl, Mlbl)},
insert_labels([Lbl|Lbls], Is, Acc, St);
- error -> opt(Is, [I|Acc], St0)
+ error ->
+ opt(Is, [I|Acc], St0)
end;
opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) ->
opt(Is, Acc, St);
@@ -362,12 +363,19 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) ->
true -> skip_unreachable(Is, [I|Acc], St);
false -> opt(Is, [I|Acc], St)
end;
-opt([], Acc, #st{fc=Fc,mlbl=Mlbl}) ->
+opt([], Acc, #st{mlbl=Mlbl}) ->
Code = reverse(Acc),
- case maps:find(Fc, Mlbl) of
- {ok,Lbls} -> insert_fc_labels(Lbls, Mlbl, Code);
- error -> Code
- end.
+ insert_fc_labels(Code, Mlbl).
+
+insert_fc_labels([{label,L}=I|Is0], Mlbl) ->
+ case maps:find(L, Mlbl) of
+ error ->
+ [I|insert_fc_labels(Is0, Mlbl)];
+ {ok,Lbls} ->
+ Is = [{label,Lb} || Lb <- Lbls] ++ Is0,
+ [I|insert_fc_labels(Is, maps:remove(L, Mlbl))]
+ end;
+insert_fc_labels([_|_]=Is, _) -> Is.
maps_append_list(K,Vs,M) ->
case M of
@@ -375,16 +383,6 @@ maps_append_list(K,Vs,M) ->
_ -> M#{K => Vs}
end.
-insert_fc_labels([L|Ls], Mlbl, Acc0) ->
- Acc = [{label,L}|Acc0],
- case maps:find(L, Mlbl) of
- error ->
- insert_fc_labels(Ls, Mlbl, Acc);
- {ok,Lbls} ->
- insert_fc_labels(Lbls++Ls, Mlbl, Acc)
- end;
-insert_fc_labels([], _, Acc) -> Acc.
-
collect_labels(Is, #st{entry=Entry}) ->
collect_labels_1(Is, Entry, []).
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
index c593184746..89cafe27ce 100644
--- a/lib/compiler/src/beam_receive.erl
+++ b/lib/compiler/src/beam_receive.erl
@@ -177,7 +177,8 @@ opt_recv([I|Is], D, R0, L0, Acc) ->
no;
false ->
opt_recv(Is, D, R, L, [I|Acc])
- end.
+ end;
+opt_recv([], _, _, _, _) -> no.
opt_update_regs({block,Bl}, R, L) ->
{opt_update_regs_bl(Bl, R),L};
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 47703b4aa3..a15ecf633e 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -167,8 +167,7 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}.
%% is_pure_test({test,Op,Fail,Ops}) -> true|false.
%% Return 'true' if the test instruction does not modify any
-%% registers and/or bit syntax matching state, nor modifies
-%% any bit syntax matching state.
+%% registers and/or bit syntax matching state.
%%
is_pure_test({test,is_eq,_,[_,_]}) -> true;
is_pure_test({test,is_ne,_,[_,_]}) -> true;
@@ -180,6 +179,8 @@ is_pure_test({test,is_nil,_,[_]}) -> true;
is_pure_test({test,is_nonempty_list,_,[_]}) -> true;
is_pure_test({test,test_arity,_,[_,_]}) -> true;
is_pure_test({test,has_map_fields,_,[_|_]}) -> true;
+is_pure_test({test,is_bitstr,_,[_]}) -> true;
+is_pure_test({test,is_function2,_,[_,_]}) -> true;
is_pure_test({test,Op,_,Ops}) ->
erl_internal:new_type_test(Op, length(Ops)).
@@ -324,8 +325,11 @@ check_liveness(R, [{deallocate,_}|Is], St) ->
{y,_} -> {killed,St};
_ -> check_liveness(R, Is, St)
end;
-check_liveness(R, [return|_], St) ->
- check_liveness_live_ret(R, 1, St);
+check_liveness({x,_}=R, [return|_], St) ->
+ case R of
+ {x,0} -> {used,St};
+ {x,_} -> {killed,St}
+ end;
check_liveness(R, [{call,Live,_}|Is], St) ->
case R of
{x,X} when X < Live -> {used,St};
@@ -534,14 +538,6 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
check_liveness_ret(R, R, St) -> {used,St};
check_liveness_ret(_, _, St) -> {killed,St}.
-check_liveness_live_ret({x,R}, Live, St) ->
- if
- R < Live -> {used,St};
- true -> {killed,St}
- end;
-check_liveness_live_ret({y,_}, _, St) ->
- {killed,St}.
-
check_liveness_fail(_, _, _, 0, St) ->
{killed,St};
check_liveness_fail(R, Op, Args, Fail, St) ->
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index faff9940ec..13aa31b7c9 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -161,6 +161,13 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
% in the module (those that start with bs_start_match2).
}).
+%% Match context type.
+-record(ms,
+ {id=make_ref() :: reference(), %Unique ID.
+ valid=0 :: non_neg_integer(), %Valid slots
+ slots=0 :: non_neg_integer() %Number of slots
+ }).
+
validate_1(Is, Name, Arity, Entry, Ft) ->
validate_2(labels(Is), Name, Arity, Entry, Ft).
@@ -274,7 +281,7 @@ valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) ->
case Ctx of
{Tag,X} when Tag =:= x; Tag =:= y ->
Type = case gb_trees:lookup(X, Xs) of
- {value,{match_context,_,_}} -> term;
+ {value,#ms{}} -> term;
_ -> get_term_type(Ctx, Vst)
end,
set_type_reg(Type, Ctx, Vst);
@@ -575,7 +582,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
verify_live(Live, Vst0),
Vst1 = prune_x_regs(Live, Vst0),
BranchVst = case CtxType of
- {match_context,_,_} ->
+ #ms{} ->
%% The failure branch will never be taken when Ctx
%% is a match context. Therefore, the type for Ctx
%% at the failure label must not be match_context
@@ -828,7 +835,7 @@ kill_state_1(Vst) ->
%% The stackframe must be initialized.
%% The instruction will return to the instruction following the call.
call(Name, Live, #vst{current=St}=Vst) ->
- verify_live(Live, Vst),
+ verify_call_args(Name, Live, Vst),
verify_y_init(Vst),
case return_type(Name, Vst) of
Type when Type =/= exception ->
@@ -840,44 +847,74 @@ call(Name, Live, #vst{current=St}=Vst) ->
%% Tail call.
%% The stackframe must have a known size and be initialized.
%% Does not return to the instruction following the call.
-tail_call(Name, Live, Vst) ->
+tail_call(Name, Live, Vst0) ->
+ verify_y_init(Vst0),
+ Vst = deallocate(Vst0),
verify_call_args(Name, Live, Vst),
- verify_y_init(Vst),
verify_no_ct(Vst),
kill_state(Vst).
verify_call_args(_, 0, #vst{}) ->
ok;
verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)->
- Verify = fun(R) ->
- case get_move_term_type(R, Vst) of
- {match_context,_,_} ->
- verify_call_match_context(Lbl, Vst);
- _ ->
- ok
- end
- end,
- verify_call_args_1(Live, Verify, Vst);
+ verify_local_call(Lbl, Live, Vst);
verify_call_args(_, Live, Vst) when is_integer(Live)->
- Verify = fun(R) -> get_term_type(R, Vst) end,
- verify_call_args_1(Live, Verify, Vst);
+ verify_call_args_1(Live, Vst);
verify_call_args(_, Live, _) ->
error({bad_number_of_live_regs,Live}).
-verify_call_args_1(0, _, _) -> ok;
-verify_call_args_1(N, Verify, Vst) ->
+verify_call_args_1(0, _) -> ok;
+verify_call_args_1(N, Vst) ->
X = N - 1,
- Verify({x,X}),
- verify_call_args_1(X, Verify, Vst).
+ get_term_type({x,X}, Vst),
+ verify_call_args_1(X, Vst).
+
+verify_local_call(Lbl, Live, Vst) ->
+ case all_ms_in_x_regs(Live, Vst) of
+ [{R,Ctx}] ->
+ %% Verify that there is a suitable bs_start_match2 instruction.
+ verify_call_match_context(Lbl, R, Vst),
+
+ %% Since the callee has consumed the match context,
+ %% there must be no additional copies in Y registers.
+ #ms{id=Id} = Ctx,
+ case ms_in_y_regs(Id, Vst) of
+ [] ->
+ ok;
+ [_|_]=Ys ->
+ error({multiple_match_contexts,[R|Ys]})
+ end;
+ [_,_|_]=Xs0 ->
+ Xs = [R || {R,_} <- Xs0],
+ error({multiple_match_contexts,Xs});
+ [] ->
+ ok
+ end.
+
+all_ms_in_x_regs(0, _Vst) ->
+ [];
+all_ms_in_x_regs(Live0, Vst) ->
+ Live = Live0 - 1,
+ R = {x,Live},
+ case get_move_term_type(R, Vst) of
+ #ms{}=M ->
+ [{R,M}|all_ms_in_x_regs(Live, Vst)];
+ _ ->
+ all_ms_in_x_regs(Live, Vst)
+ end.
+
+ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) ->
+ Ys = gb_trees:to_list(Ys0),
+ [Y || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id].
-verify_call_match_context(Lbl, #vst{ft=Ft}) ->
+verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) ->
case gb_trees:lookup(Lbl, Ft) of
none ->
error(no_bs_start_match2);
{value,[{test,bs_start_match2,_,_,[Ctx,_],Ctx}|_]} ->
ok;
- {value,[{test,bs_start_match2,_,_,[Bin,_,_],Ctx}|_]} ->
- error({binary_and_context_regs_different,Bin,Ctx})
+ {value,[{test,bs_start_match2,_,_,_,_}=I|_]} ->
+ error({unsuitable_bs_start_match2,I})
end.
allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) ->
@@ -1009,7 +1046,7 @@ assert_unique_map_keys([_,_|_]=Ls) ->
%%%
bsm_match_state(Slots) ->
- {match_context,0,Slots}.
+ #ms{slots=Slots}.
bsm_validate_context(Reg, Vst) ->
_ = bsm_get_context(Reg, Vst),
@@ -1017,7 +1054,7 @@ bsm_validate_context(Reg, Vst) ->
bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) ->
case gb_trees:lookup(X, Xs) of
- {value,{match_context,_,_}=Ctx} -> Ctx;
+ {value,#ms{}=Ctx} -> Ctx;
_ -> error({no_bsm_context,Reg})
end;
bsm_get_context(Reg, _) -> error({bad_source,Reg}).
@@ -1029,8 +1066,8 @@ bsm_save(Reg, {atom,start}, Vst) ->
Vst;
bsm_save(Reg, SavePoint, Vst) ->
case bsm_get_context(Reg, Vst) of
- {match_context,Bits,Slots} when SavePoint < Slots ->
- Ctx = {match_context,Bits bor (1 bsl SavePoint),Slots},
+ #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots ->
+ Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots},
set_type_reg(Ctx, Reg, Vst);
_ -> error({illegal_save,SavePoint})
end.
@@ -1042,7 +1079,7 @@ bsm_restore(Reg, {atom,start}, Vst) ->
Vst;
bsm_restore(Reg, SavePoint, Vst) ->
case bsm_get_context(Reg, Vst) of
- {match_context,Bits,Slots} when SavePoint < Slots ->
+ #ms{valid=Bits,slots=Slots} when SavePoint < Slots ->
case Bits band (1 bsl SavePoint) of
0 -> error({illegal_restore,SavePoint,not_set});
_ -> Vst
@@ -1123,7 +1160,7 @@ assert_term(Src, Vst) ->
%% Thus 'exception' is never stored as type descriptor
%% for a register.
%%
-%% {match_context,_,_} A matching context for bit syntax matching. We do allow
+%% #ms{} A match context for bit syntax matching. We do allow
%% it to moved/to from stack, but otherwise it must only
%% be accessed by bit syntax matching instructions.
%%
@@ -1230,7 +1267,7 @@ get_term_type(Src, Vst) ->
initialized -> error({unassigned,Src});
{catchtag,_} -> error({catchtag,Src});
{trytag,_} -> error({trytag,Src});
- {match_context,_,_} -> error({match_context,Src});
+ #ms{} -> error({match_context,Src});
Type -> Type
end.
@@ -1382,11 +1419,12 @@ merge_types(bool, {atom,A}) ->
merge_bool(A);
merge_types({atom,A}, bool) ->
merge_bool(A);
-merge_types({match_context,B0,Slots},{match_context,B1,Slots}) ->
- {match_context,B0 bor B1,Slots};
-merge_types({match_context,_,_}=M, _) ->
+merge_types(#ms{id=Id,valid=B0,slots=Slots}=M,
+ #ms{id=Id,valid=B1,slots=Slots}) ->
+ M#ms{valid=B0 bor B1,slots=Slots};
+merge_types(#ms{}=M, _) ->
M;
-merge_types(_, {match_context,_,_}=M) ->
+merge_types(_, #ms{}=M) ->
M;
merge_types(T1, T2) when T1 =/= T2 ->
%% Too different. All we know is that the type is a 'term'.
@@ -1510,7 +1548,6 @@ bif_type(node, [_], _) -> {atom,[]};
bif_type(hd, [_], _) -> term;
bif_type(tl, [_], _) -> term;
bif_type(get, [_], _) -> term;
-bif_type(raise, [_,_], _) -> exception;
bif_type(Bif, _, _) when is_atom(Bif) -> term.
is_bif_safe('/=', 2) -> true;
@@ -1524,6 +1561,7 @@ is_bif_safe('>=', 2) -> true;
is_bif_safe(is_atom, 1) -> true;
is_bif_safe(is_boolean, 1) -> true;
is_bif_safe(is_binary, 1) -> true;
+is_bif_safe(is_bitstring, 1) -> true;
is_bif_safe(is_float, 1) -> true;
is_bif_safe(is_function, 1) -> true;
is_bif_safe(is_integer, 1) -> true;
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index f531056591..f5f3c73793 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1089,6 +1089,23 @@ protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) ->
%% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%% Generate test instruction. Use explicit fail label here.
+test_cg(is_map, [A], Fail, I, Vdb, Bef, St) ->
+ %% We must avoid creating code like this:
+ %%
+ %% move x(0) y(0)
+ %% is_map Fail [x(0)]
+ %% make_fun => x(0) %% Overwrite x(0)
+ %% put_map_assoc y(0) ...
+ %%
+ %% The code is safe, but beam_validator does not understand that.
+ %% Extending beam_validator to handle such (rare) code as the
+ %% above would make it slower for all programs. Instead, change
+ %% the code generator to always prefer the Y register for is_map()
+ %% and put_map_assoc() instructions, ensuring that they use the
+ %% same register.
+ Arg = cg_reg_arg_prefer_y(A, Bef),
+ Aft = clear_dead(Bef, I, Vdb),
+ {[{test,is_map,{f,Fail},[Arg]}],Aft,St};
test_cg(Test, As, Fail, I, Vdb, Bef, St) ->
Args = cg_reg_args(As, Bef),
Aft = clear_dead(Bef, I, Vdb),
@@ -1155,19 +1172,15 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
%% Inside a guard. The only allowed function call is to
%% erlang:error/1,2. We will generate the following code:
%%
- %% jump FailureLabel
%% move {atom,ok} DestReg
- %%
- %% The 'move' instruction will never be executed, but we
- %% generate it anyway in case the beam_validator is run
- %% on unoptimized code.
+ %% jump FailureLabel
{remote,{atom,erlang},{atom,error}} = Func, %Assertion.
[{var,DestVar}] = Rs,
Int0 = clear_dead(Bef, Le#l.i, Vdb),
Reg = put_reg(DestVar, Int0#sr.reg),
Int = Int0#sr{reg=Reg},
Dst = fetch_reg(DestVar, Reg),
- {[{jump,{f,Fail}},{move,{atom,ok},Dst}],
+ {[{move,{atom,ok},Dst},{jump,{f,Fail}}],
clear_dead(Int, Le#l.i, Vdb),St0};
#cg{} ->
%% Ordinary function call in a function body.
@@ -1545,7 +1558,7 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef,
Fail = {f,Bfail},
{Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St),
- SrcReg = cg_reg_arg(Map,Int0),
+ SrcReg = cg_reg_arg_prefer_y(Map, Int0),
Line = line(Le#l.a),
List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)],
@@ -1572,7 +1585,7 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef,
Fail = {f,Bfail},
{Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St),
- SrcReg = cg_reg_arg(Map,Int0),
+ SrcReg = cg_reg_arg_prefer_y(Map, Int0),
Line = line(Le#l.a),
%% fetch registers for values to be put into the map
@@ -1845,6 +1858,9 @@ cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As].
cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef);
cg_reg_arg(Literal, _) -> Literal.
+cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef);
+cg_reg_arg_prefer_y(Literal, _) -> Literal.
+
%% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}.
%% Do the complete setup for a call/enter.
@@ -2086,6 +2102,12 @@ fetch_var(V, Sr) ->
error -> fetch_stack(V, Sr#sr.stk)
end.
+fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) ->
+ case find_stack(V, Stk) of
+ {ok,R} -> R;
+ error -> fetch_reg(V, Reg)
+ end.
+
load_vars(Vs, Regs) ->
foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).
@@ -2159,11 +2181,11 @@ fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0).
fetch_stack(V, [{V}|_], I) -> {yy,I};
fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1).
-% find_stack(Var, Stk) -> find_stack(Var, Stk, 0).
+find_stack(Var, Stk) -> find_stack(Var, Stk, 0).
-% find_stack(V, [{V}|Stk], I) -> {ok,{yy,I}};
-% find_stack(V, [O|Stk], I) -> find_stack(V, Stk, I+1);
-% find_stack(V, [], I) -> error.
+find_stack(V, [{V}|_], I) -> {ok,{yy,I}};
+find_stack(V, [_|Stk], I) -> find_stack(V, Stk, I+1);
+find_stack(_, [], _) -> error.
on_stack(V, Stk) -> keymember(V, 1, Stk).
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 203a50db55..f0185acbc7 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -13,9 +13,11 @@ MODULES= \
beam_validator_SUITE \
beam_disasm_SUITE \
beam_except_SUITE \
+ beam_jump_SUITE \
beam_reorder_SUITE \
beam_type_SUITE \
beam_utils_SUITE \
+ bif_SUITE \
bs_bincomp_SUITE \
bs_bit_binaries_SUITE \
bs_construct_SUITE \
@@ -49,9 +51,11 @@ NO_OPT= \
beam_block \
beam_bool \
beam_except \
+ beam_jump \
beam_reorder \
beam_type \
beam_utils \
+ bif \
bs_construct \
bs_match \
bs_utf \
diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl
index 8746e62fb9..47367d6eab 100644
--- a/lib/compiler/test/beam_except_SUITE.erl
+++ b/lib/compiler/test/beam_except_SUITE.erl
@@ -21,15 +21,18 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
- coverage/1]).
+ multiple_allocs/1,coverage/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [coverage].
+ test_lib:recompile(?MODULE),
+ [{group,p}].
groups() ->
- [].
+ [{p,[parallel],
+ [multiple_allocs,
+ coverage]}].
init_per_suite(Config) ->
Config.
@@ -43,6 +46,23 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+multiple_allocs(_Config) ->
+ {'EXIT',{{badmatch,#{true:=[p]}},_}} =
+ (catch could(pda, 0.0, {false,true}, {p})),
+ {'EXIT',{function_clause,_}} = (catch place(lee)),
+ {'EXIT',{{badmatch,wanted},_}} = (catch conditions()),
+
+ ok.
+
+could(Coupons = pda, Favorite = _pleasure = 0.0, {_, true}, {Presents}) ->
+ (0 = true) = #{true => [Presents]}.
+
+place(lee) ->
+ (pregnancy = presentations) = [hours | [purchase || _ <- 0]] + wine.
+
+conditions() ->
+ (talking = going) = storage + [large = wanted].
+
coverage(_) ->
File = {file,"fake.erl"},
ok = fc(a),
diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl
new file mode 100644
index 0000000000..0b13adaff2
--- /dev/null
+++ b/lib/compiler/test/beam_jump_SUITE.erl
@@ -0,0 +1,59 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(beam_jump_SUITE).
+
+-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ undefined_label/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [undefined_label
+ ]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+undefined_label(_Config) ->
+ {'EXIT',{function_clause,_}} = (catch flights(0, [], [])),
+ ok.
+
+%% Would lose a label when compiled with no_copt.
+
+flights(0, [], []) when [], 0; 0.0, [], false ->
+ clark;
+flights(_, Reproduction, introduction) when false, Reproduction ->
+ responsible.
diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl
index ae813d563b..f6d4a311bb 100644
--- a/lib/compiler/test/beam_utils_SUITE.erl
+++ b/lib/compiler/test/beam_utils_SUITE.erl
@@ -23,7 +23,8 @@
init_per_group/2,end_per_group/2,
apply_fun/1,apply_mf/1,bs_init/1,bs_save/1,
is_not_killed/1,is_not_used_at/1,
- select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1]).
+ select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1,
+ y_registers/1]).
-export([id/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -44,7 +45,8 @@ groups() ->
y_catch,
otp_8949_b,
liveopt,
- coverage
+ coverage,
+ y_registers
]}].
init_per_suite(Config) ->
@@ -311,6 +313,45 @@ clinic(Damage) ->
end,
carefully.
+y_registers(_Config) ->
+ {'EXIT',{{badfun,0},_}} = (catch economic(0.0, jim)),
+ {'EXIT',{{badmatch,apartments},_}} = (catch louisiana()),
+ {a,b} = (boxes(true))({a,b}),
+ {'EXIT',{{case_clause,webmaster},_}} = (catch yellow(true)),
+ ok.
+
+economic(0.0 = Serves, Existence) ->
+ case Serves of
+ Serves -> 0
+ end,
+ Existence = jim,
+ 0(),
+ Serves,
+ Existence.
+
+louisiana() ->
+ {catch necessarily,
+ try
+ [] == reg,
+ true = apartments
+ catch [] -> barbara
+ end}.
+
+boxes(Call) ->
+ case Call of
+ Call -> approval
+ end,
+ Call,
+ fun id/1.
+
+yellow(Hill) ->
+ case webmaster of
+ station -> eyes; Hill ->
+ "under"
+ end,
+ Hill,
+ id(42).
+
%% The identity function.
id(I) -> I.
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 7c4e88ca3e..263fd2ca7e 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -32,7 +32,7 @@
bad_bin_match/1,bad_dsetel/1,
state_after_fault_in_catch/1,no_exception_in_catch/1,
undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,
- map_field_lists/1]).
+ map_field_lists/1,cover_bin_opt/1]).
-include_lib("common_test/include/ct.hrl").
@@ -60,7 +60,7 @@ groups() ->
freg_state,bad_bin_match,bad_dsetel,
state_after_fault_in_catch,no_exception_in_catch,
undef_label,illegal_instruction,failing_gc_guard_bif,
- map_field_lists]}].
+ map_field_lists,cover_bin_opt]}].
init_per_suite(Config) ->
Config.
@@ -406,8 +406,124 @@ map_field_lists(Config) ->
empty_field_list}}
] = Errors.
+%% Coverage and smoke test of beam_validator.
+cover_bin_opt(_Config) ->
+ Ms = [beam_utils_SUITE,
+ bs_match_SUITE,
+ bs_bincomp_SUITE,
+ bs_bit_binaries_SUITE,
+ bs_utf_SUITE],
+ test_lib:p_run(fun try_bin_opt/1, Ms),
+ ok.
+
+try_bin_opt(Mod) ->
+ try
+ do_bin_opt(Mod)
+ catch
+ Class:Error ->
+ io:format("~p: ~p ~p\n~p\n",
+ [Mod,Class,Error,erlang:get_stacktrace()]),
+ error
+ end.
+
+do_bin_opt(Mod) ->
+ Beam = code:which(Mod),
+ {ok,{Mod,[{abstract_code,
+ {raw_abstract_v1,Abstr}}]}} =
+ beam_lib:chunks(Beam, [abstract_code]),
+ {ok,Mod,Asm} = compile:forms(Abstr, ['S']),
+ do_bin_opt(Mod, Asm).
+
+do_bin_opt(Mod, Asm) ->
+ do_bin_opt(fun enable_bin_opt/1, Mod, Asm),
+ do_bin_opt(fun remove_bs_start_match/1, Mod, Asm),
+ do_bin_opt(fun remove_bs_save/1, Mod, Asm),
+ do_bin_opt(fun destroy_ctxt/1, Mod, Asm),
+ do_bin_opt(fun destroy_save_point/1, Mod, Asm),
+ ok.
+
+do_bin_opt(Transform, Mod, Asm0) ->
+ Asm = Transform(Asm0),
+ case compile:forms(Asm, [from_asm,no_postopt,return]) of
+ {ok,[],Code,_Warnings} when is_binary(Code) ->
+ ok;
+ {error,Errors0,_} ->
+ %% beam_validator must return errors, not simply crash,
+ %% when illegal code is found.
+ ModString = atom_to_list(Mod),
+ [{ModString,Errors}] = Errors0,
+ _ = [verify_bin_opt_error(E) || E <- Errors],
+ ok
+ end.
+
+verify_bin_opt_error({beam_validator,_}) ->
+ ok.
+
+enable_bin_opt(Module) ->
+ transform_is(fun enable_bin_opt_body/1, Module).
+
+enable_bin_opt_body([_,{'%',{no_bin_opt,_Reason,_Anno}}|Is]) ->
+ enable_bin_opt_body(Is);
+enable_bin_opt_body([I|Is]) ->
+ [I|enable_bin_opt_body(Is)];
+enable_bin_opt_body([]) ->
+ [].
+
+remove_bs_start_match(Module) ->
+ transform_remove(fun({test,bs_start_match2,_,_,_,_}) -> true;
+ (_) -> false
+ end, Module).
+
+remove_bs_save(Module) ->
+ transform_remove(fun({bs_save2,_,_}) -> true;
+ (_) -> false
+ end, Module).
+
+destroy_save_point(Module) ->
+ transform_i(fun do_destroy_save_point/1, Module).
+
+do_destroy_save_point({I,Ctx,_Point})
+ when I =:= bs_save2; I =:= bs_restore2 ->
+ {I,Ctx,42};
+do_destroy_save_point(I) ->
+ I.
+
+destroy_ctxt(Module) ->
+ transform_i(fun do_destroy_ctxt/1, Module).
+
+do_destroy_ctxt({bs_save2=I,Ctx,Point}) ->
+ {I,destroy_reg(Ctx),Point};
+do_destroy_ctxt({bs_restore2=I,Ctx,Point}) ->
+ {I,destroy_reg(Ctx),Point};
+do_destroy_ctxt({bs_context_to_binary=I,Ctx}) ->
+ {I,destroy_reg(Ctx)};
+do_destroy_ctxt(I) ->
+ I.
+
+destroy_reg({Tag,N}) ->
+ case rand:uniform() of
+ R when R < 0.6 ->
+ {Tag,N+1};
+ _ ->
+ {y,N+1}
+ end.
+
%%%-------------------------------------------------------------------------
+transform_remove(Remove, Module) ->
+ transform_is(fun(Is) -> [I || I <- Is, not Remove(I)] end, Module).
+
+transform_i(Transform, Module) ->
+ transform_is(fun(Is) -> [Transform(I) || I <- Is] end, Module).
+
+transform_is(Transform, {Mod,Exp,Imp,Fs0,Lc}) ->
+ Fs = [transform_is_1(Transform, F) || F <- Fs0],
+ {Mod,Exp,Imp,Fs,Lc}.
+
+transform_is_1(Transform, {function,N,A,E,Is0}) ->
+ Is = Transform(Is0),
+ {function,N,A,E,Is}.
+
do_val(Mod, Config) ->
Data = proplists:get_value(data_dir, Config),
Base = atom_to_list(Mod),
diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl
new file mode 100644
index 0000000000..51bc71da81
--- /dev/null
+++ b/lib/compiler/test/bif_SUITE.erl
@@ -0,0 +1,65 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(bif_SUITE).
+
+-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ beam_validator/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [beam_validator
+ ]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+%% Cover code in beam_validator.
+
+beam_validator(Config) ->
+ [false,Config] = food(Config),
+
+ true = is_number(42.0),
+ false = is_port(Config),
+
+ ok.
+
+food(Curriculum) ->
+ [try
+ is_bitstring(functions)
+ catch _ ->
+ 0
+ end, Curriculum].
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 83298e546e..6302f82f29 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -1835,6 +1835,8 @@ bad_guards(Config) when is_list(Config) ->
fc(catch bad_guards_3(not_a_map, [x])),
fc(catch bad_guards_3(42, [x])),
+ fc(catch bad_guards_4()),
+
ok.
%% beam_bool used to produce GC BIF instructions whose
@@ -1852,6 +1854,12 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) ->
bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) ->
ok.
+%% v3_codegen would generate a jump to the failure label, but
+%% without initializing x(0). The code at the failure label expected
+%% x(0) to be initialized.
+
+bad_guards_4() when not (error#{}); {not 0.0} -> freedom.
+
%% Building maps in a guard in a 'catch' would crash v3_codegen.
guard_in_catch(_Config) ->
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index 14d175b92c..c3c4862794 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -66,7 +66,9 @@
t_export/1,
%% errors in 18
- t_register_corruption/1
+ t_register_corruption/1,
+ t_bad_update/1
+
]).
suite() -> [].
@@ -117,7 +119,8 @@ all() ->
t_export,
%% errors in 18
- t_register_corruption
+ t_register_corruption,
+ t_bad_update
].
groups() -> [].
@@ -1922,6 +1925,19 @@ validate_frequency([{T,C}|Fs],Tf) ->
validate_frequency([], _) -> ok.
+t_bad_update(_Config) ->
+ {#{0.0:=Id},#{}} = properly(#{}),
+ 42 = Id(42),
+ {'EXIT',{{badmap,_},_}} = (catch increase(0)),
+ ok.
+
+properly(Item) ->
+ {Item#{0.0 => fun id/1},Item}.
+
+increase(Allows) ->
+ catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}.
+
+
%% aux
rand_terms(0) -> [];
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 3c397561fc..8304672558 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -118,8 +118,14 @@ coverage(Config) when is_list(Config) ->
59 = tuple_to_values(infinity, x),
61 = tuple_to_values(999999, x),
0 = tuple_to_values(1, x),
+
+ {'EXIT',{{badmap,[]},_}} = (catch monitor_plus_badmap(self())),
+
ok.
+monitor_plus_badmap(Pid) ->
+ monitor(process, Pid) + []#{}.
+
receive_all() ->
receive
Any ->