aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src/beam_validator.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src/beam_validator.erl')
-rw-r--r--lib/compiler/src/beam_validator.erl189
1 files changed, 112 insertions, 77 deletions
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 6004f1974e..16dba35adc 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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.
@@ -31,15 +31,6 @@
-import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]).
--define(MAXREG, 1024).
-
-%%-define(DEBUG, 1).
--ifdef(DEBUG).
--define(DBG_FORMAT(F, D), (io:format((F), (D)))).
--else.
--define(DBG_FORMAT(F, D), ok).
--endif.
-
%% To be called by the compiler.
module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) ->
@@ -170,29 +161,25 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
% in the module (those that start with bs_start_match2).
}).
--ifdef(DEBUG).
-print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) ->
- io:format(" #st{x=~p~n"
- " y=~p~n"
- " numy=~p,h=~p,ct=~w~n",
- [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]).
--endif.
+%% 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).
validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]},
Name, Arity, Entry, Ft) ->
- lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls1),
- ?DBG_FORMAT(" ~p.~n", [_F]),
validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1, Ft);
validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) ->
error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}).
validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) ->
- lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls2),
Offset = 1 + length(Ls1) + 1 + length(Ls2),
- EntryOK = (Entry =:= undefined) orelse lists:member(Entry, Ls2),
+ EntryOK = lists:member(Entry, Ls2),
if
EntryOK ->
St = init_state(Arity),
@@ -260,7 +247,6 @@ valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) ->
error({MFA,Error})
end;
valfun([I|Is], MFA, Offset, Vst0) ->
- ?DBG_FORMAT(" ~p.\n", [I]),
valfun(Is, MFA, Offset+1,
try
Vst = val_dsetel(I, Vst0),
@@ -278,7 +264,6 @@ valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) ->
valfun_1(_I, #vst{current=none}=Vst) ->
%% Ignore instructions after erlang:error/1,2, which
%% the original R10B compiler thought would return.
- ?DBG_FORMAT("Ignoring ~p\n", [_I]),
Vst;
valfun_1({badmatch,Src}, Vst) ->
assert_term(Src, Vst),
@@ -296,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);
@@ -531,6 +516,9 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0),
Vst = set_type(TupleType, Tuple, Vst1),
set_type_reg(term, Dst, Vst);
+valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) ->
+ validate_src(Src, Vst),
+ kill_state(Vst);
valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
validate_src(Src, Vst0),
Vst = branch_state(Fail, Vst0),
@@ -594,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
@@ -670,8 +658,10 @@ valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) ->
case Src of
{Tag,_} when Tag =:= x; Tag =:= y ->
set_type_reg(map, Src, Vst);
+ {literal,Map} when is_map(Map) ->
+ Vst;
_ ->
- Vst
+ kill_state(Vst)
end;
valfun_4({test,_Op,{f,Lbl},Src}, Vst) ->
validate_src(Src, Vst),
@@ -818,9 +808,11 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) ->
%% A possibility for garbage collection must not occur between setelement/3 and
%% set_tuple_element/3.
%%
+%% Note that #vst.current will be 'none' if the instruction is unreachable.
+%%
val_dsetel({move,_,_}, Vst) ->
Vst;
-val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=St}=Vst) ->
+val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=#st{}=St}=Vst) ->
Vst#vst{current=St#st{setelem=true}};
val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) ->
error(illegal_context_for_set_tuple_element);
@@ -847,7 +839,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 ->
@@ -859,44 +851,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) ->
@@ -980,9 +1002,9 @@ get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls.
init_fregs() -> 0.
-set_freg({fr,Fr}, #vst{current=#st{f=Fregs0}=St}=Vst)
+set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst)
when is_integer(Fr), 0 =< Fr ->
- limit_check(Fr),
+ check_limit(Freg),
Bit = 1 bsl Fr,
if
Fregs0 band Bit =:= 0 ->
@@ -995,9 +1017,10 @@ set_freg(Fr, _) -> error({bad_target,Fr}).
assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}})
when is_integer(Fr), 0 =< Fr ->
if
- Fregs band (1 bsl Fr) =/= 0 ->
- limit_check(Fr);
- true -> error({uninitialized_reg,Freg})
+ (Fregs bsr Fr) band 1 =:= 0 ->
+ error({uninitialized_reg,Freg});
+ true ->
+ ok
end;
assert_freg_set(Fr, _) -> error({bad_source,Fr}).
@@ -1027,7 +1050,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),
@@ -1035,7 +1058,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}).
@@ -1047,8 +1070,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.
@@ -1060,7 +1083,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
@@ -1076,16 +1099,16 @@ set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst);
set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst);
set_type(_, _, #vst{}=Vst) -> Vst.
-set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst)
+set_type_reg(Type, {x,X}=Reg, #vst{current=#st{x=Xs}=St}=Vst)
when is_integer(X), 0 =< X ->
- limit_check(X),
+ check_limit(Reg),
Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}};
set_type_reg(Type, Reg, Vst) ->
set_type_y(Type, Reg, Vst).
set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst)
when is_integer(Y), 0 =< Y ->
- limit_check(Y),
+ check_limit(Reg),
Ys = case gb_trees:lookup(Y, Ys0) of
none ->
error({invalid_store,Reg,Type});
@@ -1141,7 +1164,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.
%%
@@ -1183,12 +1206,17 @@ assert_type(WantedType, Term, Vst) ->
assert_type(Correct, Correct) -> ok;
assert_type(float, {float,_}) -> ok;
assert_type(tuple, {tuple,_}) -> ok;
+assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok;
assert_type({tuple_element,I}, {tuple,[Sz]})
when 1 =< I, I =< Sz ->
ok;
assert_type({tuple_element,I}, {tuple,Sz})
when is_integer(Sz), 1 =< I, I =< Sz ->
ok;
+assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) ->
+ ok;
+assert_type(cons, {literal,[_|_]}) ->
+ ok;
assert_type(Needed, Actual) ->
error({bad_type,{needed,Needed},{actual,Actual}}).
@@ -1243,7 +1271,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.
@@ -1395,11 +1423,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'.
@@ -1523,7 +1552,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;
@@ -1537,6 +1565,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;
@@ -1567,8 +1596,12 @@ return_type_1(erlang, setelement, 3, Vst) ->
Tuple = {x,1},
TupleType =
case get_term_type(Tuple, Vst) of
- {tuple,_}=TT -> TT;
- _ -> {tuple,[0]}
+ {tuple,_}=TT ->
+ TT;
+ {literal,Lit} when is_tuple(Lit) ->
+ {tuple,tuple_size(Lit)};
+ _ ->
+ {tuple,[0]}
end,
case get_term_type({x,0}, Vst) of
{integer,[]} -> TupleType;
@@ -1612,17 +1645,19 @@ return_type_math(pow, 2) -> {float,[]};
return_type_math(pi, 0) -> {float,[]};
return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
-limit_check(Num) when is_integer(Num), Num >= ?MAXREG ->
- error(limit);
-limit_check(_) -> ok.
+check_limit({x,X}) when is_integer(X), X < 1023 ->
+ %% Note: x(1023) is reserved for use by the BEAM loader.
+ ok;
+check_limit({y,Y}) when is_integer(Y), Y < 1024 ->
+ ok;
+check_limit({fr,Fr}) when is_integer(Fr), Fr < 1024 ->
+ ok;
+check_limit(_) ->
+ error(limit).
min(A, B) when is_integer(A), is_integer(B), A < B -> A;
min(A, B) when is_integer(A), is_integer(B) -> B.
gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)).
--ifdef(DEBUG).
-error(Error) -> exit(Error).
--else.
error(Error) -> throw(Error).
--endif.