diff options
Diffstat (limited to 'lib/compiler/src/beam_validator.erl')
| -rw-r--r-- | lib/compiler/src/beam_validator.erl | 3049 |
1 files changed, 2095 insertions, 954 deletions
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index fb2e7df65c..09a5a6c104 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -26,8 +26,9 @@ %% Interface for compiler. -export([module/2, format_error/1]). +-export([type_anno/1, type_anno/2, type_anno/4]). --import(lists, [any/2,dropwhile/2,foldl/3,foreach/2,reverse/1]). +-import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]). %% To be called by the compiler. @@ -44,6 +45,34 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) {error,[{atom_to_list(Mod),Es}]} end. +%% Provides a stable interface for type annotations, used by certain passes to +%% indicate that we can safely assume that a register has a given type. +-spec type_anno(term()) -> term(). +type_anno(atom) -> {atom,[]}; +type_anno(bool) -> bool; +type_anno({binary,_}) -> binary; +type_anno(cons) -> cons; +type_anno(float) -> {float,[]}; +type_anno(integer) -> {integer,[]}; +type_anno(list) -> list; +type_anno(map) -> map; +type_anno(match_context) -> match_context; +type_anno(number) -> number; +type_anno(nil) -> nil. + +-spec type_anno(term(), term()) -> term(). +type_anno(atom, Value) when is_atom(Value) -> {atom, Value}; +type_anno(float, Value) when is_float(Value) -> {float, Value}; +type_anno(integer, Value) when is_integer(Value) -> {integer, Value}. + +-spec type_anno(term(), term(), term(), term()) -> term(). +type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0, + is_map(Elements) -> + case Exact of + true -> {tuple, Size, Elements}; + false -> {tuple, [Size], Elements} + end. + -spec format_error(term()) -> iolist(). format_error({{_M,F,A},{I,Off,limit}}) -> @@ -90,34 +119,9 @@ format_error(Error) -> %% format as used in the compiler and in .S files. validate(Module, Fs) -> - Ft = index_bs_start_match(Fs, []), + Ft = index_parameter_types(Fs, []), validate_0(Module, Fs, Ft). -index_bs_start_match([{function,_,_,Entry,Code0}|Fs], Acc0) -> - Code = dropwhile(fun({label,L}) when L =:= Entry -> false; - (_) -> true - end, Code0), - case Code of - [{label,Entry}|Is] -> - Acc = index_bs_start_match_1(Is, Entry, Acc0), - index_bs_start_match(Fs, Acc); - _ -> - %% Something serious is wrong. Ignore it for now. - %% It will be detected and diagnosed later. - index_bs_start_match(Fs, Acc0) - end; -index_bs_start_match([], Acc) -> - gb_trees:from_orddict(lists:sort(Acc)). - -index_bs_start_match_1([{test,bs_start_match2,_,_,_,_}=I|_], Entry, Acc) -> - [{Entry,[I]}|Acc]; -index_bs_start_match_1([{test,_,{f,F},_},{bs_context_to_binary,_}|Is0], Entry, Acc) -> - [{label,F}|Is] = dropwhile(fun({label,L}) when L =:= F -> false; - (_) -> true - end, Is0), - index_bs_start_match_1(Is, Entry, Acc); -index_bs_start_match_1(_, _, Acc) -> Acc. - validate_0(_Module, [], _) -> []; validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> try validate_1(Code, Name, Ar, Entry, Ft) of @@ -132,41 +136,126 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> erlang:raise(Class, Error, Stack) end. +-record(value_ref, {id :: index()}). +-record(value, {op :: term(), args :: [argument()], type :: type()}). + +-type argument() :: #value_ref{} | literal(). + -type index() :: non_neg_integer(). --type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}). - --record(st, %Emulation state - {x=init_regs(0, term) :: reg_tab(),%x register info. - y=init_regs(0, initialized) :: reg_tab(),%y register info. - f=init_fregs(), % - numy=none, %Number of y registers. - h=0, %Available heap size. - hf=0, %Available heap size for floats. - fls=undefined, %Floating point state. - ct=[], %List of hot catch/try labels - setelem=false, %Previous instruction was setelement/3. - puts_left=none %put/1 instructions left. - }). + +-type literal() :: {atom, [] | atom()} | + {float, [] | float()} | + {integer, [] | integer()} | + {literal, term()} | + nil. + +-type tuple_sz() :: [non_neg_integer()] | %% Inexact + non_neg_integer(). %% Exact. + +%% 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 + }). + +-type type() :: binary | + cons | + list | + map | + nil | + #ms{} | + ms_position | + none | + number | + term | + tuple_in_progress | + {tuple, tuple_sz(), #{ literal() => type() }} | + literal(). + +-type tag() :: initialized | + uninitialized | + {catchtag, [label()]} | + {trytag, [label()]}. + +-type x_regs() :: #{ {x, index()} => #value_ref{} }. +-type y_regs() :: #{ {y, index()} => tag() | #value_ref{} }. + +%% Emulation state +-record(st, + {%% All known values. + vs=#{} :: #{ #value_ref{} => #value{} }, + %% Register states. + xs=#{} :: x_regs(), + ys=#{} :: y_regs(), + f=init_fregs(), + %% A set of all registers containing "fragile" terms. That is, terms + %% that don't exist on our process heap and would be destroyed by a + %% GC. + fragile=cerl_sets:new() :: cerl_sets:set(), + %% Number of Y registers. + %% + %% Note that this may be 0 if there's a frame without saved values, + %% such as on a body-recursive call. + numy=none :: none | undecided | index(), + %% Available heap size. + h=0, + %Available heap size for floats. + hf=0, + %% Floating point state. + fls=undefined, + %% List of hot catch/try labels + ct=[], + %% Previous instruction was setelement/3. + setelem=false, + %% put/1 instructions left. + puts_left=none + }). -type label() :: integer(). -type label_set() :: gb_sets:set(label()). -type branched_tab() :: gb_trees:tree(label(), #st{}). -type ft_tab() :: gb_trees:tree(). --record(vst, %Validator state - {current=none :: #st{} | 'none', %Current state - branched=gb_trees:empty() :: branched_tab(), %States at jumps - labels=gb_sets:empty() :: label_set(), %All defined labels - ft=gb_trees:empty() :: ft_tab() %Some other functions - % 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 - }). +%% Validator state +-record(vst, + {%% Current state + current=none :: #st{} | 'none', + %% States at labels + branched=gb_trees:empty() :: branched_tab(), + %% All defined labels + labels=gb_sets:empty() :: label_set(), + %% Argument information of other functions in the module + ft=gb_trees:empty() :: ft_tab(), + %% Counter for #value_ref{} creation + ref_ctr=0 :: index() + }). + +index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> + Code = dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Code0), + case Code of + [{label,Entry}|Is] -> + Acc = index_parameter_types_1(Is, Entry, Acc0), + index_parameter_types(Fs, Acc); + _ -> + %% Something serious is wrong. Ignore it for now. + %% It will be detected and diagnosed later. + index_parameter_types(Fs, Acc0) + end; +index_parameter_types([], Acc) -> + gb_trees:from_orddict(sort(Acc)). + +index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> + Type = case Type0 of + match_context -> #ms{}; + _ -> Type0 + end, + Key = {Entry, Reg}, + index_parameter_types_1(Is, Entry, [{Key, Type} | Acc]); +index_parameter_types_1(_, _, Acc) -> + Acc. validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). @@ -179,14 +268,10 @@ validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> Offset = 1 + length(Ls1) + 1 + length(Ls2), - EntryOK = lists:member(Entry, Ls2), + EntryOK = member(Entry, Ls2), if EntryOK -> - St = init_state(Arity), - Vst0 = #vst{current=St, - branched=gb_trees_from_list([{L,St} || L <- Ls1]), - labels=gb_sets:from_list(Ls1++Ls2), - ft=Ft}, + Vst0 = init_vst(Arity, Ls1, Ls2, Ft), MFA = {Mod,Name,Arity}, Vst = valfun(Is, MFA, Offset, Vst0), validate_fun_info_branches(Ls1, MFA, Vst); @@ -203,7 +288,13 @@ validate_fun_info_branches([], _, _) -> ok. validate_fun_info_branches_1(Arity, {_,_,Arity}, _) -> ok; validate_fun_info_branches_1(X, {Mod,Name,Arity}=MFA, Vst) -> try - get_term_type({x,X}, Vst) + case Vst of + #vst{current=#st{numy=none}} -> + ok; + #vst{current=#st{numy=Size}} -> + error({unexpected_stack_frame,Size}) + end, + assert_term({x,X}, Vst) catch Error -> I = {func_info,{atom,Mod},{atom,Name},Arity}, Offset = 2, @@ -224,19 +315,22 @@ labels_1([{line,_}|Is], R) -> labels_1(Is, R) -> {reverse(R),Is}. -init_state(Arity) -> - Xs = init_regs(Arity, term), - Ys = init_regs(0, initialized), - kill_heap_allocation(#st{x=Xs,y=Ys,numy=none,ct=[]}). +init_vst(Arity, Ls1, Ls2, Ft) -> + Vst0 = init_function_args(Arity - 1, #vst{current=#st{}}), + Branches = gb_trees_from_list([{L,Vst0#vst.current} || L <- Ls1]), + Labels = gb_sets:from_list(Ls1++Ls2), + Vst0#vst{branched=Branches, + labels=Labels, + ft=Ft}. + +init_function_args(-1, Vst) -> + Vst; +init_function_args(X, Vst) -> + init_function_args(X - 1, create_term(term, argument, [], {x,X}, Vst)). kill_heap_allocation(St) -> St#st{h=0,hf=0}. -init_regs(0, _) -> - gb_trees:empty(); -init_regs(N, Type) -> - gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]). - valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Targets = gb_trees:keys(Targets0), Labels = gb_sets:to_list(Labels0), @@ -257,20 +351,25 @@ valfun([I|Is], MFA, Offset, Vst0) -> %% Instructions that are allowed in dead code or when failing, %% that is while the state is undecided in some way. -valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) -> - St = merge_states(Lbl, St0, B), - Vst#vst{current=St,branched=gb_trees:enter(Lbl, St, B), - labels=gb_sets:add(Lbl, Lbls)}; +valfun_1({label,Lbl}, #vst{current=St0, + ref_ctr=Counter0, + branched=B, + labels=Lbls}=Vst) -> + {St, Counter} = merge_states(Lbl, St0, B, Counter0), + Vst#vst{current=St, + ref_ctr=Counter, + branched=gb_trees:enter(Lbl, St, B), + labels=gb_sets:add(Lbl, Lbls)}; valfun_1(_I, #vst{current=none}=Vst) -> %% Ignore instructions after erlang:error/1,2, which %% the original R10B compiler thought would return. Vst; valfun_1({badmatch,Src}, Vst) -> - assert_term(Src, Vst), + assert_durable_term(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1({case_end,Src}, Vst) -> - assert_term(Src, Vst), + assert_durable_term(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1(if_end, Vst) -> @@ -278,35 +377,21 @@ valfun_1(if_end, Vst) -> kill_state(Vst); valfun_1({try_case_end,Src}, Vst) -> verify_y_init(Vst), - assert_term(Src, Vst), + assert_durable_term(Src, Vst), kill_state(Vst); -%% Instructions that can not 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 -> - Type = case gb_trees:lookup(X, Xs) of - {value,#ms{}} -> term; - _ -> get_term_type(Ctx, Vst) - end, - set_type_reg(Type, Ctx, Vst); - _ -> - error({bad_source,Ctx}) - end; +%% Instructions that cannot cause exceptions +valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> + bsm_validate_context(Ctx, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + Vst = prune_x_regs(Live, Vst0), + extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0); valfun_1(bs_init_writable=I, Vst) -> call(I, 1, Vst); valfun_1(build_stacktrace=I, Vst) -> call(I, 1, Vst); -valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) -> - %% The stack trimming optimization may generate a move from an initialized - %% but unassigned Y register to another Y register. - case get_term_type_1(Src, Vst) of - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); - Type -> set_type_reg(Type, Dst, Vst) - end; valfun_1({move,Src,Dst}, Vst) -> - Type = get_move_term_type(Src, Vst), - set_type_reg(Type, Dst, Vst); + assign(Src, Dst, Vst); valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> assert_type(float, Src, Vst), set_freg(Dst, Vst); @@ -314,15 +399,15 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - set_type_reg({float,[]}, Dst, Vst); -valfun_1({kill,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); -valfun_1({init,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); + create_term({float,[]}, fmove, [], Dst, Vst); +valfun_1({kill,Reg}, Vst) -> + create_tag(initialized, kill, [], Reg, Vst); +valfun_1({init,Reg}, Vst) -> + create_tag(initialized, init, [], Reg, Vst); valfun_1({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> - case is_bif_safe(Op, length(Src)) of +valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> + case is_bif_safe(Op, length(Ss)) of false -> %% Since the BIF can fail, make sure that any catch state %% is updated. @@ -330,21 +415,32 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> true -> %% It can't fail, so we finish handling it here (not updating %% catch state). - validate_src(Src, Vst), - Type = bif_type(Op, Src, Vst), - set_type_reg(Type, Dst, Vst) + validate_src(Ss, Vst), + Type = bif_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst) end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> assert_term(A, Vst0), assert_term(B, Vst0), Vst = eat_heap(2, Vst0), - set_type_reg(cons, Dst, Vst); + create_term(cons, put_list, [A, B], Dst, Vst); +valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> + _ = [assert_term(El, Vst0) || El <- Elements], + Size = length(Elements), + Vst = eat_heap(Size+1, Vst0), + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = get_term_type(Val, Vst0), + Es = set_element_type({integer,Index}, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, Elements), + Type = {tuple,Size,Es}, + create_term(Type, put_tuple2, [], Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = set_type_reg(tuple_in_progress, Dst, Vst1), + Vst = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1), #vst{current=St0} = Vst, - St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}}, + St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; valfun_1({put,Src}, Vst0) -> assert_term(Src, Vst0), @@ -353,11 +449,14 @@ valfun_1({put,Src}, Vst0) -> case St0 of #st{puts_left=none} -> error(not_building_a_tuple); - #st{puts_left={1,{Dst,Type}}} -> + #st{puts_left={1,{Dst,Sz,Es0}}} -> + Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) }, St = St0#st{puts_left=none}, - set_type_reg(Type, Dst, Vst#vst{current=St}); - #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) -> - St = St0#st{puts_left={PutsLeft-1,Info}}, + create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St}); + #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> + Index = Sz - PutsLeft + 1, + Es = Es0#{ {integer,Index} => get_term_type(Src, Vst0) }, + St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; %% Instructions for optimization of selective receives. @@ -370,13 +469,28 @@ valfun_1(remove_message, Vst) -> %% The message term is no longer fragile. It can be used %% without restrictions. remove_fragility(Vst); +valfun_1({'%', {type_info, Reg, match_context}}, Vst) -> + update_type(fun meet/2, #ms{}, Reg, Vst); +valfun_1({'%', {type_info, Reg, Type}}, Vst) -> + %% Explicit type information inserted by optimization passes to indicate + %% that Reg has a certain type, so that we can accept cross-function type + %% optimizations. + update_type(fun meet/2, Type, Reg, Vst); +valfun_1({'%', {remove_fragility, Reg}}, Vst) -> + %% This is a hack to make prim_eval:'receive'/2 work. + %% + %% Normally it's illegal to pass fragile terms as a function argument as we + %% have no way of knowing what the callee will do with it, but we know that + %% prim_eval:'receive'/2 won't leak the term, nor cause a GC since it's + %% disabled while matching messages. + remove_fragility(Reg, Vst); valfun_1({'%',_}, Vst) -> Vst; valfun_1({line,_}, Vst) -> Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> - case return_type(Func, Vst) of + case call_return_type(Func, Vst) of exception -> verify_live(Live, Vst), %% The stack will be scanned, so Y registers @@ -391,88 +505,122 @@ valfun_1(_I, #vst{current=#st{ct=undecided}}) -> %% %% Allocate and deallocate, et.al valfun_1({allocate,Stk,Live}, Vst) -> - allocate(false, Stk, 0, Live, Vst); + allocate(uninitialized, Stk, 0, Live, Vst); valfun_1({allocate_heap,Stk,Heap,Live}, Vst) -> - allocate(false, Stk, Heap, Live, Vst); + allocate(uninitialized, Stk, Heap, Live, Vst); valfun_1({allocate_zero,Stk,Live}, Vst) -> - allocate(true, Stk, 0, Live, Vst); + allocate(initialized, Stk, 0, Live, Vst); valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) -> - allocate(true, Stk, Heap, Live, Vst); + allocate(initialized, Stk, Heap, Live, Vst); valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> verify_no_ct(Vst), deallocate(Vst); valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_1({trim,N,Remaining}, #vst{current=#st{y=Yregs0,numy=NumY}=St}=Vst) -> +valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> + #st{numy=NumY} = St0, if - N =< NumY, N+Remaining =:= NumY -> - Yregs1 = [{Y-N,Type} || {Y,Type} <- gb_trees:to_list(Yregs0), Y >= N], - Yregs = gb_trees_from_list(Yregs1), - Vst#vst{current=St#st{y=Yregs,numy=NumY-N}}; - true -> - error({trim,N,Remaining,allocated,NumY}) + N =< NumY, N+Remaining =:= NumY -> + Vst#vst{current=trim_stack(N, 0, NumY, St0)}; + N > NumY; N+Remaining =/= NumY -> + error({trim,N,Remaining,allocated,NumY}) end; %% Catch & try. -valfun_1({'catch',Dst,{f,Fail}}, Vst0) when Fail /= none -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({catchtag,[Fail]}, Dst, Vst0), - Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({'try',Dst,{f,Fail}}, Vst0) -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({trytag,[Fail]}, Dst, Vst0), - Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {catchtag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; - Type -> - error({bad_type,Type}) +valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> + init_try_catch_branch(catchtag, Dst, Fail, Vst); +valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> + init_try_catch_branch(trytag, Dst, Fail, Vst); +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {catchtag,Fail} -> + %% {x,0} contains the caught term, if any. + create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {trytag,Fail} -> - Vst = case Fail of - [FailLabel] -> branch_state(FailLabel, Vst0); - _ -> Vst0 - end, - St = St0#st{ct=Fails,fls=undefined}, - set_catch_end(Reg, Vst#vst{current=St}); - Type -> - error({bad_type,Type}) +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) -> + case get_tag_type(Reg, Vst) of + {trytag,Fail} -> + %% Kill the catch tag, note that x registers are unaffected. + kill_catch_tag(Reg, Vst); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {trytag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; - Type -> - error({bad_type,Type}) +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {trytag,Fail} -> + %% Kill the catch tag and all x registers. + Vst1 = prune_x_regs(0, kill_catch_tag(Reg, Vst0)), + + %% Class:Error:Stacktrace + Vst2 = create_term({atom,[]}, try_case, [], {x,0}, Vst1), + Vst = create_term(term, try_case, [], {x,1}, Vst2), + create_term(term, try_case, [], {x,2}, Vst); + Type -> + error({wrong_tag_type,Type}) end; valfun_1({get_list,Src,D1,D2}, Vst0) -> + assert_not_literal(Src), assert_type(cons, Src, Vst0), - Vst = set_type_reg(term, Src, D1, Vst0), - set_type_reg(term, Src, D2, Vst); + Vst = extract_term(term, get_hd, [Src], D1, Vst0), + extract_term(term, get_tl, [Src], D2, Vst); valfun_1({get_hd,Src,Dst}, Vst) -> + assert_not_literal(Src), assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + extract_term(term, get_hd, [Src], Dst, Vst); valfun_1({get_tl,Src,Dst}, Vst) -> + assert_not_literal(Src), assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); -valfun_1({get_tuple_element,Src,I,Dst}, Vst) -> - assert_type({tuple_element,I+1}, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + extract_term(term, get_tl, [Src], Dst, Vst); +valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> + assert_not_literal(Src), + assert_type({tuple_element,N+1}, Src, Vst), + Index = {integer,N+1}, + Type = get_element_type(Index, Src, Vst), + extract_term(Type, {bif,element}, [Index, Src], Dst, Vst); +valfun_1({jump,{f,Lbl}}, Vst) -> + branch(Lbl, Vst, + fun(SuccVst) -> + %% The next instruction is never executed. + kill_state(SuccVst) + end); valfun_1(I, Vst) -> valfun_2(I, Vst). -%% Update branched state if necessary and try next set of instructions. -valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> - valfun_3(I, Vst); +init_try_catch_branch(Tag, Dst, Fail, Vst0) -> + Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0), + #vst{current=#st{ct=Fails}=St0} = Vst1, + St = St0#st{ct=[[Fail]|Fails]}, + Vst = Vst0#vst{current=St}, + + branch(Fail, Vst, + fun(CatchVst) -> + #vst{current=#st{ys=Ys}} = CatchVst, + maps:fold(fun init_catch_handler_1/3, CatchVst, Ys) + end, + fun(SuccVst) -> + %% All potentially-throwing instructions after this + %% one will implicitly branch to the fail label; + %% see valfun_2/2 + SuccVst + end). + +%% Set the initial state at the try/catch label. Assume that Y registers +%% contain terms or try/catch tags. +init_catch_handler_1(Reg, initialized, Vst) -> + create_term(term, 'catch_handler', [], Reg, Vst); +init_catch_handler_1(Reg, uninitialized, Vst) -> + create_term(term, 'catch_handler', [], Reg, Vst); +init_catch_handler_1(_, _, Vst) -> + Vst. + valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> - %% Update branched state + %% We have an active try/catch tag and we can jump there from this + %% instruction, so we need to update the branched state of the try/catch + %% handler. valfun_3(I, branch_state(Fail, Vst)); +valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> + valfun_3(I, Vst); valfun_2(_, _) -> error(ambiguous_catch_try_state). @@ -480,17 +628,23 @@ valfun_2(_, _) -> %% Floating point. valfun_3({fconv,Src,{fr,_}=Dst}, Vst) -> assert_term(Src, Vst), - set_freg(Dst, Vst); -valfun_3({bif,fadd,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fdiv,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fmul,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fnegate,_,[_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fsub,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); + + %% An exception is raised on error, hence branching to 0. + branch(0, Vst, + fun(SuccVst0) -> + SuccVst = update_type(fun meet/2, number, Src, SuccVst0), + set_freg(Dst, SuccVst) + end); +valfun_3({bif,fadd,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fmul,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fnegate,_,[_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fsub,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); valfun_3(fclearerror, Vst) -> case get_fls(Vst) of undefined -> ok; @@ -541,67 +695,87 @@ valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs -valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), - Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_tuple_type({tuple,[0]}, TupleType0), - Vst = set_type(TupleType, Tuple, Vst1), - set_type_reg({integer,[]}, Dst, Vst); -valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), - PosType = get_term_type(Pos, Vst0), - Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0), - Vst = set_type(TupleType, Tuple, Vst1), - set_type_reg(term, Tuple, Dst, Vst); +valfun_4({bif,element,{f,Fail},[Pos,Src],Dst}, Vst) -> + branch(Fail, Vst, + fun(SuccVst0) -> + PosType = get_term_type(Pos, SuccVst0), + TupleType = {tuple,[get_tuple_size(PosType)],#{}}, + + SuccVst1 = update_type(fun meet/2, TupleType, + Src, SuccVst0), + SuccVst = update_type(fun meet/2, {integer,[]}, + Pos, SuccVst1), + + ElementType = get_element_type(PosType, Src, SuccVst), + extract_term(ElementType, {bif,element}, [Pos,Src], + Dst, SuccVst) + end); valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); valfun_4(raw_raise=I, Vst) -> call(I, 3, Vst); -valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> - validate_src(Src, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = set_type(map, Map, Vst1), - Type = propagate_fragility(term, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> - validate_src(Src, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = set_type(map, Map, Vst1), - Type = propagate_fragility(bool, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> - validate_src(Src, Vst0), - Vst = branch_state(Fail, Vst0), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) -> +valfun_4({bif,Op,{f,Fail},[Src]=Ss,Dst}, Vst) when Op =:= hd; Op =:= tl -> + assert_term(Src, Vst), + branch(Fail, Vst, + fun(FailVst) -> + update_type(fun subtract/2, cons, Src, FailVst) + end, + fun(SuccVst0) -> + SuccVst = update_type(fun meet/2, cons, Src, SuccVst0), + extract_term(term, {bif,Op}, Ss, Dst, SuccVst) + end); +valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst) -> + validate_src(Ss, Vst), + branch(Fail, Vst, + fun(SuccVst0) -> + %% Infer argument types. Note that we can't subtract + %% types as the BIF could fail for reasons other than + %% bad argument types. + ArgTypes = bif_arg_types(Op, Ss), + SuccVst = foldl(fun({Arg, T}, V) -> + update_type(fun meet/2, T, Arg, V) + end, SuccVst0, zip(Ss, ArgTypes)), + Type = bif_return_type(Op, Ss, SuccVst), + extract_term(Type, {bif,Op}, Ss, Dst, SuccVst) + end); +valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> + validate_src(Ss, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), + + %% Heap allocations and X registers are killed regardless of whether we + %% fail or not, as we may fail after GC. St = kill_heap_allocation(St0), - Vst1 = Vst0#vst{current=St}, - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - validate_src(Src, Vst), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); + Vst = prune_x_regs(Live, Vst0#vst{current=St}), + + branch(Fail, Vst, + fun(SuccVst0) -> + ArgTypes = bif_arg_types(Op, Ss), + SuccVst = foldl(fun({Arg, T}, V) -> + update_type(fun meet/2, T, Arg, V) + end, SuccVst0, zip(Ss, ArgTypes)), + + Type = bif_return_type(Op, Ss, SuccVst), + + %% We're passing Vst0 as the original because the + %% registers were pruned before the branch. + extract_term(Type, {gc_bif,Op}, Ss, Dst, SuccVst, Vst0) + end); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> - assert_term({x,0}, Vst), + assert_durable_term({x,0}, Vst), kill_state(Vst); valfun_4(return, #vst{current=#st{numy=NumY}}) -> error({stack_frame,NumY}); -valfun_4({jump,{f,Lbl}}, Vst) -> - kill_state(branch_state(Lbl, Vst)); -valfun_4({loop_rec,{f,Fail},Dst}, Vst0) -> - Vst = branch_state(Fail, Vst0), - %% This term may not be part of the root set until - %% remove_message/0 is executed. If control transfers - %% to the loop_rec_end/1 instruction, no part of - %% this term must be stored in a Y register. - set_type_reg({fragile,term}, Dst, Vst); +valfun_4({loop_rec,{f,Fail},Dst}, Vst) -> + %% This term may not be part of the root set until remove_message/0 is + %% executed. If control transfers to the loop_rec_end/1 instruction, no + %% part of this term must be stored in a Y register. + branch(Fail, Vst, + fun(SuccVst0) -> + {Ref, SuccVst} = new_value(term, loop_rec, [], SuccVst0), + mark_fragile(Dst, set_reg_vref(Ref, Dst, SuccVst)) + end); valfun_4({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -612,131 +786,169 @@ valfun_4({wait_timeout,_,Src}, Vst) -> valfun_4({loop_rec_end,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); -valfun_4(timeout, #vst{current=St}=Vst) -> - Vst#vst{current=St#st{x=init_regs(0, term)}}; +valfun_4(timeout, Vst) -> + prune_x_regs(0, Vst); valfun_4(send, Vst) -> call(send, 2, Vst); -valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> +valfun_4({set_tuple_element,Src,Tuple,N}, Vst) -> + I = N + 1, assert_term(Src, Vst), - assert_type({tuple_element,I+1}, Tuple, Vst), - Vst; + assert_type({tuple_element,I}, Tuple, Vst), + %% Manually update the tuple type; we can't rely on the ordinary update + %% helpers as we must support overwriting (rather than just widening or + %% narrowing) known elements, and we can't use extract_term either since + %% the source tuple may be aliased. + {tuple, Sz, Es0} = get_term_type(Tuple, Vst), + Es = set_element_type({integer,I}, get_term_type(Src, Vst), Es0), + override_type({tuple, Sz, Es}, Tuple, Vst); %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> assert_term(Src, Vst), - Lbls = [L || {f,L} <- Choices]++[Fail], - kill_state(foldl(fun(L, S) -> branch_state(L, S) end, Vst, Lbls)); + assert_choices(Choices), + validate_select_val(Fail, Choices, Src, Vst); valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> assert_type(tuple, Tuple, Vst), - kill_state(branch_arities(Choices, Tuple, branch_state(Fail, Vst))); + assert_arities(Choices), + validate_select_tuple_arity(Fail, Choices, Tuple, Vst); %% New bit syntax matching instructions. -valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> - %% If source and destination registers are the same, match state - %% is OK as input. - CtxType = get_move_term_type(Ctx, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst1 = prune_x_regs(Live, Vst0), - BranchVst = case CtxType of - #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 - %% (or we could reject legal code). - set_type_reg(term, Ctx, Vst1); - _ -> - Vst1 - end, - Vst = branch_state(Fail, BranchVst), - set_type_reg(bsm_match_state(NeedSlots), Ctx, Vst); -valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) -> - assert_term(Src, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst1 = prune_x_regs(Live, Vst0), - Vst = branch_state(Fail, Vst1), - set_type_reg(bsm_match_state(Slots), Src, Dst, Vst); +valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, bsm_match_state(), Src, Dst, Vst); +valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, bsm_match_state(Slots), Src, Dst, Vst); valfun_4({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) -> bsm_validate_context(Ctx, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_skip_bits2,{f,Fail},[Ctx,Src,_,_]}, Vst) -> bsm_validate_context(Ctx, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) -> bsm_validate_context(Ctx, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_test_unit,{f,Fail},[Ctx,_]}, Vst) -> bsm_validate_context(Ctx, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); valfun_4({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_4({test,bs_get_integer2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst); -valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - Type = propagate_fragility(term, [Ctx], Vst), - validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst); -valfun_4({test,bs_get_utf8,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_utf32,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst); +valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst); +valfun_4({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); valfun_4({bs_save2,Ctx,SavePoint}, Vst) -> bsm_save(Ctx, SavePoint, Vst); valfun_4({bs_restore2,Ctx,SavePoint}, Vst) -> bsm_restore(Ctx, SavePoint, Vst); +valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> + bsm_validate_context(Ctx, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + Vst = prune_x_regs(Live, Vst0), + create_term(ms_position, bs_get_position, [Ctx], Dst, Vst, Vst0); +valfun_4({bs_set_position, Ctx, Pos}, Vst) -> + bsm_validate_context(Ctx, Vst), + assert_type(ms_position, Pos, Vst), + Vst; %% Other test instructions. -valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) -> - assert_term(Float, Vst), - set_type({float,[]}, Float, branch_state(Lbl, Vst)); -valfun_4({test,is_tuple,{f,Lbl},[Tuple]}, Vst) -> - Type0 = get_term_type(Tuple, Vst), - Type = upgrade_tuple_type({tuple,[0]}, Type0), - set_type(Type, Tuple, branch_state(Lbl, Vst)); -valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) -> - assert_term(Cons, Vst), - set_type(cons, Cons, branch_state(Lbl, Vst)); -valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> - assert_type(tuple, Tuple, Vst), - set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst)); -valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) -> - validate_src([Src], Vst), - set_type_reg({tuple, Sz}, Src, branch_state(Lbl, Vst)); valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), assert_unique_map_keys(List), - branch_state(Lbl, Vst); -valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> - Vst = branch_state(Lbl, Vst0), - case Src of - {Tag,_} when Tag =:= x; Tag =:= y -> - set_type_reg(map, Src, Vst); - {literal,Map} when is_map(Map) -> - Vst; - _ -> - kill_state(Vst) - end; + branch(Lbl, Vst, fun(V) -> V end); +valfun_4({test,is_atom,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {atom,[]}, Src, Vst); +valfun_4({test,is_binary,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, binary, Src, Vst); +valfun_4({test,is_bitstr,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, binary, Src, Vst); +valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, bool, Src, Vst); +valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {float,[]}, Src, Vst); +valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {tuple,[0],#{}}, Src, Vst); +valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {integer,[]}, Src, Vst); +valfun_4({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, cons, Src, Vst); +valfun_4({test,is_number,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, number, Src, Vst); +valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, list, Src, Vst); +valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, map, Src, Vst); +valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) -> + %% is_nil is an exact check against the 'nil' value, and should not be + %% treated as a simple type test. + assert_term(Src, Vst), + branch(Lbl, Vst, + fun(FailVst) -> + update_ne_types(Src, nil, FailVst) + end, + fun(SuccVst) -> + update_eq_types(Src, nil, SuccVst) + end); +valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> + assert_type(tuple, Tuple, Vst), + Type = {tuple, Sz, #{}}, + type_test(Lbl, Type, Tuple, Vst); +valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) -> + assert_term(Src, Vst), + Type = {tuple, Sz, #{ {integer,1} => Atom }}, + type_test(Lbl, Type, Src, Vst); +valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> + validate_src(Ss, Vst), + branch(Lbl, Vst, + fun(FailVst) -> + update_ne_types(Src, Val, FailVst) + end, + fun(SuccVst) -> + update_eq_types(Src, Val, SuccVst) + end); +valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> + validate_src(Ss, Vst), + branch(Lbl, Vst, + fun(FailVst) -> + update_eq_types(Src, Val, FailVst) + end, + fun(SuccVst) -> + update_ne_types(Src, Val, SuccVst) + end); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> + %% is_pid, is_reference, et cetera. validate_src(Src, Vst), - branch_state(Lbl, Vst); + branch(Lbl, Vst, fun(V) -> V end); valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> assert_term(A, Vst), assert_term(B, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + branch(Fail, Vst, + fun(SuccVst) -> + create_term({integer,[]}, bs_add, [A, B], Dst, SuccVst) + end); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + branch(Fail, Vst, + fun(SuccVst) -> + create_term({integer,[]}, bs_utf8_size, [A], Dst, SuccVst) + end); valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + branch(Fail, Vst, + fun(SuccVst) -> + create_term({integer,[]}, bs_utf16_size, [A], Dst, SuccVst) + end); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -746,10 +958,12 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> true -> assert_term(Sz, Vst0) end, - Vst1 = heap_alloc(Heap, Vst0), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + Vst = heap_alloc(Heap, Vst0), + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + create_term(binary, bs_init2, [], Dst, SuccVst, SuccVst0) + end); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -759,116 +973,203 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> true -> assert_term(Sz, Vst0) end, - Vst1 = heap_alloc(Heap, Vst0), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + Vst = heap_alloc(Heap, Vst0), + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + create_term(binary, bs_init_bits, [], Dst, SuccVst) + end); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), assert_term(Bits, Vst0), assert_term(Bin, Vst0), - Vst1 = heap_alloc(Heap, Vst0), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); -valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> - assert_term(Bits, Vst0), - assert_term(Bin, Vst0), - Vst = branch_state(Fail, Vst0), - set_type_reg(binary, Dst, Vst); + Vst = heap_alloc(Heap, Vst0), + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + create_term(binary, bs_append, [Bin], Dst, SuccVst, SuccVst0) + end); +valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst) -> + assert_term(Bits, Vst), + assert_term(Bin, Vst), + branch(Fail, Vst, + fun(SuccVst) -> + create_term(binary, bs_private_append, [Bin], Dst, SuccVst) + end); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, binary, Src, SuccVst) + end); valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {float,[]}, Src, SuccVst) + end); valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); %% Map instructions. -valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); -valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> verify_get_map(Fail, Src, List, Vst); valfun_4(_, _) -> error(unknown_instruction). verify_get_map(Fail, Src, List, Vst0) -> + assert_not_literal(Src), %OTP 22. assert_type(map, Src, Vst0), - Vst1 = foldl(fun(D, Vsti) -> - case is_reg_defined(D,Vsti) of - true -> set_type_reg(term,D,Vsti); - false -> Vsti - end - end, Vst0, extract_map_vals(List)), - Vst2 = branch_state(Fail, Vst1), - Keys = extract_map_keys(List), - assert_unique_map_keys(Keys), - verify_get_map_pair(List, Src, Vst0, Vst2). - -extract_map_vals([_Key,Val|T]) -> - [Val|extract_map_vals(T)]; -extract_map_vals([]) -> []. + + branch(Fail, Vst0, + fun(FailVst) -> + clobber_map_vals(List, Src, FailVst) + end, + fun(SuccVst) -> + Keys = extract_map_keys(List), + assert_unique_map_keys(Keys), + extract_map_vals(List, Src, SuccVst, SuccVst) + end). + +%% get_map_elements may leave its destinations in an inconsistent state when +%% the fail label is taken. Consider the following: +%% +%% {get_map_elements,{f,7},{x,1},{list,[{atom,a},{x,1},{atom,b},{x,2}]}}. +%% +%% If 'a' exists but not 'b', {x,1} is overwritten when we jump to {f,7}. +clobber_map_vals([Key,Dst|T], Map, Vst0) -> + case is_reg_defined(Dst, Vst0) of + true -> + Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0), + clobber_map_vals(T, Map, Vst); + false -> + clobber_map_vals(T, Map, Vst0) + end; +clobber_map_vals([], _Map, Vst) -> + Vst. extract_map_keys([Key,_Val|T]) -> [Key|extract_map_keys(T)]; extract_map_keys([]) -> []. -verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) -> - assert_term(Src, Vst0), - Vsti = set_type_reg(term, Map, Dst, Vsti0), - verify_get_map_pair(Vs, Map, Vst0, Vsti); -verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst. +extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) -> + assert_term(Key, Vst0), + Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0), + extract_map_vals(Vs, Map, Vst0, Vsti); +extract_map_vals([], _Map, _Vst0, Vst) -> + Vst. -verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> +verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), - foreach(fun (Term) -> assert_term(Term, Vst0) end, List), - Vst1 = heap_alloc(0, Vst0), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - Keys = extract_map_keys(List), - assert_unique_map_keys(Keys), - set_type_reg(map, Dst, Vst). + _ = [assert_term(Term, Vst0) || Term <- List], + Vst = heap_alloc(0, Vst0), + + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + Keys = extract_map_keys(List), + assert_unique_map_keys(Keys), + create_term(map, Op, [Src], Dst, SuccVst, SuccVst0) + end). + +%% +%% Common code for validating bs_start_match* instructions. +%% + +validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> + verify_live(Live, Vst), + verify_y_init(Vst), + + %% #ms{} can represent either a match context or a term, so we have to mark + %% the source as a term if it fails with a match context as an input. This + %% hack is only needed until we get proper union types. + branch(Fail, Vst, + fun(FailVst) -> + case get_movable_term_type(Src, FailVst) of + #ms{} -> override_type(term, Src, FailVst); + _ -> FailVst + end + end, + fun(SuccVst0) -> + SuccVst1 = update_type(fun meet/2, binary, + Src, SuccVst0), + SuccVst = prune_x_regs(Live, SuccVst1), + extract_term(Type, bs_start_match, [Src], Dst, + SuccVst, SuccVst0) + end). %% %% Common code for validating bs_get* instructions. %% -validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) -> - bsm_validate_context(Ctx, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst1 = prune_x_regs(Live, Vst0), - Vst = branch_state(Fail, Vst1), - set_type_reg(Type, Dst, Vst). +validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) -> + bsm_validate_context(Ctx, Vst), + verify_live(Live, Vst), + verify_y_init(Vst), + + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + extract_term(Type, Op, [Ctx], Dst, SuccVst, SuccVst0) + end). %% %% Common code for validating bs_skip_utf* instructions. %% -validate_bs_skip_utf(Fail, Ctx, Live, Vst0) -> - bsm_validate_context(Ctx, Vst0), - verify_y_init(Vst0), - verify_live(Live, Vst0), - Vst = prune_x_regs(Live, Vst0), - branch_state(Fail, Vst). +validate_bs_skip_utf(Fail, Ctx, Live, Vst) -> + bsm_validate_context(Ctx, Vst), + verify_y_init(Vst), + verify_live(Live, Vst), + + branch(Fail, Vst, + fun(SuccVst) -> + prune_x_regs(Live, SuccVst) + end). + +%% +%% Common code for is_$type instructions. +%% +type_test(Fail, Type, Reg, Vst) -> + assert_term(Reg, Vst), + branch(Fail, Vst, + fun(FailVst) -> + update_type(fun subtract/2, Type, Reg, FailVst) + end, + fun(SuccVst) -> + update_type(fun meet/2, Type, Reg, SuccVst) + end). %% %% Special state handling for setelement/3 and set_tuple_element/3 instructions. @@ -885,34 +1186,29 @@ val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; +val_dsetel({get_tuple_element,_,_,_}, Vst) -> + Vst; val_dsetel({line,_}, Vst) -> Vst; val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; val_dsetel(_, Vst) -> Vst. -kill_state(#vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> - %% There is an active catch. Make sure that we merge the state into - %% the catch label before clearing it, so that that we can be sure - %% that the label gets a state. - kill_state_1(branch_state(Fail, Vst)); kill_state(Vst) -> - kill_state_1(Vst). - -kill_state_1(Vst) -> Vst#vst{current=none}. %% A "plain" call. %% The stackframe must be initialized. %% The instruction will return to the instruction following the call. -call(Name, Live, #vst{current=St}=Vst) -> - verify_call_args(Name, Live, Vst), - verify_y_init(Vst), - case return_type(Name, Vst) of - Type when Type =/= exception -> - %% Type is never 'exception' because it has been handled earlier. - Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs,f=init_fregs()}} +call(Name, Live, #vst{current=St0}=Vst0) -> + verify_call_args(Name, Live, Vst0), + verify_y_init(Vst0), + case call_return_type(Name, Vst0) of + Type when Type =/= exception -> + %% Type is never 'exception' because it has been handled earlier. + St = St0#st{f=init_fregs()}, + Vst = prune_x_regs(0, Vst0#vst{current=St}), + create_term(Type, call, [], {x,0}, Vst) end. %% Tail call. @@ -928,79 +1224,131 @@ tail_call(Name, Live, Vst0) -> verify_call_args(_, 0, #vst{}) -> ok; verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - verify_local_call(Lbl, Live, Vst); + verify_local_args(Live - 1, Lbl, #{}, Vst); verify_call_args(_, Live, Vst) when is_integer(Live)-> - verify_call_args_1(Live, Vst); + verify_remote_args_1(Live - 1, Vst); verify_call_args(_, Live, _) -> error({bad_number_of_live_regs,Live}). -verify_call_args_1(0, _) -> ok; -verify_call_args_1(N, Vst) -> - X = N - 1, - 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 +verify_remote_args_1(-1, _) -> + ok; +verify_remote_args_1(X, Vst) -> + assert_durable_term({x, X}, Vst), + verify_remote_args_1(X - 1, Vst). + +verify_local_args(-1, _Lbl, _CtxIds, _Vst) -> + ok; +verify_local_args(X, Lbl, CtxIds, Vst) -> + Reg = {x, X}, + assert_not_fragile(Reg, Vst), + case get_movable_term_type(Reg, Vst) of + #ms{id=Id}=Type -> + case CtxIds of + #{ Id := Other } -> + error({multiple_match_contexts, [Reg, Other]}); + #{} -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) + end; + Type -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds, Vst) 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) +%% Verifies that the given argument narrows to what the function expects. +verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) -> + %% Match contexts require explicit support, and may not be passed to a + %% function that accepts arbitrary terms. + case gb_trees:lookup({Lbl, Reg}, Ft) of + {value, #ms{}} -> ok; + _ -> error(no_bs_start_match2) + end; +verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) -> + case gb_trees:lookup({Lbl, Reg}, Ft) of + {value, #ms{}} -> + %% Functions that accept match contexts also accept all other + %% terms. This will change once we support union types. + ok; + {value, RequiredType} -> + case vat_1(GivenType, RequiredType) of + true -> ok; + false -> error({bad_arg_type, Reg, GivenType, RequiredType}) + end; + none -> + ok end. -ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) -> - Ys = gb_trees:to_list(Ys0), - [{y,Y} || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id]. +%% Checks whether the Given argument is compatible with the Required one. This +%% is essentially a relaxed version of 'meet(Given, Req) =:= Given', where we +%% accept that the Given value has the right type but not necessarily the exact +%% same value; if {atom,gurka} is required, we'll consider {atom,[]} valid. +%% +%% This will catch all problems that could crash the emulator, like passing a +%% 1-tuple when the callee expects a 3-tuple, but some value errors might slip +%% through. +vat_1(Same, Same) -> true; +vat_1({atom,A}, {atom,B}) -> A =:= B orelse is_list(A) orelse is_list(B); +vat_1({atom,A}, bool) -> is_boolean(A) orelse is_list(A); +vat_1(bool, {atom,B}) -> is_boolean(B) orelse is_list(B); +vat_1(cons, list) -> true; +vat_1({float,A}, {float,B}) -> A =:= B orelse is_list(A) orelse is_list(B); +vat_1({float,_}, number) -> true; +vat_1({integer,A}, {integer,B}) -> A =:= B orelse is_list(A) orelse is_list(B); +vat_1({integer,_}, number) -> true; +vat_1(_, {literal,_}) -> false; +vat_1({literal,_}=Lit, Required) -> vat_1(get_literal_type(Lit), Required); +vat_1(nil, list) -> true; +vat_1({tuple,SzA,EsA}, {tuple,SzB,EsB}) -> + if + is_list(SzB) -> + tuple_sz(SzA) >= tuple_sz(SzB) andalso vat_elements(EsA, EsB); + SzA =:= SzB -> + vat_elements(EsA, EsB); + SzA =/= SzB -> + false + end; +vat_1(_, _) -> false. -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,_,_,_,_}=I|_]} -> - error({unsuitable_bs_start_match2,I}) - end. +vat_elements(EsA, EsB) -> + maps:fold(fun(Key, Req, Acc) -> + case EsA of + #{ Key := Given } -> Acc andalso vat_1(Given, Req); + #{} -> false + end + end, true, EsB). -allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}}=Vst0) -> +allocate(Tag, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> verify_live(Live, Vst0), - Vst = #vst{current=St} = prune_x_regs(Live, Vst0), - Ys = init_regs(Stk, case Zero of - true -> initialized; - false -> uninitialized - end), - heap_alloc(Heap, Vst#vst{current=St#st{y=Ys,numy=Stk}}); + Vst1 = Vst0#vst{current=St#st{numy=Stk}}, + Vst2 = prune_x_regs(Live, Vst1), + Vst = init_stack(Tag, Stk - 1, Vst2), + heap_alloc(Heap, Vst); allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> error({existing_stack_frame,{size,Numy}}). deallocate(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. + Vst#vst{current=St#st{ys=#{},numy=none}}. + +init_stack(_Tag, -1, Vst) -> + Vst; +init_stack(Tag, Y, Vst) -> + init_stack(Tag, Y - 1, create_tag(Tag, allocate, [], {y,Y}, Vst)). + +trim_stack(From, To, Top, #st{ys=Ys0}=St) when From =:= Top -> + Ys = maps:filter(fun({y,Y}, _) -> Y < To end, Ys0), + St#st{numy=To,ys=Ys}; +trim_stack(From, To, Top, St0) -> + Src = {y, From}, + Dst = {y, To}, + + #st{ys=Ys0} = St0, + Ys = case Ys0 of + #{ Src := Ref } -> Ys0#{ Dst => Ref }; + #{} -> error({invalid_shift,Src,Dst}) + end, + St = St0#st{ys=Ys}, + + trim_stack(From + 1, To + 1, Top, St). test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), @@ -1025,13 +1373,43 @@ heap_alloc_2([{floats,Floats}|T], St0) -> St = St0#st{hf=Floats}, heap_alloc_2(T, St); heap_alloc_2([], St) -> St. - -prune_x_regs(Live, #vst{current=#st{x=Xs0}=St0}=Vst) when is_integer(Live) -> - Xs1 = gb_trees:to_list(Xs0), - Xs = [P || {R,_}=P <- Xs1, R < Live], - St = St0#st{x=gb_trees:from_orddict(Xs)}, + +prune_x_regs(Live, #vst{current=St0}=Vst) when is_integer(Live) -> + #st{fragile=Fragile0,xs=Xs0} = St0, + Fragile = cerl_sets:filter(fun({x,X}) -> + X < Live; + ({y,_}) -> + true + end, Fragile0), + Xs = maps:filter(fun({x,X}, _) -> + X < Live + end, Xs0), + St = St0#st{fragile=Fragile,xs=Xs}, Vst#vst{current=St}. +%% All choices in a select_val list must be integers, floats, or atoms. +%% All must be of the same type. +assert_choices([{Tag,_},{f,_}|T]) -> + if + Tag =:= atom; Tag =:= float; Tag =:= integer -> + assert_choices_1(T, Tag); + true -> + error(bad_select_list) + end; +assert_choices([]) -> ok. + +assert_choices_1([{Tag,_},{f,_}|T], Tag) -> + assert_choices_1(T, Tag); +assert_choices_1([_,{f,_}|_], _Tag) -> + error(bad_select_list); +assert_choices_1([], _Tag) -> ok. + +assert_arities([Arity,{f,_}|T]) when is_integer(Arity) -> + assert_arities(T); +assert_arities([]) -> ok; +assert_arities(_) -> error(bad_tuple_arity_list). + + %%% %%% Floating point checking. %%% @@ -1051,8 +1429,8 @@ prune_x_regs(Live, #vst{current=#st{x=Xs0}=St0}=Vst) when is_integer(Live) -> %%% fmove Src {fr,_} %% Move INTO floating point register. %%% -float_op(Src, Dst, Vst0) -> - foreach (fun(S) -> assert_freg_set(S, Vst0) end, Src), +float_op(Ss, Dst, Vst0) -> + _ = [assert_freg_set(S, Vst0) || S <- Ss], assert_fls(cleared, Vst0), Vst = set_fls(cleared, Vst0), set_freg(Dst, Vst). @@ -1070,8 +1448,7 @@ get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls. init_fregs() -> 0. -set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst) - when is_integer(Fr), 0 =< Fr -> +set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst) -> check_limit(Freg), Bit = 1 bsl Fr, if @@ -1107,7 +1484,10 @@ assert_unique_map_keys([]) -> assert_unique_map_keys([_]) -> ok; assert_unique_map_keys([_,_|_]=Ls) -> - Vs = [get_literal(L) || L <- Ls], + Vs = [begin + assert_literal(L), + L + end || L <- Ls], case length(Vs) =:= sets:size(sets:from_list(Vs)) of true -> ok; false -> error(keys_not_unique) @@ -1117,6 +1497,8 @@ assert_unique_map_keys([_,_|_]=Ls) -> %%% New binary matching instructions. %%% +bsm_match_state() -> + #ms{}. bsm_match_state(Slots) -> #ms{slots=Slots}. @@ -1124,13 +1506,13 @@ bsm_validate_context(Reg, Vst) -> _ = bsm_get_context(Reg, Vst), ok. -bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) -> - case gb_trees:lookup(X, Xs) of - {value,#ms{}=Ctx} -> Ctx; - {value,{fragile,#ms{}=Ctx}} -> Ctx; - _ -> error({no_bsm_context,Reg}) +bsm_get_context({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y-> + case get_movable_term_type(Reg, Vst) of + #ms{}=Ctx -> Ctx; + _ -> error({no_bsm_context,Reg}) end; -bsm_get_context(Reg, _) -> error({bad_source,Reg}). +bsm_get_context(Reg, _) -> + error({bad_source,Reg}). bsm_save(Reg, {atom,start}, Vst) -> %% Save point refering to where the match started. @@ -1141,7 +1523,7 @@ bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of #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); + override_type(Ctx, Reg, Vst); _ -> error({illegal_save,SavePoint}) end. @@ -1160,104 +1542,380 @@ bsm_restore(Reg, SavePoint, Vst) -> _ -> error({illegal_restore,SavePoint,range}) end. +validate_select_val(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> + %% We've already branched on all of Src's possible values, so we know we + %% can't reach the fail label or any of the remaining choices. + Vst; +validate_select_val(Fail, [Val,{f,L}|T], Src, Vst0) -> + Vst = branch(L, Vst0, + fun(BranchVst) -> + update_eq_types(Src, Val, BranchVst) + end, + fun(FailVst) -> + update_ne_types(Src, Val, FailVst) + end), + validate_select_val(Fail, T, Src, Vst); +validate_select_val(Fail, [], _, Vst) -> + branch(Fail, Vst, + fun(SuccVst) -> + %% The next instruction is never executed. + kill_state(SuccVst) + end). + +validate_select_tuple_arity(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> + %% We've already branched on all of Src's possible values, so we know we + %% can't reach the fail label or any of the remaining choices. + Vst; +validate_select_tuple_arity(Fail, [Arity,{f,L}|T], Tuple, Vst0) -> + Type = {tuple, Arity, #{}}, + Vst = branch(L, Vst0, + fun(BranchVst) -> + update_type(fun meet/2, Type, Tuple, BranchVst) + end, + fun(FailVst) -> + update_type(fun subtract/2, Type, Tuple, FailVst) + end), + validate_select_tuple_arity(Fail, T, Tuple, Vst); +validate_select_tuple_arity(Fail, [], _, #vst{}=Vst) -> + branch(Fail, Vst, + fun(SuccVst) -> + %% The next instruction is never executed. + kill_state(SuccVst) + end). + +infer_types({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> + infer_types(get_reg_vref(Reg, Vst), Vst); +infer_types(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> + case Vs of + #{ Ref := Entry } -> infer_types_1(Entry); + #{} -> fun(_, S) -> S end + end; +infer_types(_, #vst{}) -> + fun(_, S) -> S end. + +infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> + fun({atom,true}, S) -> + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, S), + Infer_R = infer_types(LHS, S), + Infer_R(RHS, Infer_L(LHS, S)); + (_, S) -> S + end; +infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> + fun(Val, S) -> + case is_value_alive(Tuple, S) of + true -> + Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }}, + update_type(fun meet/2, Type, Tuple, S); + false -> + S + end + end; +infer_types_1(#value{op={bif,is_atom},args=[Src]}) -> + infer_type_test_bif({atom,[]}, Src); +infer_types_1(#value{op={bif,is_boolean},args=[Src]}) -> + infer_type_test_bif(bool, Src); +infer_types_1(#value{op={bif,is_binary},args=[Src]}) -> + infer_type_test_bif(binary, Src); +infer_types_1(#value{op={bif,is_bitstring},args=[Src]}) -> + infer_type_test_bif(binary, Src); +infer_types_1(#value{op={bif,is_float},args=[Src]}) -> + infer_type_test_bif(float, Src); +infer_types_1(#value{op={bif,is_integer},args=[Src]}) -> + infer_type_test_bif({integer,{}}, Src); +infer_types_1(#value{op={bif,is_list},args=[Src]}) -> + infer_type_test_bif(list, Src); +infer_types_1(#value{op={bif,is_map},args=[Src]}) -> + infer_type_test_bif(map, Src); +infer_types_1(#value{op={bif,is_number},args=[Src]}) -> + infer_type_test_bif(number, Src); +infer_types_1(#value{op={bif,is_tuple},args=[Src]}) -> + infer_type_test_bif({tuple,[0],#{}}, Src); +infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) -> + fun({integer,Arity}, S) -> + case is_value_alive(Tuple, S) of + true -> update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); + false -> S + end; + (_, S) -> S + end; +infer_types_1(_) -> + fun(_, S) -> S end. + +infer_type_test_bif(Type, Src) -> + fun({atom,true}, S) -> + case is_value_alive(Src, S) of + true -> update_type(fun meet/2, Type, Src, S); + false -> S + end; + (_, S) -> + S + end. + %%% %%% Keeping track of types. %%% -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, Src, Dst, Vst) -> - case get_term_type_1(Src, Vst) of - {fragile,_} -> - set_type_reg(make_fragile(Type), Dst, Vst); +%% Assigns Src to Dst and marks them as aliasing each other. +assign({y,_}=Src, {y,_}=Dst, Vst) -> + %% The stack trimming optimization may generate a move from an initialized + %% but unassigned Y register to another Y register. + case get_raw_type(Src, Vst) of + initialized -> create_tag(initialized, init, [], Dst, Vst); + _ -> assign_1(Src, Dst, Vst) + end; +assign({Kind,_}=Src, Dst, Vst) when Kind =:= x; Kind =:= y -> + assign_1(Src, Dst, Vst); +assign(Literal, Dst, Vst) -> + Type = get_literal_type(Literal), + create_term(Type, move, [Literal], Dst, Vst). + +%% Creates a special tag value that isn't a regular term, such as 'initialized' +%% or 'catchtag' +create_tag(Tag, _Op, _Ss, {y,_}=Dst, #vst{current=#st{ys=Ys0}=St0}=Vst) -> + case maps:get(Dst, Ys0, uninitialized) of + {catchtag,_}=Prev -> + error(Prev); + {trytag,_}=Prev -> + error(Prev); _ -> - set_type_reg(Type, Dst, Vst) + check_try_catch_tags(Tag, Dst, Vst), + Ys = Ys0#{ Dst => Tag }, + St = St0#st{ys=Ys}, + remove_fragility(Dst, Vst#vst{current=St}) + end; +create_tag(_Tag, _Op, _Ss, Dst, _Vst) -> + error({invalid_tag_register, Dst}). + +%% Wipes a special tag, leaving the register initialized but empty. +kill_tag({y,_}=Reg, #vst{current=#st{ys=Ys0}=St0}=Vst) -> + _ = get_tag_type(Reg, Vst), %Assertion. + Ys = Ys0#{ Reg => initialized }, + Vst#vst{current=St0#st{ys=Ys}}. + +%% Creates a completely new term with the given type. +create_term(Type, Op, Ss0, Dst, Vst0) -> + create_term(Type, Op, Ss0, Dst, Vst0, Vst0). + +%% As create_term/4, but uses the incoming Vst for argument resolution in +%% case x-regs have been pruned and the sources can no longer be found. +create_term(Type, Op, Ss0, Dst, Vst0, OrigVst) -> + {Ref, Vst1} = new_value(Type, Op, resolve_args(Ss0, OrigVst), Vst0), + Vst = remove_fragility(Dst, Vst1), + set_reg_vref(Ref, Dst, Vst). + +%% Extracts a term from Ss, propagating fragility. +extract_term(Type, Op, Ss0, Dst, Vst0) -> + extract_term(Type, Op, Ss0, Dst, Vst0, Vst0). + +%% As extract_term/4, but uses the incoming Vst for argument resolution in +%% case x-regs have been pruned and the sources can no longer be found. +extract_term(Type, Op, Ss0, Dst, Vst0, OrigVst) -> + {Ref, Vst1} = new_value(Type, Op, resolve_args(Ss0, OrigVst), Vst0), + Vst = propagate_fragility(Dst, Ss0, Vst1), + set_reg_vref(Ref, Dst, Vst). + +%% Translates instruction arguments into the argument() type, decoupling them +%% from their registers, allowing us to infer their types after they've been +%% clobbered or moved. +resolve_args([{Kind,_}=Src | Args], Vst) when Kind =:= x; Kind =:= y -> + [get_reg_vref(Src, Vst) | resolve_args(Args, Vst)]; +resolve_args([Lit | Args], Vst) -> + assert_literal(Lit), + [Lit | resolve_args(Args, Vst)]; +resolve_args([], _Vst) -> + []. + +%% Overrides the type of Reg. This is ugly but a necessity for certain +%% destructive operations. +override_type(Type, Reg, Vst) -> + update_type(fun(_, T) -> T end, Type, Reg, Vst). + +%% This is used when linear code finds out more and more information about a +%% type, so that the type gets more specialized. +update_type(Merge, With, #value_ref{}=Ref, Vst) -> + %% If the old type can't be merged with the new one, the type information + %% is inconsistent and we know that some instructions will never be + %% executed at run-time. For example: + %% + %% {test,is_list,Fail,[Reg]}. + %% {test,is_tuple,Fail,[Reg]}. + %% {test,test_arity,Fail,[Reg,5]}. + %% + %% Note that the test_arity instruction can never be reached, so we need to + %% kill the state to avoid raising an error when we encounter it. + %% + %% Simply returning `kill_state(Vst)` is unsafe however as we might be in + %% the middle of an instruction, and altering the rest of the validator + %% (eg. prune_x_regs/2) to no-op on dead states is prone to error. + %% + %% We therefore throw a 'type_conflict' error instead, which causes + %% validation to fail unless we're in a context where such errors can be + %% handled, such as in a branch handler. + Current = get_raw_type(Ref, Vst), + case Merge(Current, With) of + none -> throw({type_conflict, Current, With}); + Type -> set_type(Type, Ref, Vst) + end; +update_type(Merge, With, {Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> + update_type(Merge, With, get_reg_vref(Reg, Vst), Vst); +update_type(Merge, With, Literal, Vst) -> + assert_literal(Literal), + %% Literals always retain their type, but we still need to bail on type + %% conflicts. + case Merge(Literal, With) of + none -> throw({type_conflict, Literal, With}); + _Type -> Vst end. -set_type_reg(Type, {x,_}=Reg, Vst) -> - set_type_x(Type, Reg, Vst); -set_type_reg(Type, Reg, Vst) -> - set_type_y(Type, Reg, Vst). - -set_type_x(Type, {x,X}=Reg, #vst{current=#st{x=Xs0}=St}=Vst) - when is_integer(X), 0 =< X -> - check_limit(Reg), - Xs = case gb_trees:lookup(X, Xs0) of - none -> - gb_trees:insert(X, Type, Xs0); - {value,{fragile,_}} -> - gb_trees:update(X, make_fragile(Type), Xs0); - {value,_} -> - gb_trees:update(X, Type, Xs0) - end, - Vst#vst{current=St#st{x=Xs}}; -set_type_x(Type, Reg, #vst{}) -> - error({invalid_store,Reg,Type}). - -set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) - when is_integer(Y), 0 =< Y -> - check_limit(Reg), - Ys = case gb_trees:lookup(Y, Ys0) of - none -> - error({invalid_store,Reg,Type}); - {value,{catchtag,_}=Tag} -> - error(Tag); - {value,{trytag,_}=Tag} -> - error(Tag); - {value,_} -> - gb_trees:update(Y, Type, Ys0) - end, - check_try_catch_tags(Type, Y, Ys0), - Vst#vst{current=St#st{y=Ys}}; -set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}). - -make_fragile({fragile,_}=Type) -> Type; -make_fragile(Type) -> {fragile,Type}. - -set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) -> - Ys = gb_trees:update(Y, initialized, Ys0), - Vst#vst{current=St#st{y=Ys}}. - -check_try_catch_tags(Type, LastY, Ys) -> - case is_try_catch_tag(Type) of - false -> - ok; - true -> - %% Every catch or try/catch must use a lower Y register - %% number than any enclosing catch or try/catch. That will - %% ensure that when the stack is scanned when an - %% exception occurs, the innermost try/catch tag is found - %% first. - Bad = [{{y,Y},Tag} || {Y,Tag} <- gb_trees:to_list(Ys), - Y < LastY, is_try_catch_tag(Tag)], - case Bad of - [] -> - ok; - [_|_] -> - error({bad_try_catch_nesting,{y,LastY},Bad}) - end +update_ne_types(LHS, RHS, Vst) -> + %% While updating types on equality is fairly straightforward, inequality + %% is a bit trickier since all we know is that the *value* of LHS differs + %% from RHS, so we can't blindly subtract their types. + %% + %% Consider `number =/= {integer,[]}`; all we know is that LHS isn't equal + %% to some *specific integer* of unknown value, and if we were to subtract + %% {integer,[]} we would erroneously infer that the new type is {float,[]}. + %% + %% Therefore, we only subtract when we know that RHS has a specific value. + RType = get_term_type(RHS, Vst), + case is_literal(RType) of + true -> update_type(fun subtract/2, RType, LHS, Vst); + false -> Vst end. -is_try_catch_tag({catchtag,_}) -> true; -is_try_catch_tag({trytag,_}) -> true; -is_try_catch_tag(_) -> false. +update_eq_types(LHS, RHS, Vst0) -> + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, Vst0), + Infer_R = infer_types(LHS, Vst0), + Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)), -is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst); -is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst); -is_reg_defined(V, #vst{}) -> error({not_a_register, V}). + T1 = get_term_type(LHS, Vst1), + T2 = get_term_type(RHS, Vst1), + + Vst = update_type(fun meet/2, T2, LHS, Vst1), + update_type(fun meet/2, T1, RHS, Vst). + +%% Helper functions for the above. + +assign_1(Src, Dst, Vst0) -> + assert_movable(Src, Vst0), + Vst = propagate_fragility(Dst, [Src], Vst0), + set_reg_vref(get_reg_vref(Src, Vst), Dst, Vst). + +set_reg_vref(Ref, {x,_}=Dst, Vst) -> + check_limit(Dst), + #vst{current=#st{xs=Xs0}=St0} = Vst, + St = St0#st{xs=Xs0#{ Dst => Ref }}, + Vst#vst{current=St}; +set_reg_vref(Ref, {y,_}=Dst, #vst{current=#st{ys=Ys0}=St0} = Vst) -> + check_limit(Dst), + case Ys0 of + #{ Dst := {catchtag,_}=Tag } -> + error(Tag); + #{ Dst := {trytag,_}=Tag } -> + error(Tag); + #{ Dst := _ } -> + St = St0#st{ys=Ys0#{ Dst => Ref }}, + Vst#vst{current=St}; + #{} -> + %% Storing into a non-existent Y register means that we haven't set + %% up a (sufficiently large) stack. + error({invalid_store, Dst}) + end. -is_type_defined_x({x,X}, #vst{current=#st{x=Xs}}) -> - gb_trees:is_defined(X,Xs). +get_reg_vref({x,_}=Src, #vst{current=#st{xs=Xs}}) -> + check_limit(Src), + case Xs of + #{ Src := #value_ref{}=Ref } -> + Ref; + #{} -> + error({uninitialized_reg, Src}) + end; +get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) -> + check_limit(Src), + case Ys of + #{ Src := #value_ref{}=Ref } -> + Ref; + #{ Src := initialized } -> + error({unassigned, Src}); + #{ Src := Tag } when Tag =/= uninitialized -> + error(Tag); + #{} -> + error({uninitialized_reg, Src}) + end. + +set_type(Type, #value_ref{}=Ref, #vst{current=#st{vs=Vs0}=St}=Vst) -> + case Vs0 of + #{ Ref := #value{}=Entry } -> + Vs = Vs0#{ Ref => Entry#value{type=Type} }, + Vst#vst{current=St#st{vs=Vs}}; + #{} -> + %% Dead references may happen during type inference and are not an + %% error in and of themselves. If a problem were to arise from this + %% it'll explode elsewhere. + Vst + end. + +new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> + Ref = #value_ref{id=Counter}, + Vs = Vs0#{ Ref => #value{op=Op,args=Ss,type=Type} }, + + {Ref, Vst#vst{current=St#st{vs=Vs},ref_ctr=Counter+1}}. -is_type_defined_y({y,Y}, #vst{current=#st{y=Ys}}) -> - gb_trees:is_defined(Y,Ys). +kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> + Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, + {_, Fail} = get_tag_type(Reg, Vst), %Assertion. + kill_tag(Reg, Vst). + +check_try_catch_tags(Type, {y,N}=Reg, Vst) -> + %% Every catch or try/catch must use a lower Y register number than any + %% enclosing catch or try/catch. That will ensure that when the stack is + %% scanned when an exception occurs, the innermost try/catch tag is found + %% first. + case is_try_catch_tag(Type) of + true -> + case collect_try_catch_tags(N - 1, Vst, []) of + [_|_]=Bad -> error({bad_try_catch_nesting, Reg, Bad}); + [] -> ok + end; + false -> + ok + end. + +is_reg_defined({x,_}=Reg, #vst{current=#st{xs=Xs}}) -> is_map_key(Reg, Xs); +is_reg_defined({y,_}=Reg, #vst{current=#st{ys=Ys}}) -> is_map_key(Reg, Ys); +is_reg_defined(V, #vst{}) -> error({not_a_register, V}). assert_term(Src, Vst) -> - get_term_type(Src, Vst), + _ = get_term_type(Src, Vst), + ok. + +assert_movable(Src, Vst) -> + _ = get_movable_term_type(Src, Vst), ok. +assert_literal(Src) -> + case is_literal(Src) of + true -> ok; + false -> error({literal_required,Src}) + end. + +assert_not_literal(Src) -> + case is_literal(Src) of + true -> error({literal_not_allowed,Src}); + false -> ok + end. + +is_literal(nil) -> true; +is_literal({atom,A}) when is_atom(A) -> true; +is_literal({float,F}) when is_float(F) -> true; +is_literal({integer,I}) when is_integer(I) -> true; +is_literal({literal,_L}) -> true; +is_literal(_) -> false. + %% The possible types. %% %% First non-term types: @@ -1276,10 +1934,10 @@ assert_term(Src, Vst) -> %% used by the catch instructions; NOT safe to use in other %% instructions. %% -%% exception Can only be used as a type returned by return_type/2 -%% (which gives the type of the value returned by a BIF). -%% Thus 'exception' is never stored as type descriptor -%% for a register. +%% exception Can only be used as a type returned by +%% call_return_type/2 (which gives the type of the value +%% returned by a call). Thus 'exception' is never stored +%% as type descriptor for a register. %% %% #ms{} A match context for bit syntax matching. We do allow %% it to moved/to from stack, but otherwise it must only @@ -1290,17 +1948,22 @@ assert_term(Src, Vst) -> %% %% term Any valid Erlang (but not of the special types above). %% +%% binary Binary or bitstring. +%% %% bool The atom 'true' or the atom 'false'. %% %% cons Cons cell: [_|_] %% %% nil Empty list: [] %% -%% {tuple,[Sz]} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. +%% list List: [] or [_|_] +%% +%% {tuple,[Sz],Es} Tuple. An element has been accessed using +%% element/2 or setelement/3 so that it is known that +%% the type is a tuple of size at least Sz. Es is a map +%% containing known types by tuple index. %% -%% {tuple,Sz} Tuple. A test_arity instruction has been seen +%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen %% so that it is known that the size is exactly Sz. %% %% {atom,[]} Atom. @@ -1316,35 +1979,214 @@ assert_term(Src, Vst) -> %% %% map Map. %% +%% none A conflict in types. There will be an exception at runtime. %% -%% -%% FRAGILITY -%% --------- -%% -%% The loop_rec/2 instruction may return a reference to a term that is -%% not part of the root set. That term or any part of it must not be -%% included in a garbage collection. Therefore, the term (or any part -%% of it) must not be stored in an Y register. -%% -%% Such terms are wrapped in a {fragile,Type} tuple, where Type is one -%% of the types described above. -assert_type(WantedType, Term, Vst) -> - case get_term_type(Term, Vst) of - {fragile,Type} -> - assert_type(WantedType, Type); - Type -> - assert_type(WantedType, Type) +%% join(Type1, Type2) -> Type +%% Return the most specific type possible. +join(Same, Same) -> + Same; +join(none, Other) -> + Other; +join(Other, none) -> + Other; +join({literal,_}=T1, T2) -> + join_literal(T1, T2); +join(T1, {literal,_}=T2) -> + join_literal(T2, T1); +join({tuple,Size,EsA}, {tuple,Size,EsB}) -> + Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), + {tuple, Size, Es}; +join({tuple,A,EsA}, {tuple,B,EsB}) -> + Size = min(tuple_sz(A), tuple_sz(B)), + Es = join_tuple_elements(Size, EsA, EsB), + {tuple, [Size], Es}; +join({Type,A}, {Type,B}) + when Type =:= atom; Type =:= integer; Type =:= float -> + if A =:= B -> {Type,A}; + true -> {Type,[]} + end; +join({Type,_}, number) + when Type =:= integer; Type =:= float -> + number; +join(number, {Type,_}) + when Type =:= integer; Type =:= float -> + number; +join({integer,_}, {float,_}) -> + number; +join({float,_}, {integer,_}) -> + number; +join(bool, {atom,A}) -> + join_bool(A); +join({atom,A}, bool) -> + join_bool(A); +join({atom,A}, {atom,B}) when is_boolean(A), is_boolean(B) -> + bool; +join({atom,_}, {atom,_}) -> + {atom,[]}; +join(#ms{id=Id1,valid=B1,slots=Slots1}, + #ms{id=Id2,valid=B2,slots=Slots2}) -> + Id = if + Id1 =:= Id2 -> Id1; + true -> make_ref() + end, + #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)}; +join(T1, T2) when T1 =/= T2 -> + %% We've exhaused all other options, so the type must either be a list or + %% a 'term'. + join_list(T1, T2). + +join_tuple_elements(Limit, EsA, EsB) -> + Es0 = join_elements(EsA, EsB), + maps:filter(fun({integer,Index}, _Type) -> Index =< Limit end, Es0). + +join_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + join_elements_1(Keys, Es1, Es2, #{}). + +join_elements_1([Key | Keys], Es1, Es2, Acc0) -> + Type = case {Es1, Es2} of + {#{ Key := Same }, #{ Key := Same }} -> Same; + {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); + {#{}, #{}} -> term + end, + Acc = set_element_type(Key, Type, Acc0), + join_elements_1(Keys, Es1, Es2, Acc); +join_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% Joins types of literals; note that the left argument must either be a +%% literal or exactly equal to the second argument. +join_literal(Same, Same) -> + Same; +join_literal({literal,_}=Lit, T) -> + join_literal(T, get_literal_type(Lit)); +join_literal(T1, T2) -> + %% We're done extracting the types, try merging them again. + join(T1, T2). + +join_list(nil, cons) -> list; +join_list(nil, list) -> list; +join_list(cons, list) -> list; +join_list(T, nil) -> join_list(nil, T); +join_list(T, cons) -> join_list(cons, T); +join_list(_, _) -> + %% Not a list, so it must be a term. + term. + +join_bool([]) -> {atom,[]}; +join_bool(true) -> bool; +join_bool(false) -> bool; +join_bool(_) -> {atom,[]}. + +%% meet(Type1, Type2) -> Type +%% Return the meet of two types. The meet is a more specific type. +%% It will be 'none' if the types are in conflict. + +meet(Same, Same) -> + Same; +meet(term, Other) -> + Other; +meet(Other, term) -> + Other; +meet(#ms{}, binary) -> + #ms{}; +meet(binary, #ms{}) -> + #ms{}; +meet({literal,_}, {literal,_}) -> + none; +meet(T1, {literal,_}=T2) -> + meet(T2, T1); +meet({literal,_}=T1, T2) -> + case meet(get_literal_type(T1), T2) of + none -> none; + _ -> T1 + end; +meet(T1, T2) -> + case {erlang:min(T1, T2),erlang:max(T1, T2)} of + {{atom,_}=A,{atom,[]}} -> A; + {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; + {bool,{atom,[]}} -> bool; + {cons,list} -> cons; + {{float,_}=T,{float,[]}} -> T; + {{integer,_}=T,{integer,[]}} -> T; + {list,nil} -> nil; + {number,{integer,_}=T} -> T; + {number,{float,_}=T} -> T; + {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> + Es = meet_elements(Es1, Es2), + case {Size1,Size2,Es} of + {_, _, none} -> + none; + {[Sz1],[Sz2],_} -> + Sz = erlang:max(Sz1, Sz2), + assert_tuple_elements(Sz, Es), + {tuple,[Sz],Es}; + {Sz1,[Sz2],_} when Sz2 =< Sz1 -> + assert_tuple_elements(Sz1, Es), + {tuple,Sz1,Es}; + {Sz,Sz,_} -> + assert_tuple_elements(Sz, Es), + {tuple,Sz,Es}; + {_,_,_} -> + none + end; + {_,_} -> none end. +meet_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + meet_elements_1(Keys, Es1, Es2, #{}). + +meet_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + case meet(Type1, Type2) of + none -> none; + Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +meet_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% No tuple elements may have an index above the known size. +assert_tuple_elements(Limit, Es) -> + true = maps:fold(fun({integer,Index}, _T, true) -> + Index =< Limit + end, true, Es). %Assertion. + +%% subtract(Type1, Type2) -> Type +%% Subtract Type2 from Type2. Example: +%% subtract(list, nil) -> cons + +subtract(Same, Same) -> none; +subtract(list, nil) -> cons; +subtract(list, cons) -> nil; +subtract(number, {integer,[]}) -> {float,[]}; +subtract(number, {float,[]}) -> {integer,[]}; +subtract(bool, {atom,false}) -> {atom, true}; +subtract(bool, {atom,true}) -> {atom, false}; +subtract(Type, _) -> Type. + +assert_type(WantedType, Term, Vst) -> + Type = get_term_type(Term, Vst), + assert_type(WantedType, Type). + assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_}) -> ok; +assert_type(tuple, {tuple,_,_}) -> ok; assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz]}) +assert_type({tuple_element,I}, {tuple,[Sz],_}) when 1 =< I, I =< Sz -> ok; -assert_type({tuple_element,I}, {tuple,Sz}) +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) -> @@ -1354,141 +2196,300 @@ assert_type(cons, {literal,[_|_]}) -> assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). -%% upgrade_tuple_type(NewTupleType, OldType) -> TupleType. -%% upgrade_tuple_type/2 is used when linear code finds out more and -%% more information about a tuple type, so that the type gets more -%% specialized. If OldType is not a tuple type, the type information -%% is inconsistent, and we know that some instructions will never -%% be executed at run-time. - -upgrade_tuple_type(NewType, {fragile,OldType}) -> - make_fragile(upgrade_tuple_type_1(NewType, OldType)); -upgrade_tuple_type(NewType, OldType) -> - upgrade_tuple_type_1(NewType, OldType). - -upgrade_tuple_type_1({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz -> - %% The old type has a higher value for the least tuple size. - T; -upgrade_tuple_type_1({tuple,[Sz]}, {tuple,OldSz}=T) - when is_integer(Sz), is_integer(OldSz), Sz =< OldSz -> - %% The old size is exact, and the new size is smaller than the old size. - T; -upgrade_tuple_type_1({tuple,_}=T, _) -> - %% The new type information is exact or has a higher value for - %% the least tuple size. - %% Note that inconsistencies are also handled in this - %% clause, e.g. if the old type was an integer or a tuple accessed - %% outside its size; inconsistences will generally cause an exception - %% at run-time but are safe from our point of view. - T. +get_element_type(Key, Src, Vst) -> + get_element_type_1(Key, get_term_type(Src, Vst)). + +get_element_type_1({integer,_}=Key, {tuple,_Sz,Es}) -> + case Es of + #{ Key := Type } -> Type; + #{} -> term + end; +get_element_type_1(_Index, _Type) -> + term. + +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, term, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. get_tuple_size({integer,[]}) -> 0; get_tuple_size({integer,Sz}) -> Sz; get_tuple_size(_) -> 0. validate_src(Ss, Vst) when is_list(Ss) -> - foreach(fun(S) -> get_term_type(S, Vst) end, Ss). + _ = [assert_term(S, Vst) || S <- Ss], + ok. -%% get_move_term_type(Src, ValidatorState) -> Type +%% get_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be -%% a standard Erlang type (no catch/try tags). Match contexts are OK. +%% a standard Erlang type (no catch/try tags or match contexts). -get_move_term_type(Src, Vst) -> - case get_term_type_1(Src, Vst) of - initialized -> error({unassigned,Src}); - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); - tuple_in_progress -> error({tuple_in_progress,Src}); - Type -> Type +get_term_type(Src, Vst) -> + case get_movable_term_type(Src, Vst) of + #ms{} -> error({match_context,Src}); + Type -> Type end. -%% get_term_type(Src, ValidatorState) -> Type +%% get_movable_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be -%% a standard Erlang type (no catch/try tags or match contexts). +%% a standard Erlang type (no catch/try tags). Match contexts are OK. -get_term_type(Src, Vst) -> - case get_move_term_type(Src, Vst) of - #ms{} -> error({match_context,Src}); - Type -> Type +get_movable_term_type(Src, Vst) -> + case get_raw_type(Src, Vst) of + initialized -> error({unassigned,Src}); + uninitialized -> error({uninitialized_reg,Src}); + {catchtag,_} -> error({catchtag,Src}); + {trytag,_} -> error({trytag,Src}); + tuple_in_progress -> error({tuple_in_progress,Src}); + {literal,_}=Lit -> get_literal_type(Lit); + Type -> Type end. -%% get_special_y_type(Src, ValidatorState) -> Type -%% Return the type for the Y register without doing any validity checks. - -get_special_y_type({y,_}=Reg, Vst) -> get_term_type_1(Reg, Vst); -get_special_y_type(Src, _) -> error({source_not_y_reg,Src}). - -get_term_type_1(nil=T, _) -> T; -get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; -get_term_type_1({float,F}=T, _) when is_float(F) -> T; -get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; -get_term_type_1({literal,Map}, _) when is_map(Map) -> map; -get_term_type_1({literal,_}=T, _) -> T; -get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> - case gb_trees:lookup(X, Xs) of - {value,Type} -> Type; - none -> error({uninitialized_reg,Reg}) +%% get_tag_type(Src, ValidatorState) -> Type +%% Return the tag type of a Y register, erroring out if it contains a term. + +get_tag_type({y,_}=Src, Vst) -> + case get_raw_type(Src, Vst) of + {catchtag, _}=Tag -> Tag; + {trytag, _}=Tag -> Tag; + uninitialized=Tag -> Tag; + initialized=Tag -> Tag; + Other -> error({invalid_tag,Src,Other}) end; -get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> - case gb_trees:lookup(Y, Ys) of - none -> error({uninitialized_reg,Reg}); - {value,uninitialized} -> error({uninitialized_reg,Reg}); - {value,Type} -> Type +get_tag_type(Src, _) -> + error({invalid_tag_register,Src}). + +%% get_raw_type(Src, ValidatorState) -> Type +%% Return the type of a register without doing any validity checks or +%% conversions. +get_raw_type({x,X}=Src, #vst{current=#st{xs=Xs}}=Vst) when is_integer(X) -> + check_limit(Src), + case Xs of + #{ Src := #value_ref{}=Ref } -> get_raw_type(Ref, Vst); + #{} -> uninitialized end; -get_term_type_1(Src, _) -> error({bad_source,Src}). - +get_raw_type({y,Y}=Src, #vst{current=#st{ys=Ys}}=Vst) when is_integer(Y) -> + check_limit(Src), + case Ys of + #{ Src := #value_ref{}=Ref } -> get_raw_type(Ref, Vst); + #{ Src := Tag } -> Tag; + #{} -> uninitialized + end; +get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> + case Vs of + #{ Ref := #value{type=Type} } -> Type; + #{} -> none + end; +get_raw_type(Src, #vst{}) -> + get_literal_type(Src). + +is_value_alive(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> + is_map_key(Ref, Vs). + +get_literal_type(nil=T) -> T; +get_literal_type({atom,A}=T) when is_atom(A) -> T; +get_literal_type({float,F}=T) when is_float(F) -> T; +get_literal_type({integer,I}=T) when is_integer(I) -> T; +get_literal_type({literal,[_|_]}) -> cons; +get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary; +get_literal_type({literal,Map}) when is_map(Map) -> map; +get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> glt_1(Tuple); +get_literal_type({literal,_}) -> term; +get_literal_type(T) -> error({not_literal,T}). + +glt_1([]) -> nil; +glt_1(A) when is_atom(A) -> {atom, A}; +glt_1(F) when is_float(F) -> {float, F}; +glt_1(I) when is_integer(I) -> {integer, I}; +glt_1(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = glt_1(Val), + Es = set_element_type({integer,Index}, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + {tuple, tuple_size(T), Es}; +glt_1(L) -> + {literal, L}. -%% get_literal(Src) -> literal_value(). -get_literal(nil) -> []; -get_literal({atom,A}) when is_atom(A) -> A; -get_literal({float,F}) when is_float(F) -> F; -get_literal({integer,I}) when is_integer(I) -> I; -get_literal({literal,L}) -> L; -get_literal(T) -> error({not_literal,T}). +%%% +%%% Branch tracking +%%% +%% Forks the execution flow, with the provided funs returning the new state of +%% their respective branch; the "fail" fun returns the state where the branch +%% is taken, and the "success" fun returns the state where it's not. +%% +%% If either path is known not to be taken at runtime (eg. due to a type +%% conflict), it will simply be discarded. +-spec branch(Lbl :: label(), + Original :: #vst{}, + FailFun :: BranchFun, + SuccFun :: BranchFun) -> #vst{} when + BranchFun :: fun((#vst{}) -> #vst{}). +branch(Lbl, Vst0, FailFun, SuccFun) -> + #vst{current=St0} = Vst0, + try FailFun(Vst0) of + Vst1 -> + Vst2 = branch_state(Lbl, Vst1), + Vst = Vst2#vst{current=St0}, + try SuccFun(Vst) of + V -> V + catch + {type_conflict, _, _} -> + %% The instruction is guaranteed to fail; kill the state. + kill_state(Vst) + end + catch + {type_conflict, _, _} -> + %% This instruction is guaranteed not to fail, so we run the + %% success branch *without* catching type conflicts to avoid hiding + %% errors in the validator itself; one of the branches must + %% succeed. + SuccFun(Vst0) + end. -branch_arities([], _, #vst{}=Vst) -> Vst; -branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) - when is_integer(Sz) -> - Vst1 = set_type_reg({tuple,Sz}, Tuple, Vst0), - Vst = branch_state(L, Vst1), - branch_arities(T, Tuple, Vst#vst{current=St}). +%% A shorthand version of branch/4 for when the state is only altered on +%% success. +branch(Fail, Vst, SuccFun) -> + branch(Fail, Vst, fun(V) -> V end, SuccFun). +%% Directly branches off the state. This is an "internal" operation that should +%% be used sparingly. branch_state(0, #vst{}=Vst) -> - %% If the instruction fails, the stack may be scanned - %% looking for a catch tag. Therefore the Y registers - %% must be initialized at this point. + %% If the instruction fails, the stack may be scanned looking for a catch + %% tag. Therefore the Y registers must be initialized at this point. verify_y_init(Vst), Vst; -branch_state(L, #vst{current=St,branched=B}=Vst) -> - Vst#vst{ - branched=case gb_trees:is_defined(L, B) of - false -> - gb_trees:insert(L, St, B); - true -> - MergedSt = merge_states(L, St, B), - gb_trees:update(L, MergedSt, B) - end}. - -%% merge_states/3 is used when there are more than one way to arrive -%% at this point, and the type states for the different paths has -%% to be merged. The type states are downgraded to the least common -%% subset for the subsequent code. - -merge_states(L, St, Branched) when L =/= 0 -> +branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> + case gb_trees:is_defined(L, B) of + true -> + {MergedSt, Counter} = merge_states(L, St, B, Counter0), + Branched = gb_trees:update(L, MergedSt, B), + Vst#vst{branched=Branched,ref_ctr=Counter}; + false -> + Vst#vst{branched=gb_trees:insert(L, St, B)} + end. + +%% merge_states/3 is used when there's more than one way to arrive at a +%% certain point, requiring the states to be merged down to the least +%% common subset for the subsequent code. + +merge_states(L, St, Branched, Counter) when L =/= 0 -> case gb_trees:lookup(L, Branched) of - none -> St; - {value,OtherSt} when St =:= none -> OtherSt; - {value,OtherSt} -> merge_states_1(St, OtherSt) + none -> + {St, Counter}; + {value,OtherSt} when St =:= none -> + {OtherSt, Counter}; + {value,OtherSt} -> + merge_states_1(St, OtherSt, Counter) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}, - #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> - NumY = merge_stk(NumY0, NumY1), - Xs = merge_regs(Xs0, Xs1), - Ys = merge_y_regs(Ys0, Ys1), - Ct = merge_ct(Ct0, Ct1), - #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. +merge_states_1(#st{xs=XsA,ys=YsA,vs=VsA,fragile=FragA,numy=NumYA,h=HA,ct=CtA}, + #st{xs=XsB,ys=YsB,vs=VsB,fragile=FragB,numy=NumYB,h=HB,ct=CtB}, + Counter0) -> + %% When merging registers we drop all registers that aren't defined in both + %% states, and resolve conflicts by creating new values (similar to phi + %% nodes in SSA). + %% + %% While doing this we build a "merge map" detailing which values need to + %% be kept and which new values need to be created to resolve conflicts. + %% This map is then used to create a new value database where the types of + %% all values have been joined. + {Xs, Merge0, Counter1} = merge_regs(XsA, XsB, #{}, Counter0), + {Ys, Merge, Counter} = merge_regs(YsA, YsB, Merge0, Counter1), + Vs = merge_values(Merge, VsA, VsB), + + Fragile = merge_fragility(FragA, FragB), + NumY = merge_stk(NumYA, NumYB), + Ct = merge_ct(CtA, CtB), + + St = #st{xs=Xs,ys=Ys,vs=Vs,fragile=Fragile,numy=NumY,h=min(HA, HB),ct=Ct}, + {St, Counter}. + +%% Merges the contents of two register maps, returning the updated "merge map" +%% and the new registers. +merge_regs(RsA, RsB, Merge, Counter) -> + Keys = if + map_size(RsA) =< map_size(RsB) -> maps:keys(RsA); + map_size(RsA) > map_size(RsB) -> maps:keys(RsB) + end, + merge_regs_1(Keys, RsA, RsB, #{}, Merge, Counter). + +merge_regs_1([Reg | Keys], RsA, RsB, Regs, Merge0, Counter0) -> + case {RsA, RsB} of + {#{ Reg := #value_ref{}=RefA }, #{ Reg := #value_ref{}=RefB }} -> + {Ref, Merge, Counter} = merge_vrefs(RefA, RefB, Merge0, Counter0), + merge_regs_1(Keys, RsA, RsB, Regs#{ Reg => Ref }, Merge, Counter); + {#{ Reg := TagA }, #{ Reg := TagB }} -> + %% Tags describe the state of the register rather than the value it + %% contains, so if a register contains a tag in one state we have + %% to merge it as a tag regardless of whether the other state says + %% it's a value. + {y, _} = Reg, %Assertion. + merge_regs_1(Keys, RsA, RsB, Regs#{ Reg => merge_tags(TagA,TagB) }, + Merge0, Counter0); + {#{}, #{}} -> + merge_regs_1(Keys, RsA, RsB, Regs, Merge0, Counter0) + end; +merge_regs_1([], _, _, Regs, Merge, Counter) -> + {Regs, Merge, Counter}. + +merge_tags(Same, Same) -> + Same; +merge_tags(uninitialized, _) -> + uninitialized; +merge_tags(_, uninitialized) -> + uninitialized; +merge_tags({catchtag,T0}, {catchtag,T1}) -> + {catchtag, ordsets:from_list(T0 ++ T1)}; +merge_tags({trytag,T0}, {trytag,T1}) -> + {trytag, ordsets:from_list(T0 ++ T1)}; +merge_tags(_A, _B) -> + %% All other combinations leave the register initialized. Errors arising + %% from this will be caught later on. + initialized. + +merge_vrefs(Ref, Ref, Merge, Counter) -> + %% We have two (potentially) different versions of the same value, so we + %% should join their types into the same value. + {Ref, Merge#{ Ref => Ref }, Counter}; +merge_vrefs(RefA, RefB, Merge, Counter) -> + %% We have two different values, so we need to create a new value from + %% their joined type if we haven't already done so. + Key = {RefA, RefB}, + case Merge of + #{ Key := Ref } -> + {Ref, Merge, Counter}; + #{} -> + Ref = #value_ref{id=Counter}, + {Ref, Merge#{ Key => Ref }, Counter + 1} + end. + +merge_values(Merge, VsA, VsB) -> + maps:fold(fun(Spec, New, Acc) -> + merge_values_1(Spec, New, VsA, VsB, Acc) + end, #{}, Merge). + +merge_values_1(Same, Same, VsA, VsB, Acc) -> + %% We're merging different versions of the same value, so it's safe to + %% reuse old entries if the type's unchanged. + #value{type=TypeA}=EntryA = map_get(Same, VsA), + #value{type=TypeB}=EntryB = map_get(Same, VsB), + Entry = case join(TypeA, TypeB) of + TypeA -> EntryA; + TypeB -> EntryB; + JoinedType -> EntryA#value{type=JoinedType} + end, + Acc#{ Same => Entry }; +merge_values_1({RefA, RefB}, New, VsA, VsB, Acc) -> + #value{type=TypeA} = map_get(RefA, VsA), + #value{type=TypeB} = map_get(RefB, VsB), + Acc#{ New => #value{op=join,args=[],type=join(TypeA, TypeB)} }. + +merge_fragility(FragileA, FragileB) -> + cerl_sets:union(FragileA, FragileB). merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1501,135 +2502,70 @@ merge_ct_1([C0|Ct0], [C1|Ct1]) -> merge_ct_1([], []) -> []; merge_ct_1(_, _) -> undecided. -merge_regs(Rs0, Rs1) -> - Rs = merge_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)), - gb_trees_from_list(Rs). - -merge_regs_1([Same|Rs1], [Same|Rs2]) -> - [Same|merge_regs_1(Rs1, Rs2)]; -merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> - merge_regs_1(Rs1, Rs2); -merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> - merge_regs_1(Rs1, Rs2); -merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_regs_1(Rs1, Rs2)]; -merge_regs_1([], []) -> []; -merge_regs_1([], [_|_]) -> []; -merge_regs_1([_|_], []) -> []. - -merge_y_regs(Rs0, Rs1) -> - case {gb_trees:size(Rs0),gb_trees:size(Rs1)} of - {Sz0,Sz1} when Sz0 < Sz1 -> - merge_y_regs_1(Sz0-1, Rs1, Rs0); - {_,Sz1} -> - merge_y_regs_1(Sz1-1, Rs0, Rs1) - end. +tuple_sz([Sz]) -> Sz; +tuple_sz(Sz) -> Sz. -merge_y_regs_1(Y, S, Regs0) when Y >= 0 -> - Type0 = gb_trees:get(Y, Regs0), - case gb_trees:get(Y, S) of - Type0 -> - merge_y_regs_1(Y-1, S, Regs0); - Type1 -> - Type = merge_types(Type0, Type1), - Regs = gb_trees:update(Y, Type, Regs0), - merge_y_regs_1(Y-1, S, Regs) - end; -merge_y_regs_1(_, _, Regs) -> Regs. +verify_y_init(#vst{current=#st{numy=NumY,ys=Ys}}=Vst) when is_integer(NumY) -> + HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), + true = NumY > HighestY, %Assertion. + verify_y_init_1(NumY - 1, Vst), + ok; +verify_y_init(#vst{current=#st{numy=undecided,ys=Ys}}=Vst) -> + HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), + verify_y_init_1(HighestY, Vst); +verify_y_init(#vst{}) -> + ok. -%% merge_types(Type1, Type2) -> Type -%% Return the most specific type possible. -%% Note: Type1 must NOT be the same as Type2. -merge_types({fragile,Same}=Type, Same) -> - Type; -merge_types({fragile,T1}, T2) -> - make_fragile(merge_types(T1, T2)); -merge_types(Same, {fragile,Same}=Type) -> - Type; -merge_types(T1, {fragile,T2}) -> - make_fragile(merge_types(T1, T2)); -merge_types(uninitialized=I, _) -> I; -merge_types(_, uninitialized=I) -> I; -merge_types(initialized=I, _) -> I; -merge_types(_, initialized=I) -> I; -merge_types({catchtag,T0},{catchtag,T1}) -> - {catchtag,ordsets:from_list(T0++T1)}; -merge_types({trytag,T0},{trytag,T1}) -> - {trytag,ordsets:from_list(T0++T1)}; -merge_types({tuple,A}, {tuple,B}) -> - {tuple,[min(tuple_sz(A), tuple_sz(B))]}; -merge_types({Type,A}, {Type,B}) - when Type =:= atom; Type =:= integer; Type =:= float -> - if A =:= B -> {Type,A}; - true -> {Type,[]} - end; -merge_types({Type,_}, number) - when Type =:= integer; Type =:= float -> - number; -merge_types(number, {Type,_}) - when Type =:= integer; Type =:= float -> - number; -merge_types(bool, {atom,A}) -> - merge_bool(A); -merge_types({atom,A}, bool) -> - merge_bool(A); -merge_types(#ms{id=Id1,valid=B1,slots=Slots1}, - #ms{id=Id2,valid=B2,slots=Slots2}) -> - Id = if - Id1 =:= Id2 -> Id1; - true -> make_ref() - end, - #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)}; -merge_types(T1, T2) when T1 =/= T2 -> - %% Too different. All we know is that the type is a 'term'. - term. +verify_y_init_1(-1, _Vst) -> + ok; +verify_y_init_1(Y, Vst) -> + Reg = {y, Y}, + assert_not_fragile(Reg, Vst), + case get_raw_type(Reg, Vst) of + uninitialized -> error({uninitialized_reg,Reg}); + _ -> verify_y_init_1(Y - 1, Vst) + end. -tuple_sz([Sz]) -> Sz; -tuple_sz(Sz) -> Sz. +verify_live(0, _Vst) -> + ok; +verify_live(Live, Vst) when is_integer(Live), 0 < Live, Live =< 1023 -> + verify_live_1(Live - 1, Vst); +verify_live(Live, _Vst) -> + error({bad_number_of_live_regs,Live}). -merge_bool([]) -> {atom,[]}; -merge_bool(true) -> bool; -merge_bool(false) -> bool; -merge_bool(_) -> {atom,[]}. - -verify_y_init(#vst{current=#st{y=Ys}}) -> - verify_y_init_1(gb_trees:to_list(Ys)). - -verify_y_init_1([]) -> ok; -verify_y_init_1([{Y,uninitialized}|_]) -> - error({uninitialized_reg,{y,Y}}); -verify_y_init_1([{Y,{fragile,_}}|_]) -> - %% Unsafe. This term may be outside any heap belonging - %% to the process and would be corrupted by a GC. - error({fragile_message_reference,{y,Y}}); -verify_y_init_1([{_,_}|Ys]) -> - verify_y_init_1(Ys). - -verify_live(0, #vst{}) -> ok; -verify_live(N, #vst{current=#st{x=Xs}}) -> - verify_live_1(N, Xs). - -verify_live_1(0, _) -> ok; -verify_live_1(N, Xs) when is_integer(N) -> - X = N-1, - case gb_trees:is_defined(X, Xs) of - false -> error({{x,X},not_live}); - true -> verify_live_1(X, Xs) - end; -verify_live_1(N, _) -> error({bad_number_of_live_regs,N}). +verify_live_1(-1, _) -> + ok; +verify_live_1(X, Vst) when is_integer(X) -> + Reg = {x, X}, + case get_raw_type(Reg, Vst) of + uninitialized -> error({Reg, not_live}); + _ -> verify_live_1(X - 1, Vst) + end. -verify_no_ct(#vst{current=#st{numy=none}}) -> ok; +verify_no_ct(#vst{current=#st{numy=none}}) -> + ok; verify_no_ct(#vst{current=#st{numy=undecided}}) -> error(unknown_size_of_stackframe); -verify_no_ct(#vst{current=#st{y=Ys}}) -> - case [Y || Y <- gb_trees:to_list(Ys), verify_no_ct_1(Y)] of - [] -> ok; - CT -> error({unfinished_catch_try,CT}) +verify_no_ct(#vst{current=St}=Vst) -> + case collect_try_catch_tags(St#st.numy - 1, Vst, []) of + [_|_]=Bad -> error({unfinished_catch_try,Bad}); + [] -> ok end. -verify_no_ct_1({_, {catchtag, _}}) -> true; -verify_no_ct_1({_, {trytag, _}}) -> true; -verify_no_ct_1({_, _}) -> false. +%% Collects all try/catch tags, walking down from the Nth stack position. +collect_try_catch_tags(-1, _Vst, Acc) -> + Acc; +collect_try_catch_tags(Y, Vst, Acc0) -> + Tag = get_raw_type({y, Y}, Vst), + Acc = case is_try_catch_tag(Tag) of + true -> [{{y, Y}, Tag} | Acc0]; + false -> Acc0 + end, + collect_try_catch_tags(Y - 1, Vst, Acc). + +is_try_catch_tag({catchtag,_}) -> true; +is_try_catch_tag({trytag,_}) -> true; +is_try_catch_tag(_) -> false. eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) -> case Heap0-N of @@ -1647,89 +2583,190 @@ eat_heap_float(#vst{current=#st{hf=HeapFloats0}=St}=Vst) -> Vst#vst{current=St#st{hf=HeapFloats}} end. -remove_fragility(#vst{current=#st{x=Xs0,y=Ys0}=St0}=Vst) -> - F = fun(_, {fragile,Type}) -> Type; - (_, Type) -> Type - end, - Xs = gb_trees:map(F, Xs0), - Ys = gb_trees:map(F, Ys0), - St = St0#st{x=Xs,y=Ys}, +%%% FRAGILITY +%%% +%%% The loop_rec/2 instruction may return a reference to a term that is not +%%% part of the root set. That term or any part of it must not be included in a +%%% garbage collection. Therefore, the term (or any part of it) must not be +%%% passed to another function, placed in another term, or live in a Y register +%%% over an instruction that may GC. +%%% +%%% Fragility is marked on a per-register (rather than per-value) basis. + +%% Marks Reg as fragile. +mark_fragile(Reg, Vst) -> + #vst{current=#st{fragile=Fragile0}=St0} = Vst, + Fragile = cerl_sets:add_element(Reg, Fragile0), + St = St0#st{fragile=Fragile}, Vst#vst{current=St}. -propagate_fragility(Type, Ss, Vst) -> - F = fun(S) -> - case get_term_type_1(S, Vst) of - {fragile,_} -> true; - _ -> false - end - end, - case any(F, Ss) of - true -> make_fragile(Type); - false -> Type +propagate_fragility(Reg, Args, #vst{current=St0}=Vst) -> + #st{fragile=Fragile0} = St0, + + Sources = cerl_sets:from_list(Args), + Fragile = case cerl_sets:is_disjoint(Sources, Fragile0) of + true -> cerl_sets:del_element(Reg, Fragile0); + false -> cerl_sets:add_element(Reg, Fragile0) + end, + + St = St0#st{fragile=Fragile}, + Vst#vst{current=St}. + +%% Marks Reg as durable, must be used when assigning a newly created value to +%% a register. +remove_fragility(Reg, Vst) -> + #vst{current=#st{fragile=Fragile0}=St0} = Vst, + case cerl_sets:is_element(Reg, Fragile0) of + true -> + Fragile = cerl_sets:del_element(Reg, Fragile0), + St = St0#st{fragile=Fragile}, + Vst#vst{current=St}; + false -> + Vst end. -bif_type('-', Src, Vst) -> - arith_type(Src, Vst); -bif_type('+', Src, Vst) -> - arith_type(Src, Vst); -bif_type('*', Src, Vst) -> - arith_type(Src, Vst); -bif_type(abs, [Num], Vst) -> +%% Marks all registers as durable. +remove_fragility(#vst{current=St0}=Vst) -> + St = St0#st{fragile=cerl_sets:new()}, + Vst#vst{current=St}. + +assert_durable_term(Src, Vst) -> + assert_term(Src, Vst), + assert_not_fragile(Src, Vst). + +assert_not_fragile({Kind,_}=Src, Vst) when Kind =:= x; Kind =:= y -> + check_limit(Src), + #vst{current=#st{fragile=Fragile}} = Vst, + case cerl_sets:is_element(Src, Fragile) of + true -> error({fragile_message_reference, Src}); + false -> ok + end; +assert_not_fragile(Lit, #vst{}) -> + assert_literal(Lit), + ok. + +%%% +%%% Return/argument types of BIFs +%%% + +bif_return_type('-', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('+', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('*', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type(abs, [Num], Vst) -> case get_term_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number + {float,_}=T -> T; + {integer,_}=T -> T; + _ -> number end; -bif_type(float, _, _) -> {float,[]}; -bif_type('/', _, _) -> {float,[]}; +bif_return_type(float, _, _) -> {float,[]}; +bif_return_type('/', _, _) -> {float,[]}; +%% Binary operations +bif_return_type('binary_part', [_,_], _) -> binary; +bif_return_type('binary_part', [_,_,_], _) -> binary; +bif_return_type('bit_size', [_], _) -> {integer,[]}; +bif_return_type('byte_size', [_], _) -> {integer,[]}; %% Integer operations. -bif_type(ceil, [_], _) -> {integer,[]}; -bif_type('div', [_,_], _) -> {integer,[]}; -bif_type(floor, [_], _) -> {integer,[]}; -bif_type('rem', [_,_], _) -> {integer,[]}; -bif_type(length, [_], _) -> {integer,[]}; -bif_type(size, [_], _) -> {integer,[]}; -bif_type(trunc, [_], _) -> {integer,[]}; -bif_type(round, [_], _) -> {integer,[]}; -bif_type('band', [_,_], _) -> {integer,[]}; -bif_type('bor', [_,_], _) -> {integer,[]}; -bif_type('bxor', [_,_], _) -> {integer,[]}; -bif_type('bnot', [_], _) -> {integer,[]}; -bif_type('bsl', [_,_], _) -> {integer,[]}; -bif_type('bsr', [_,_], _) -> {integer,[]}; +bif_return_type(ceil, [_], _) -> {integer,[]}; +bif_return_type('div', [_,_], _) -> {integer,[]}; +bif_return_type(floor, [_], _) -> {integer,[]}; +bif_return_type('rem', [_,_], _) -> {integer,[]}; +bif_return_type(length, [_], _) -> {integer,[]}; +bif_return_type(size, [_], _) -> {integer,[]}; +bif_return_type(trunc, [_], _) -> {integer,[]}; +bif_return_type(round, [_], _) -> {integer,[]}; +bif_return_type('band', [_,_], _) -> {integer,[]}; +bif_return_type('bor', [_,_], _) -> {integer,[]}; +bif_return_type('bxor', [_,_], _) -> {integer,[]}; +bif_return_type('bnot', [_], _) -> {integer,[]}; +bif_return_type('bsl', [_,_], _) -> {integer,[]}; +bif_return_type('bsr', [_,_], _) -> {integer,[]}; %% Booleans. -bif_type('==', [_,_], _) -> bool; -bif_type('/=', [_,_], _) -> bool; -bif_type('=<', [_,_], _) -> bool; -bif_type('<', [_,_], _) -> bool; -bif_type('>=', [_,_], _) -> bool; -bif_type('>', [_,_], _) -> bool; -bif_type('=:=', [_,_], _) -> bool; -bif_type('=/=', [_,_], _) -> bool; -bif_type('not', [_], _) -> bool; -bif_type('and', [_,_], _) -> bool; -bif_type('or', [_,_], _) -> bool; -bif_type('xor', [_,_], _) -> bool; -bif_type(is_atom, [_], _) -> bool; -bif_type(is_boolean, [_], _) -> bool; -bif_type(is_binary, [_], _) -> bool; -bif_type(is_float, [_], _) -> bool; -bif_type(is_function, [_], _) -> bool; -bif_type(is_integer, [_], _) -> bool; -bif_type(is_list, [_], _) -> bool; -bif_type(is_map, [_], _) -> bool; -bif_type(is_number, [_], _) -> bool; -bif_type(is_pid, [_], _) -> bool; -bif_type(is_port, [_], _) -> bool; -bif_type(is_reference, [_], _) -> bool; -bif_type(is_tuple, [_], _) -> bool; +bif_return_type('==', [_,_], _) -> bool; +bif_return_type('/=', [_,_], _) -> bool; +bif_return_type('=<', [_,_], _) -> bool; +bif_return_type('<', [_,_], _) -> bool; +bif_return_type('>=', [_,_], _) -> bool; +bif_return_type('>', [_,_], _) -> bool; +bif_return_type('=:=', [_,_], _) -> bool; +bif_return_type('=/=', [_,_], _) -> bool; +bif_return_type('not', [_], _) -> bool; +bif_return_type('and', [_,_], _) -> bool; +bif_return_type('or', [_,_], _) -> bool; +bif_return_type('xor', [_,_], _) -> bool; +bif_return_type(is_atom, [_], _) -> bool; +bif_return_type(is_boolean, [_], _) -> bool; +bif_return_type(is_binary, [_], _) -> bool; +bif_return_type(is_float, [_], _) -> bool; +bif_return_type(is_function, [_], _) -> bool; +bif_return_type(is_function, [_,_], _) -> bool; +bif_return_type(is_integer, [_], _) -> bool; +bif_return_type(is_list, [_], _) -> bool; +bif_return_type(is_map, [_], _) -> bool; +bif_return_type(is_number, [_], _) -> bool; +bif_return_type(is_pid, [_], _) -> bool; +bif_return_type(is_port, [_], _) -> bool; +bif_return_type(is_reference, [_], _) -> bool; +bif_return_type(is_tuple, [_], _) -> bool; %% Misc. -bif_type(node, [], _) -> {atom,[]}; -bif_type(node, [_], _) -> {atom,[]}; -bif_type(hd, [_], _) -> term; -bif_type(tl, [_], _) -> term; -bif_type(get, [_], _) -> term; -bif_type(Bif, _, _) when is_atom(Bif) -> term. +bif_return_type(tuple_size, [_], _) -> {integer,[]}; +bif_return_type(map_size, [_], _) -> {integer,[]}; +bif_return_type(node, [], _) -> {atom,[]}; +bif_return_type(node, [_], _) -> {atom,[]}; +bif_return_type(hd, [_], _) -> term; +bif_return_type(tl, [_], _) -> term; +bif_return_type(get, [_], _) -> term; +bif_return_type(Bif, _, _) when is_atom(Bif) -> term. + +%% Generic +bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; +bif_arg_types(map_size, [_]) -> [map]; +bif_arg_types(is_map_key, [_,_]) -> [term, map]; +bif_arg_types(map_get, [_,_]) -> [term, map]; +bif_arg_types(length, [_]) -> [list]; +bif_arg_types(hd, [_]) -> [cons]; +bif_arg_types(tl, [_]) -> [cons]; +%% Boolean +bif_arg_types('not', [_]) -> [bool]; +bif_arg_types('and', [_,_]) -> [bool, bool]; +bif_arg_types('or', [_,_]) -> [bool, bool]; +bif_arg_types('xor', [_,_]) -> [bool, bool]; +%% Binary +bif_arg_types('binary_part', [_,_]) -> + PosLen = {tuple, 2, #{ {integer,1} => {integer,[]}, + {integer,2} => {integer,[]} }}, + [binary, PosLen]; +bif_arg_types('binary_part', [_,_,_]) -> + [binary, {integer,[]}, {integer,[]}]; +bif_arg_types('bit_size', [_]) -> [binary]; +bif_arg_types('byte_size', [_]) -> [binary]; +%% Numerical +bif_arg_types('-', [_]) -> [number]; +bif_arg_types('-', [_,_]) -> [number,number]; +bif_arg_types('+', [_]) -> [number]; +bif_arg_types('+', [_,_]) -> [number,number]; +bif_arg_types('*', [_,_]) -> [number, number]; +bif_arg_types('/', [_,_]) -> [number, number]; +bif_arg_types(abs, [_]) -> [number]; +bif_arg_types(ceil, [_]) -> [number]; +bif_arg_types(float, [_]) -> [number]; +bif_arg_types(floor, [_]) -> [number]; +bif_arg_types(trunc, [_]) -> [number]; +bif_arg_types(round, [_]) -> [number]; +%% Integer-specific +bif_arg_types('div', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('rem', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('band', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bor', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bxor', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bnot', [_]) -> [{integer,[]}]; +bif_arg_types('bsl', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}]; +%% Unsafe type tests that may fail if an argument doesn't have the right type. +bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}]; +bif_arg_types(_, Args) -> [term || _Arg <- Args]. is_bif_safe('/=', 2) -> true; is_bif_safe('<', 2) -> true; @@ -1758,86 +2795,190 @@ is_bif_safe(self, 0) -> true; is_bif_safe(node, 0) -> true; is_bif_safe(_, _) -> false. -arith_type([A,B], Vst) -> - case {get_term_type(A, Vst),get_term_type(B, Vst)} of +arith_return_type([A], Vst) -> + %% Unary '+' or '-'. + case get_term_type(A, Vst) of + {integer,_} -> {integer,[]}; + {float,_} -> {float,[]}; + _ -> number + end; +arith_return_type([A,B], Vst) -> + TypeA = get_term_type(A, Vst), + TypeB = get_term_type(B, Vst), + case {TypeA, TypeB} of + {{integer,_},{integer,_}} -> {integer,[]}; {{float,_},_} -> {float,[]}; {_,{float,_}} -> {float,[]}; {_,_} -> number end; -arith_type(_, _) -> number. +arith_return_type(_, _) -> number. + +%%% +%%% Return/argument types of calls +%%% -return_type({extfunc,M,F,A}, Vst) -> return_type_1(M, F, A, Vst); -return_type(_, _) -> term. +call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); +call_return_type(_, _) -> term. -return_type_1(erlang, setelement, 3, Vst) -> - Tuple = {x,1}, +call_return_type_1(erlang, setelement, 3, Vst) -> + IndexType = get_term_type({x,0}, Vst), TupleType = - case get_term_type(Tuple, Vst) of - {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; - {integer,I} -> upgrade_tuple_type({tuple,[I]}, TupleType); - _ -> TupleType + case get_term_type({x,1}, Vst) of + {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit); + {tuple,_,_}=TT -> TT; + _ -> {tuple,[0],#{}} + end, + case IndexType of + {integer,I} when is_integer(I) -> + case meet({tuple,[I],#{}}, TupleType) of + {tuple, Sz, Es0} -> + ValueType = get_term_type({x,2}, Vst), + Es = set_element_type({integer,I}, ValueType, Es0), + {tuple, Sz, Es}; + none -> + TupleType + end; + _ -> + %% The index could point anywhere, so we must discard all element + %% information. + setelement(3, TupleType, #{}) end; -return_type_1(erlang, F, A, _) -> - return_type_erl(F, A); -return_type_1(math, F, A, _) -> - return_type_math(F, A); -return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> +call_return_type_1(erlang, '++', 2, Vst) -> + case get_term_type({x,0}, Vst) =:= cons orelse + get_term_type({x,1}, Vst) =:= cons of + true -> cons; + false -> list + end; +call_return_type_1(erlang, '--', 2, _Vst) -> + list; +call_return_type_1(erlang, F, A, _) -> + erlang_mod_return_type(F, A); +call_return_type_1(lists, F, A, Vst) -> + lists_mod_return_type(F, A, Vst); +call_return_type_1(math, F, A, _) -> + math_mod_return_type(F, A); +call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> term. -return_type_erl(exit, 1) -> exception; -return_type_erl(throw, 1) -> exception; -return_type_erl(error, 1) -> exception; -return_type_erl(error, 2) -> exception; -return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -return_type_math(cos, 1) -> {float,[]}; -return_type_math(cosh, 1) -> {float,[]}; -return_type_math(sin, 1) -> {float,[]}; -return_type_math(sinh, 1) -> {float,[]}; -return_type_math(tan, 1) -> {float,[]}; -return_type_math(tanh, 1) -> {float,[]}; -return_type_math(acos, 1) -> {float,[]}; -return_type_math(acosh, 1) -> {float,[]}; -return_type_math(asin, 1) -> {float,[]}; -return_type_math(asinh, 1) -> {float,[]}; -return_type_math(atan, 1) -> {float,[]}; -return_type_math(atanh, 1) -> {float,[]}; -return_type_math(erf, 1) -> {float,[]}; -return_type_math(erfc, 1) -> {float,[]}; -return_type_math(exp, 1) -> {float,[]}; -return_type_math(log, 1) -> {float,[]}; -return_type_math(log2, 1) -> {float,[]}; -return_type_math(log10, 1) -> {float,[]}; -return_type_math(sqrt, 1) -> {float,[]}; -return_type_math(atan2, 2) -> {float,[]}; -return_type_math(pow, 2) -> {float,[]}; -return_type_math(ceil, 1) -> {float,[]}; -return_type_math(floor, 1) -> {float,[]}; -return_type_math(fmod, 2) -> {float,[]}; -return_type_math(pi, 0) -> {float,[]}; -return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -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). +erlang_mod_return_type(exit, 1) -> exception; +erlang_mod_return_type(throw, 1) -> exception; +erlang_mod_return_type(error, 1) -> exception; +erlang_mod_return_type(error, 2) -> exception; +erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +math_mod_return_type(cos, 1) -> {float,[]}; +math_mod_return_type(cosh, 1) -> {float,[]}; +math_mod_return_type(sin, 1) -> {float,[]}; +math_mod_return_type(sinh, 1) -> {float,[]}; +math_mod_return_type(tan, 1) -> {float,[]}; +math_mod_return_type(tanh, 1) -> {float,[]}; +math_mod_return_type(acos, 1) -> {float,[]}; +math_mod_return_type(acosh, 1) -> {float,[]}; +math_mod_return_type(asin, 1) -> {float,[]}; +math_mod_return_type(asinh, 1) -> {float,[]}; +math_mod_return_type(atan, 1) -> {float,[]}; +math_mod_return_type(atanh, 1) -> {float,[]}; +math_mod_return_type(erf, 1) -> {float,[]}; +math_mod_return_type(erfc, 1) -> {float,[]}; +math_mod_return_type(exp, 1) -> {float,[]}; +math_mod_return_type(log, 1) -> {float,[]}; +math_mod_return_type(log2, 1) -> {float,[]}; +math_mod_return_type(log10, 1) -> {float,[]}; +math_mod_return_type(sqrt, 1) -> {float,[]}; +math_mod_return_type(atan2, 2) -> {float,[]}; +math_mod_return_type(pow, 2) -> {float,[]}; +math_mod_return_type(ceil, 1) -> {float,[]}; +math_mod_return_type(floor, 1) -> {float,[]}; +math_mod_return_type(fmod, 2) -> {float,[]}; +math_mod_return_type(pi, 0) -> {float,[]}; +math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +lists_mod_return_type(all, 2, _Vst) -> + bool; +lists_mod_return_type(any, 2, _Vst) -> + bool; +lists_mod_return_type(keymember, 3, _Vst) -> + bool; +lists_mod_return_type(member, 2, _Vst) -> + bool; +lists_mod_return_type(prefix, 2, _Vst) -> + bool; +lists_mod_return_type(suffix, 2, _Vst) -> + bool; +lists_mod_return_type(dropwhile, 2, _Vst) -> + list; +lists_mod_return_type(duplicate, 2, _Vst) -> + list; +lists_mod_return_type(filter, 2, _Vst) -> + list; +lists_mod_return_type(flatten, 1, _Vst) -> + list; +lists_mod_return_type(map, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> + ListType = same_length_type({x,2}, Vst), + {tuple,2,#{ {integer,1} => ListType} }; +lists_mod_return_type(partition, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(reverse, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(seq, 2, _Vst) -> + list; +lists_mod_return_type(sort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(sort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(splitwith, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(takewhile, 2, _Vst) -> + list; +lists_mod_return_type(unzip, 1, Vst) -> + ListType = same_length_type({x,0}, Vst), + two_tuple(ListType, ListType); +lists_mod_return_type(usort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(zip, 2, _Vst) -> + list; +lists_mod_return_type(zipwith, 3, _Vst) -> + list; +lists_mod_return_type(_, _, _) -> + term. + +two_tuple(Type1, Type2) -> + {tuple,2,#{ {integer,1} => Type1, + {integer,2} => Type2 }}. + +same_length_type(Reg, Vst) -> + case get_term_type(Reg, Vst) of + {literal,[_|_]} -> cons; + cons -> cons; + nil -> nil; + _ -> list + end. + +check_limit({x,X}=Src) when is_integer(X) -> + if + %% Note: x(1023) is reserved for use by the BEAM loader. + 0 =< X, X < 1023 -> ok; + 1023 =< X -> error(limit); + X < 0 -> error({bad_register, Src}) + end; +check_limit({y,Y}=Src) when is_integer(Y) -> + if + 0 =< Y, Y < 1024 -> ok; + 1024 =< Y -> error(limit); + Y < 0 -> error({bad_register, Src}) + end; +check_limit({fr,Fr}=Src) when is_integer(Fr) -> + if + 0 =< Fr, Fr < 1023 -> ok; + 1023 =< Fr -> error(limit); + Fr < 0 -> error({bad_register, Src}) + end. 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)). +gb_trees_from_list(L) -> gb_trees:from_orddict(sort(L)). error(Error) -> throw(Error). |