aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/compiler/src/beam_validator.erl106
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl120
2 files changed, 190 insertions, 36 deletions
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 1af17dc641..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'.
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),
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-04 11:06:08 +0000