diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/compiler/src/beam_jump.erl | 8 | ||||
| -rw-r--r-- | lib/compiler/src/beam_ssa_type.erl | 3 | ||||
| -rw-r--r-- | lib/compiler/src/beam_validator.erl | 1540 | ||||
| -rw-r--r-- | lib/compiler/src/cerl_sets.erl | 2 | ||||
| -rw-r--r-- | lib/compiler/test/beam_jump_SUITE.erl | 47 | ||||
| -rw-r--r-- | lib/compiler/test/beam_validator_SUITE.erl | 19 | ||||
| -rw-r--r-- | lib/compiler/test/receive_SUITE.erl | 30 | ||||
| -rw-r--r-- | lib/crypto/test/Makefile | 1 | ||||
| -rw-r--r-- | lib/crypto/test/blowfish_SUITE.erl | 300 | ||||
| -rw-r--r-- | lib/crypto/test/crypto_SUITE.erl | 34 | ||||
| -rw-r--r-- | lib/edoc/src/edoc.erl | 17 |
11 files changed, 999 insertions, 1002 deletions
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 6f50bfdb9c..74f80ca70e 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -179,8 +179,9 @@ function({function,Name,Arity,CLabel,Asm0}, Lc0) -> eliminate_moves(Is) -> eliminate_moves(Is, #{}, []). -eliminate_moves([{select,select_val,Reg,_,List}=I|Is], D0, Acc) -> - D = update_value_dict(List, Reg, D0), +eliminate_moves([{select,select_val,Reg,{f,Fail},List}=I|Is], D0, Acc) -> + D1 = add_unsafe_label(Fail, D0), + D = update_value_dict(List, Reg, D1), eliminate_moves(Is, D, [I|Acc]); eliminate_moves([{test,is_eq_exact,_,[Reg,Val]}=I, {block,BlkIs0}|Is], D0, Acc) -> @@ -229,6 +230,9 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. +add_unsafe_label(L, D) -> + D#{L=>unsafe}. + update_unsafe_labels(I, D) -> Ls = instr_labels(I), update_unsafe_labels_1(Ls, D). diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index aa4720d222..c01ea4af91 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -170,7 +170,8 @@ opt_finish_1([], [], ParamInfo) -> validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) -> Elements = maps:fold(fun(Index, Type, Acc) -> - Acc#{ Index => validator_anno(Type) } + Key = beam_validator:type_anno(integer, Index), + Acc#{ Key => validator_anno(Type) } end, #{}, Elements0), beam_validator:type_anno(tuple, Size, Exact, Elements); validator_anno(#t_integer{elements={Same,Same}}) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 5175be3ad5..296c095be2 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -28,8 +28,7 @@ -export([module/2, format_error/1]). -export([type_anno/1, type_anno/2, type_anno/4]). --import(lists, [any/2,dropwhile/2,foldl/3,map/2,member/2,reverse/1, - seq/2,sort/1,zip/2]). +-import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]). %% To be called by the compiler. @@ -51,7 +50,7 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) -spec type_anno(term()) -> term(). type_anno(atom) -> {atom,[]}; type_anno(bool) -> bool; -type_anno({binary,_}) -> term; +type_anno({binary,_}) -> binary; type_anno(cons) -> cons; type_anno(float) -> {float,[]}; type_anno(integer) -> {integer,[]}; @@ -62,9 +61,9 @@ type_anno(number) -> number; type_anno(nil) -> nil. -spec type_anno(term(), term()) -> term(). -type_anno(atom, Value) -> {atom, Value}; -type_anno(float, Value) -> {float, Value}; -type_anno(integer, Value) -> {integer, Value}. +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, @@ -137,43 +136,100 @@ 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 :: reg_tab(), %x register info. - y :: 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. - defs=#{}, %Defining expression for each register. - aliases=#{} - }). + +-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; @@ -238,7 +294,7 @@ validate_fun_info_branches_1(X, {Mod,Name,Arity}=MFA, Vst) -> #vst{current=#st{numy=Size}} -> error({unexpected_stack_frame,Size}) end, - get_term_type({x,X}, Vst) + assert_term({x,X}, Vst) catch Error -> I = {func_info,{atom,Mod},{atom,Name},Arity}, Offset = 2, @@ -260,24 +316,21 @@ labels_1(Is, R) -> {reverse(R),Is}. init_vst(Arity, Ls1, Ls2, Ft) -> - Xs = init_regs(Arity, term), - Ys = init_regs(0, initialized), - St = #st{x=Xs,y=Ys}, - Branches = gb_trees_from_list([{L,St} || L <- Ls1]), + 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), - #vst{branched=Branches, - current=St, - labels=Labels, - ft=Ft}. + 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 <- seq(0, N-1)]). - valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Targets = gb_trees:keys(Targets0), Labels = gb_sets:to_list(Labels0), @@ -298,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_not_fragile(Src, Vst), + assert_durable_term(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1({case_end,Src}, Vst) -> - assert_not_fragile(Src, Vst), + assert_durable_term(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1(if_end, Vst) -> @@ -319,7 +377,7 @@ valfun_1(if_end, Vst) -> kill_state(Vst); valfun_1({try_case_end,Src}, Vst) -> verify_y_init(Vst), - assert_not_fragile(Src, Vst), + assert_durable_term(Src, Vst), kill_state(Vst); %% Instructions that cannot cause exceptions valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> @@ -363,17 +421,17 @@ valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> - assert_not_fragile(A, Vst0), - assert_not_fragile(B, Vst0), + assert_term(A, Vst0), + assert_term(B, Vst0), Vst = eat_heap(2, Vst0), create_term(cons, put_list, [A, B], Dst, Vst); valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> - _ = [assert_not_fragile(El, Vst0) || El <- Elements], + _ = [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(Index, Type, Es0), + Es = set_element_type({integer,Index}, Type, Es0), {Es, Index + 1} end, {#{}, 1}, Elements), Type = {tuple,Size,Es}, @@ -385,18 +443,19 @@ valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; valfun_1({put,Src}, Vst0) -> - assert_not_fragile(Src, Vst0), + assert_term(Src, Vst0), Vst = eat_heap(1, Vst0), #vst{current=St0} = Vst, case St0 of #st{puts_left=none} -> error(not_building_a_tuple); - #st{puts_left={1,{Dst,Sz,Es}}} -> + #st{puts_left={1,{Dst,Sz,Es0}}} -> + Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) }, St = St0#st{puts_left=none}, 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#{ Index => get_term_type(Src, Vst0) }, + Es = Es0#{ {integer,Index} => get_term_type(Src, Vst0) }, St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; @@ -417,6 +476,14 @@ valfun_1({'%', {type_info, Reg, Type}}, Vst) -> %% 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) -> @@ -438,13 +505,13 @@ 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); @@ -508,8 +575,9 @@ valfun_1({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), - Type = get_element_type(N+1, Src, Vst), - extract_term(Type, get_tuple_element, [Src], Dst, 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) -> kill_state(branch_state(Lbl, Vst)); valfun_1(I, Vst) -> @@ -518,20 +586,26 @@ valfun_1(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, - CurrentSt = St0#st{ct=[[Fail]|Fails]}, + St = St0#st{ct=[[Fail]|Fails]}, + Vst = Vst0#vst{current=St}, - %% Set the initial state at the try/catch label. - %% Assume that Y registers contain terms or try/catch - %% tags. - Yregs0 = map(fun({Y,uninitialized}) -> {Y,term}; - ({Y,initialized}) -> {Y,term}; - (E) -> E - end, gb_trees:to_list(CurrentSt#st.y)), - Yregs = gb_trees:from_orddict(Yregs0), - BranchSt = CurrentSt#st{y=Yregs}, + complex_test(Fail, + fun(CatchVst) -> + #vst{current=#st{ys=Ys}} = CatchVst, + maps:fold(fun init_catch_handler_1/3, CatchVst, Ys) + end, + fun(SuccVst) -> + SuccVst + end, Vst). - Vst = branch_state(Fail, Vst1#vst{current=BranchSt}), - Vst#vst{current=CurrentSt}. +%% 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. %% Update branched state if necessary and try next set of instructions. valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> @@ -609,15 +683,13 @@ valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> - PosType = get_durable_term_type(Pos, Vst0), - ElementType = case PosType of - {integer,I} -> get_element_type(I, Tuple, Vst0); - _ -> term - end, + PosType = get_term_type(Pos, Vst0), + ElementType = get_element_type(PosType, Tuple, Vst0), InferredType = {tuple,[get_tuple_size(PosType)],#{}}, Vst1 = branch_state(Fail, Vst0), - Vst = update_type(fun meet/2, InferredType, Tuple, Vst1), - extract_term(ElementType, {bif,element}, [Tuple], Dst, Vst); + Vst2 = update_type(fun meet/2, InferredType, Tuple, Vst1), + Vst = update_type(fun meet/2, {integer,[]}, Pos, Vst2), + extract_term(ElementType, {bif,element}, [Pos,Tuple], Dst, Vst); valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); @@ -634,7 +706,7 @@ valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst0) -> Vst1 = branch_state(Fail, Vst0), %% Infer argument types. Note that we can't type_test in the general case - %% as the BIF could fail for reasons other than bad arguments. + %% as the BIF could fail for reasons other than bad argument types. ArgTypes = bif_arg_types(Op, Ss), Vst = foldl(fun({Arg, T}, Vsti) -> update_type(fun meet/2, T, Arg, Vsti) @@ -659,17 +731,18 @@ valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> Vst = prune_x_regs(Live, Vst3), extract_term(Type, {gc_bif,Op}, Ss, Dst, Vst, Vst0); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> - assert_not_fragile({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({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. - create_term({fragile,term}, loop_rec, [], Dst, Vst); + Vst1 = branch_state(Fail, Vst0), + {Ref, Vst} = new_value(term, loop_rec, [], Vst1), + mark_fragile(Dst, set_reg_vref(Ref, Dst, Vst)); valfun_4({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -680,20 +753,20 @@ 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,N}, Vst) -> I = N + 1, - assert_not_fragile(Src, Vst), + assert_term(Src, 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(I, get_term_type(Src, Vst), Es0), + 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}}, Vst0) -> @@ -750,15 +823,19 @@ valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - create_term(bs_position, bs_get_position, [Ctx], Dst, Vst); + 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(bs_position, Pos, Vst), + assert_type(ms_position, Pos, Vst), Vst; %% Other test instructions. 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) -> @@ -769,10 +846,21 @@ 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_nil,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, nil, 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), + complex_test(Lbl, + fun(FailVst) -> + update_ne_types(Src, nil, FailVst) + end, + fun(SuccVst) -> + update_eq_types(Src, nil, SuccVst) + end, Vst); valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) -> case Src of {Tag,_} when Tag =:= x; Tag =:= y -> @@ -790,7 +878,7 @@ valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst0) when is_integer(Sz) -> valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst0) -> assert_term(Src, Vst0), Vst = branch_state(Lbl, Vst0), - update_type(fun meet/2, {tuple,Sz,#{ 1 => Atom }}, Src, Vst); + update_type(fun meet/2, {tuple,Sz,#{ {integer,1} => Atom }}, Src, Vst); valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), assert_unique_map_keys(List), @@ -817,8 +905,8 @@ valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> - assert_not_fragile(A, Vst), - assert_not_fragile(B, Vst), + assert_term(A, Vst), + assert_term(B, Vst), create_term({integer,[]}, bs_add, [A, B], Dst, branch_state(Fail, Vst)); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), @@ -833,12 +921,12 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> is_integer(Sz) -> ok; true -> - assert_not_fragile(Sz, Vst0) + assert_term(Sz, Vst0) end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - create_term(binary, bs_init2, [], Dst, Vst); + create_term(binary, bs_init2, [], Dst, Vst, Vst0); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -855,39 +943,39 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), - assert_not_fragile(Bits, Vst0), - assert_not_fragile(Bin, 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), - create_term(binary, bs_append, [Bin], Dst, Vst); + create_term(binary, bs_append, [Bin], Dst, Vst, Vst0); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> - assert_not_fragile(Bits, Vst0), - assert_not_fragile(Bin, Vst0), + assert_term(Bits, Vst0), + assert_term(Bin, Vst0), Vst = branch_state(Fail, Vst0), create_term(binary, bs_private_append, [Bin], Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_not_fragile(Sz, Vst), - assert_not_fragile(Src, Vst), + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_not_fragile(Sz, Vst), - assert_not_fragile(Src, Vst), + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_not_fragile(Sz, Vst), - assert_not_fragile(Src, Vst), + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> - assert_not_fragile(Src, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> - assert_not_fragile(Src, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> - assert_not_fragile(Src, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); %% Map instructions. valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -945,13 +1033,13 @@ verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), - [assert_not_fragile(Term, Vst0) || Term <- List], + [assert_term(Term, Vst0) || Term <- 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), - create_term(map, Op, [Src], Dst, Vst). + create_term(map, Op, [Src], Dst, Vst, Vst0). %% %% Common code for validating bs_start_match* instructions. @@ -962,18 +1050,20 @@ validate_bs_start_match(Fail, Live, Type, Src, Dst, 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, and retain the incoming type if it - %% succeeds (match context or not). - %% - %% The override_type hack is only needed until we get proper union types. + %% 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. complex_test(Fail, fun(FailVst) -> - override_type(term, Src, FailVst) + case get_raw_type(Src, FailVst) of + #ms{} -> override_type(term, Src, FailVst); + _ -> FailVst + end end, fun(SuccVst0) -> - SuccVst = prune_x_regs(Live, 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, Vst) + SuccVst, SuccVst0) end, Vst). %% @@ -985,7 +1075,7 @@ validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst0) -> verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), Vst = branch_state(Fail, Vst1), - extract_term(Type, Op, [Ctx], Dst, Vst). + extract_term(Type, Op, [Ctx], Dst, Vst, Vst0). %% %% Common code for validating bs_skip_utf* instructions. @@ -1032,7 +1122,7 @@ call(Name, Live, #vst{current=St0}=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(),aliases=#{}}, + St = St0#st{f=init_fregs()}, Vst = prune_x_regs(0, Vst0#vst{current=St}), create_term(Type, call, [], {x,0}, Vst) end. @@ -1059,13 +1149,15 @@ verify_call_args(_, Live, _) -> verify_remote_args_1(-1, _) -> ok; verify_remote_args_1(X, Vst) -> - assert_not_fragile({x, 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_movable(Reg, Vst), + assert_not_fragile(Reg, Vst), case get_raw_type(Reg, Vst) of #ms{id=Id}=Type -> case CtxIds of @@ -1075,8 +1167,6 @@ verify_local_args(X, Lbl, CtxIds, Vst) -> verify_arg_type(Lbl, Reg, Type, Vst), verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) end; - {fragile,_} -> - error({fragile_message_reference, Reg}); Type -> verify_arg_type(Lbl, Reg, Type, Vst), verify_local_args(X - 1, Lbl, CtxIds, Vst) @@ -1092,56 +1182,89 @@ verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) -> end; verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) -> case gb_trees:lookup({Lbl, Reg}, Ft) of - {value, bool} when GivenType =:= {atom, true}; - GivenType =:= {atom, false}; - GivenType =:= {atom, []} -> - %% We don't yet support upgrading true/false to bool, so we - %% assume unknown atoms can be bools when validating calls. - ok; {value, #ms{}} -> %% Functions that accept match contexts also accept all other %% terms. This will change once we support union types. ok; {value, RequiredType} -> - case meet(GivenType, RequiredType) of - none -> error({bad_arg_type, Reg, GivenType, RequiredType}); - _ -> ok + case vat_1(GivenType, RequiredType) of + true -> ok; + false -> error({bad_arg_type, Reg, GivenType, RequiredType}) end; none -> ok end. -allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}}=Vst0) -> +%% 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. + +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(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}}. - -trim_stack(From, To, Top, #st{y=Ys0}=St) when From =:= Top -> - Ys = foldl(fun(Y, Acc) -> - gb_trees:delete(Y, Acc) - end, Ys0, seq(To, From - 1)), - %% Note that all aliases and defs are wiped. This is perhaps a bit too - %% conservative, but preserving them won't be easy until type management - %% is refactored. - St#st{aliases=#{},defs=#{},numy=To,y=Ys}; + 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) -> - #st{y=Ys0} = St0, + Src = {y, From}, + Dst = {y, To}, - Ys = case gb_trees:lookup(From, Ys0) of - none -> error({invalid_shift,{y,From},{y,To}}); - {value,Type} -> gb_trees:enter(To, Type, Ys0) + #st{ys=Ys0} = St0, + Ys = case Ys0 of + #{ Src := Ref } -> Ys0#{ Dst => Ref }; + #{} -> error({invalid_shift,Src,Dst}) end, + St = St0#st{ys=Ys}, - St = St0#st{y=Ys}, trim_stack(From + 1, To + 1, Top, St). test_heap(Heap, Live, Vst0) -> @@ -1168,24 +1291,17 @@ heap_alloc_2([{floats,Floats}|T], St0) -> heap_alloc_2(T, St); heap_alloc_2([], St) -> St. -prune_x_regs(Live, #vst{current=St0}=Vst) - when is_integer(Live) -> - #st{x=Xs0,defs=Defs0,aliases=Aliases0} = St0, - Xs1 = gb_trees:to_list(Xs0), - Xs = [P || {R,_}=P <- Xs1, R < Live], - Defs = maps:filter(fun({x,X}, _) -> X < Live; - ({y,_}, _) -> true - end, Defs0), - Aliases = maps:filter(fun({x,X1}, {x,X2}) -> - X1 < Live andalso X2 < Live; - ({x,X}, _) -> - X < Live; - (_, {x,X}) -> - X < Live; - (_, _) -> - true - end, Aliases0), - St = St0#st{x=gb_trees:from_orddict(Xs),defs=Defs,aliases=Aliases}, +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. @@ -1249,8 +1365,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 @@ -1308,19 +1423,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}) - end; -bsm_get_context({y,Y}=Reg, #vst{current=#st{y=Ys}}=_Vst) when is_integer(Y) -> - case gb_trees:lookup(Y, Ys) 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_raw_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. @@ -1357,17 +1466,17 @@ select_val_branches(Fail, Src, Choices, Vst0) -> svb_1([Val,{f,L}|T], Src, Vst0) -> Vst = complex_test(L, fun(BranchVst) -> - update_eq_types(Val, Src, BranchVst) + update_eq_types(Src, Val, BranchVst) end, fun(FailVst) -> - update_ne_types(Val, Src, FailVst) + update_ne_types(Src, Val, FailVst) end, Vst0), svb_1(T, Src, Vst); svb_1([], _, Vst) -> Vst. select_arity_branches(Fail, List, Tuple, Vst0) -> - Type = get_durable_term_type(Tuple, Vst0), + Type = get_term_type(Tuple, Vst0), Vst = sab_1(List, Tuple, Type, Vst0), kill_state(branch_state(Fail, Vst)). @@ -1389,42 +1498,54 @@ sab_1([_,{f,_}|T], Tuple, Type, Vst) -> sab_1([], _, _, #vst{}=Vst) -> Vst. -infer_types(Src, Vst) -> - case get_def(Src, Vst) of - {{bif,tuple_size}, [Tuple]} -> - fun({integer,Arity}, S) -> - update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); - (_, S) -> S - end; - {{bif,'=:='},[ArityReg,{integer,_}=Val]} when ArityReg =/= Src -> - fun({atom,true}, S) -> - Infer = infer_types(ArityReg, S), - Infer(Val, S); - (_, S) -> S - end; - {{bif,is_atom},[Src]} -> - infer_type_test_bif({atom,[]}, Src); - {{bif,is_boolean},[Src]} -> - infer_type_test_bif(bool, Src); - {{bif,is_binary},[Src]} -> - infer_type_test_bif(binary, Src); - {{bif,is_bitstring},[Src]} -> - infer_type_test_bif(binary, Src); - {{bif,is_float},[Src]} -> - infer_type_test_bif(float, Src); - {{bif,is_integer},[Src]} -> - infer_type_test_bif({integer,{}}, Src); - {{bif,is_list},[Src]} -> - infer_type_test_bif(list, Src); - {{bif,is_map},[Src]} -> - infer_type_test_bif(map, Src); - {{bif,is_number},[Src]} -> - infer_type_test_bif(number, Src); - {{bif,is_tuple},[Src]} -> - infer_type_test_bif({tuple,[0],#{}}, Src); - _ -> - fun(_, S) -> S end - 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) -> + Infer = infer_types(RHS, S), + Infer(LHS, S); + (_, S) -> S + end; +infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> + fun(Val, S) -> + Type = get_term_type(Val, S), + update_type(fun meet/2,{tuple,[Index],#{ Key => Type }}, Tuple, S) + 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) -> + update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); + (_, S) -> S + end; +infer_types_1(_) -> + fun(_, S) -> S end. infer_type_test_bif(Type, Src) -> fun({atom,true}, S) -> @@ -1445,38 +1566,67 @@ assign({y,_}=Src, {y,_}=Dst, Vst) -> initialized -> create_tag(initialized, init, [], Dst, Vst); _ -> assign_1(Src, Dst, Vst) end; -assign({Kind,_}=Reg, Dst, Vst) when Kind =:= x; Kind =:= y -> - assign_1(Reg, Dst, Vst); +assign({Kind,_}=Src, Dst, Vst) when Kind =:= x; Kind =:= y -> + assign_1(Src, Dst, Vst); assign(Literal, Dst, Vst) -> - Type = get_term_type(Literal, 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(Type, Op, Ss, {y,_}=Dst, Vst) -> - set_type_reg_expr(Type, {Op, Ss}, Dst, Vst); -create_tag(_Type, _Op, _Ss, 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); + _ -> + 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,Y}=Reg, #vst{current=#st{y=Ys0}=St0}=Vst) -> +kill_tag({y,_}=Reg, #vst{current=#st{ys=Ys0}=St0}=Vst) -> _ = get_tag_type(Reg, Vst), %Assertion. - Ys = gb_trees:update(Y, initialized, Ys0), - Vst#vst{current=St0#st{y=Ys}}. + Ys = Ys0#{ Reg => initialized }, + Vst#vst{current=St0#st{ys=Ys}}. %% Creates a completely new term with the given type. -create_term(Type, Op, Ss, Dst, Vst) -> - set_type_reg_expr(Type, {Op, Ss}, Dst, Vst). +create_term(Type, Op, Ss0, Dst, Vst0) -> + create_term(Type, Op, Ss0, Dst, Vst0, Vst0). -%% Extracts a term from Ss, propagating fragility. -extract_term(Type, Op, Ss, Dst, Vst) -> - extract_term(Type, Op, Ss, Dst, Vst, Vst). +%% 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). -%% As extract_term/4, but uses the incoming Vst for fragility in case x-regs -%% have been pruned and the sources can no longer be found. -extract_term(Type0, Op, Ss, Dst, Vst, OrigVst) -> - Type = propagate_fragility(Type0, Ss, OrigVst), - set_type_reg_expr(Type, {Op, Ss}, 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) -> + []. %% Helper functions for tests that alter state on both the success and fail %% branches, keeping the states from tainting each other. @@ -1501,13 +1651,11 @@ type_test(Fail, Type, Reg, Vst) -> %% Overrides the type of Reg. This is ugly but a necessity for certain %% destructive operations. override_type(Type, Reg, Vst) -> - %% Once the new type format is in, this should be expressed as: - %% update_type(fun(_, T) -> T end, Type, Reg, Vst). - set_aliased_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, Type0, Reg, Vst) -> +update_type(Merge, Type0, #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: @@ -1518,21 +1666,26 @@ update_type(Merge, Type0, Reg, Vst) -> %% %% Note that the test_arity instruction can never be reached, so we use the %% new type instead of 'none'. - Type = case Merge(get_durable_term_type(Reg, Vst), Type0) of + Type = case Merge(get_raw_type(Ref, Vst), Type0) of none -> Type0; T -> T end, - set_aliased_type(Type, Reg, Vst). + set_type(Type, Ref, Vst); +update_type(Merge, Type, {Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> + update_type(Merge, Type, get_reg_vref(Reg, Vst), Vst); +update_type(_Merge, _Type, Literal, Vst) -> + assert_literal(Literal), + Vst. update_ne_types(LHS, RHS, Vst) -> - update_type(fun subtract/2, get_durable_term_type(RHS, Vst), LHS, Vst). + update_type(fun subtract/2, get_term_type(RHS, Vst), LHS, Vst). update_eq_types(LHS, RHS, Vst0) -> Infer = infer_types(LHS, Vst0), Vst1 = Infer(RHS, Vst0), - T1 = get_durable_term_type(LHS, Vst1), - T2 = get_durable_term_type(RHS, Vst1), + 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). @@ -1540,102 +1693,69 @@ update_eq_types(LHS, RHS, Vst0) -> %% Helper functions for the above. assign_1(Src, Dst, Vst0) -> - Type = get_move_term_type(Src, Vst0), - Def = get_def(Src, Vst0), - - Vst = set_type_reg_expr(Type, Def, Dst, Vst0), - - #vst{current=St0} = Vst, - #st{aliases=Aliases0} = St0, - - Aliases = Aliases0#{Src=>Dst,Dst=>Src}, - - St = St0#st{aliases=Aliases}, - Vst#vst{current=St}. - -set_aliased_type(Type, Reg, #vst{current=#st{aliases=Aliases}}=Vst0) -> - Vst1 = set_type(Type, Reg, Vst0), - case Aliases of - #{Reg:=OtherReg} -> - Vst = set_type_reg(Type, OtherReg, Vst1), - #vst{current=St} = Vst, - Vst#vst{current=St#st{aliases=Aliases}}; + 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}; #{} -> - Vst1 + %% Storing into a non-existent Y register means that we haven't set + %% up a (sufficiently large) stack. + error({invalid_store, Dst}) end. -kill_aliases(Reg, #st{aliases=Aliases0}=St) -> - case Aliases0 of - #{Reg:=OtherReg} -> - Aliases = maps:without([Reg,OtherReg], Aliases0), - St#st{aliases=Aliases}; +get_reg_vref({x,_}=Src, #vst{current=#st{xs=Xs}}) -> + check_limit(Src), + case Xs of + #{ Src := #value_ref{}=Ref } -> + Ref; #{} -> - St + 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, {x,_}=Reg, Vst) -> - set_type_reg(Type, Reg, Reg, Vst); -set_type(Type, {y,_}=Reg, Vst) -> - set_type_reg(Type, Reg, Reg, Vst); -set_type(_, _, #vst{}=Vst) -> Vst. - -set_type_reg(Type, Src, Dst, Vst) -> - case get_raw_type(Src, Vst) of - uninitialized -> - error({uninitialized_reg, Src}); - {fragile,_} -> - set_type_reg(make_fragile(Type), Dst, Vst); - _ -> - set_type_reg(Type, Dst, Vst) +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. -set_type_reg(Type, Reg, Vst) -> - set_type_reg_expr(Type, none, Reg, Vst). - -set_type_reg_expr(Type, Expr, {x,_}=Reg, Vst) -> - set_type_x(Type, Expr, Reg, Vst); -set_type_reg_expr(Type, Expr, Reg, Vst) -> - set_type_y(Type, Expr, Reg, Vst). - -set_type_x(Type, Expr, {x,X}=Reg, #vst{current=#st{x=Xs0,defs=Defs0}=St0}=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, - Defs = Defs0#{Reg=>Expr}, - St = kill_aliases(Reg, St0), - Vst#vst{current=St#st{x=Xs,defs=Defs}}; -set_type_x(Type, _Expr, Reg, #vst{}) -> - error({invalid_store,Reg,Type}). - -set_type_y(Type, Expr, {y,Y}=Reg, #vst{current=#st{y=Ys0,defs=Defs0}=St0}=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, Reg, Vst), - Defs = Defs0#{Reg=>Expr}, - St = kill_aliases(Reg, St0), - Vst#vst{current=St#st{y=Ys,defs=Defs}}; -set_type_y(Type, _Expr, Reg, #vst{}) -> - error({invalid_store,Reg,Type}). - -make_fragile({fragile,_}=Type) -> Type; -make_fragile(Type) -> {fragile,Type}. +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}}. kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, @@ -1657,25 +1777,17 @@ check_try_catch_tags(Type, {y,N}=Reg, Vst) -> ok end. -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({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}). -is_type_defined_x({x,X}, #vst{current=#st{x=Xs}}) -> - gb_trees:is_defined(X,Xs). - -is_type_defined_y({y,Y}, #vst{current=#st{y=Ys}}) -> - gb_trees:is_defined(Y,Ys). - assert_term(Src, Vst) -> - get_term_type(Src, Vst), + _ = get_term_type(Src, Vst), ok. -assert_not_fragile(Src, Vst) -> - case get_term_type(Src, Vst) of - {fragile, _} -> error({fragile_message_reference, Src}); - _ -> ok - end. +assert_movable(Src, Vst) -> + _ = get_move_term_type(Src, Vst), + ok. assert_literal(nil) -> ok; assert_literal({atom,A}) when is_atom(A) -> ok; @@ -1753,16 +1865,106 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% %% 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. + +%% 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. @@ -1770,14 +1972,23 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). meet(Same, Same) -> Same; -meet({literal,_}=T1, T2) -> - meet_literal(T1, T2); -meet(T1, {literal,_}=T2) -> - meet_literal(T2, T1); 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; @@ -1810,13 +2021,6 @@ meet(T1, T2) -> {_,_} -> none end. -%% Meets types of literals. -meet_literal({literal,_}=Lit, T) -> - meet_literal(T, get_literal_type(Lit)); -meet_literal(T1, T2) -> - %% We're done extracting the types, try merging them again. - meet(T1, T2). - meet_elements(Es1, Es2) -> Keys = maps:keys(Es1) ++ maps:keys(Es2), meet_elements_1(Keys, Es1, Es2, #{}). @@ -1838,7 +2042,7 @@ meet_elements_1([], _Es1, _Es2, Acc) -> %% No tuple elements may have an index above the known size. assert_tuple_elements(Limit, Es) -> - true = maps:fold(fun(Index, _T, true) -> + true = maps:fold(fun({integer,Index}, _T, true) -> Index =< Limit end, true, Es). %Assertion. @@ -1855,7 +2059,7 @@ subtract(bool, {atom,true}) -> {atom, false}; subtract(Type, _) -> Type. assert_type(WantedType, Term, Vst) -> - Type = get_durable_term_type(Term, Vst), + Type = get_term_type(Term, Vst), assert_type(WantedType, Type). assert_type(Correct, Correct) -> ok; @@ -1876,11 +2080,11 @@ assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). get_element_type(Key, Src, Vst) -> - get_element_type_1(Key, get_durable_term_type(Src, Vst)). + get_element_type_1(Key, get_term_type(Src, Vst)). -get_element_type_1(Index, {tuple,Sz,Es}) -> +get_element_type_1({integer,Index}=Key, {tuple,Sz,Es}) -> case Es of - #{ Index := Type } -> Type; + #{ Key := Type } -> Type; #{} when Index =< Sz -> term; #{} -> none end; @@ -1912,17 +2116,6 @@ get_term_type(Src, Vst) -> Type -> Type end. -%% get_durable_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). -%% Fragility will be stripped. - -get_durable_term_type(Src, Vst) -> - case get_term_type(Src, Vst) of - {fragile,Type} -> Type; - Type -> Type - end. - %% get_move_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. @@ -1953,25 +2146,27 @@ get_tag_type(Src, _) -> %% get_raw_type(Src, ValidatorState) -> Type %% Return the type of a register without doing any validity checks. -get_raw_type({x,X}, #vst{current=#st{x=Xs}}) when is_integer(X) -> - case gb_trees:lookup(X, Xs) of - {value,Type} -> Type; - none -> uninitialized +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_raw_type({y,Y}, #vst{current=#st{y=Ys}}) when is_integer(Y) -> - case gb_trees:lookup(Y, Ys) of - {value,Type} -> Type; - none -> uninitialized +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). -get_def(Src, #vst{current=#st{defs=Defs}}) -> - case Defs of - #{Src:=Def} -> Def; - #{} -> none - end. - 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; @@ -1979,22 +2174,23 @@ 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) -> value_to_type(Tuple); +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}). -value_to_type([]) -> nil; -value_to_type(A) when is_atom(A) -> {atom, A}; -value_to_type(F) when is_float(F) -> {float, F}; -value_to_type(I) when is_integer(I) -> {integer, I}; -value_to_type(T) when is_tuple(T) -> - {Es,_} = foldl(fun(Val, {Es0, Index}) -> - Type = value_to_type(Val), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(T)), - {tuple, tuple_size(T), Es}; -value_to_type(L) -> {literal, L}. +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}. branch_state(0, #vst{}=Vst) -> %% If the instruction fails, the stack may be scanned @@ -2002,36 +2198,134 @@ branch_state(0, #vst{}=Vst) -> %% 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,aliases=Aliases0}, - #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1,aliases=Aliases1}) -> - NumY = merge_stk(NumY0, NumY1), - Xs = merge_regs(Xs0, Xs1), - Ys = merge_y_regs(Ys0, Ys1), - Ct = merge_ct(Ct0, Ct1), - Aliases = merge_aliases(Aliases0, Aliases1), - #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct,aliases=Aliases}. +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. @@ -2044,174 +2338,17 @@ 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,join(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. - -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 = join(Type0, Type1), - Regs = gb_trees:update(Y, Type, Regs0), - merge_y_regs_1(Y-1, S, Regs) - end; -merge_y_regs_1(_, _, Regs) -> Regs. - -%% join(Type1, Type2) -> Type -%% Return the most specific type possible. -%% Note: Type1 must NOT be the same as Type2. -join({literal,_}=T1, T2) -> - join_literal(T1, T2); -join(T1, {literal,_}=T2) -> - join_literal(T2, T1); -join({fragile,Same}=Type, Same) -> - Type; -join({fragile,T1}, T2) -> - make_fragile(join(T1, T2)); -join(Same, {fragile,Same}=Type) -> - Type; -join(T1, {fragile,T2}) -> - make_fragile(join(T1, T2)); -join(uninitialized=I, _) -> I; -join(_, uninitialized=I) -> I; -join(initialized=I, _) -> I; -join(_, initialized=I) -> I; -join({catchtag,T0},{catchtag,T1}) -> - {catchtag,ordsets:from_list(T0++T1)}; -join({trytag,T0},{trytag,T1}) -> - {trytag,ordsets:from_list(T0++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(bool, {atom,A}) -> - join_bool(A); -join({atom,A}, bool) -> - join_bool(A); -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(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,[]}. - tuple_sz([Sz]) -> Sz; tuple_sz(Sz) -> Sz. -merge_aliases(Al0, Al1) when map_size(Al0) =< map_size(Al1) -> - maps:filter(fun(K, V) -> - case Al1 of - #{K:=V} -> true; - #{} -> false - end - end, Al0); -merge_aliases(Al0, Al1) -> - merge_aliases(Al1, Al0). - -verify_y_init(#vst{current=#st{numy=NumY,y=Ys}}=Vst) - when is_integer(NumY), NumY > 0 -> - {HighestY, _} = gb_trees:largest(Ys), +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,y=Ys}}=Vst) -> - case gb_trees:is_empty(Ys) of - true -> - ok; - false -> - {HighestY, _} = gb_trees:largest(Ys), - verify_y_init_1(HighestY, Vst) - end; +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. @@ -2219,15 +2356,10 @@ 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}); - {fragile, _} -> - %% Unsafe. This term may be outside any heap belonging to the - %% process and would be corrupted by a GC. - error({fragile_message_reference,Reg}); - _ -> - verify_y_init_1(Y - 1, Vst) + uninitialized -> error({uninitialized_reg,Reg}); + _ -> verify_y_init_1(Y - 1, Vst) end. verify_live(0, _Vst) -> @@ -2287,27 +2419,68 @@ 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_raw_type(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. +%% 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 %%% @@ -2319,7 +2492,7 @@ bif_return_type('+', Src, Vst) -> bif_return_type('*', Src, Vst) -> arith_return_type(Src, Vst); bif_return_type(abs, [Num], Vst) -> - case get_durable_term_type(Num, Vst) of + case get_term_type(Num, Vst) of {float,_}=T -> T; {integer,_}=T -> T; _ -> number @@ -2327,8 +2500,10 @@ bif_return_type(abs, [Num], Vst) -> bif_return_type(float, _, _) -> {float,[]}; bif_return_type('/', _, _) -> {float,[]}; %% Binary operations -bif_return_type('byte_size', _, _) -> {integer,[]}; -bif_return_type('bit_size', _, _) -> {integer,[]}; +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_return_type(ceil, [_], _) -> {integer,[]}; bif_return_type('div', [_,_], _) -> {integer,[]}; @@ -2362,6 +2537,7 @@ 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; @@ -2372,6 +2548,7 @@ bif_return_type(is_reference, [_], _) -> bool; bif_return_type(is_tuple, [_], _) -> bool; %% Misc. 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; @@ -2393,14 +2570,24 @@ bif_arg_types('and', [_,_]) -> [bool, bool]; bif_arg_types('or', [_,_]) -> [bool, bool]; bif_arg_types('xor', [_,_]) -> [bool, bool]; %% Binary -bif_arg_types('byte_size', [_]) -> [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]; @@ -2446,14 +2633,14 @@ is_bif_safe(_, _) -> false. arith_return_type([A], Vst) -> %% Unary '+' or '-'. - case get_durable_term_type(A, Vst) of + case get_term_type(A, Vst) of {integer,_} -> {integer,[]}; {float,_} -> {float,[]}; _ -> number end; arith_return_type([A,B], Vst) -> - TypeA = get_durable_term_type(A, Vst), - TypeB = get_durable_term_type(B, Vst), + TypeA = get_term_type(A, Vst), + TypeB = get_term_type(B, Vst), case {TypeA, TypeB} of {{integer,_},{integer,_}} -> {integer,[]}; {{float,_},_} -> {float,[]}; @@ -2482,7 +2669,7 @@ call_return_type_1(erlang, setelement, 3, Vst) -> case meet({tuple,[I],#{}}, TupleType) of {tuple, Sz, Es0} -> ValueType = get_term_type({x,2}, Vst), - Es = set_element_type(I, ValueType, Es0), + Es = set_element_type({integer,I}, ValueType, Es0), {tuple, Sz, Es}; none -> TupleType @@ -2542,19 +2729,33 @@ 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(flatten, 2, _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,#{1=>ListType}}; + {tuple,2,#{ {integer,1} => ListType} }; lists_mod_return_type(partition, 2, _Vst) -> two_tuple(list, list); lists_mod_return_type(reverse, 1, Vst) -> @@ -2590,7 +2791,8 @@ lists_mod_return_type(_, _, _) -> term. two_tuple(Type1, Type2) -> - {tuple,2,#{1=>Type1,2=>Type2}}. + {tuple,2,#{ {integer,1} => Type1, + {integer,2} => Type2 }}. same_length_type(Reg, Vst) -> case get_term_type(Reg, Vst) of @@ -2600,15 +2802,25 @@ same_length_type(Reg, Vst) -> _ -> list end. -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). +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. diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl index 0361186713..f489baf238 100644 --- a/lib/compiler/src/cerl_sets.erl +++ b/lib/compiler/src/cerl_sets.erl @@ -204,4 +204,4 @@ fold(F, Init, D) -> Set2 :: set(Element). filter(F, D) -> - maps:from_list(lists:filter(fun({K,_}) -> F(K) end, maps:to_list(D))). + maps:filter(fun(K,_) -> F(K) end, D). diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl index 759d884dc4..a456f31d79 100644 --- a/lib/compiler/test/beam_jump_SUITE.erl +++ b/lib/compiler/test/beam_jump_SUITE.erl @@ -79,12 +79,13 @@ checks(Wanted) -> {catch case river() of sheet -> begin +Wanted, if "da" -> Wanted end end end, catch case river() of sheet -> begin + Wanted, if "da" -> Wanted end end end}. unsafe_move_elimination(_Config) -> - {{left,right,false},false} = unsafe_move_elimination(left, right, false), - {{false,right,false},false} = unsafe_move_elimination(false, right, true), - {{true,right,right},right} = unsafe_move_elimination(true, right, true), + {{left,right,false},false} = unsafe_move_elimination_1(left, right, false), + {{false,right,false},false} = unsafe_move_elimination_1(false, right, true), + {{true,right,right},right} = unsafe_move_elimination_1(true, right, true), + [ok = unsafe_move_elimination_2(I) || I <- lists:seq(0,16)], ok. -unsafe_move_elimination(Left, Right, Simple0) -> +unsafe_move_elimination_1(Left, Right, Simple0) -> id(1), %% The move at label 29 would be removed by beam_jump, which is unsafe because @@ -115,6 +116,44 @@ unsafe_move_elimination(Left, Right, Simple0) -> end, {id({Left,Right,Simple}),Simple}. +unsafe_move_elimination_2(Int) -> + %% The type optimization pass would recognize that TagInt can only be + %% [0 .. 7], so the first 'case' would select_val over [0 .. 6] and swap + %% out the fail label with the block for 7. + %% + %% A later optimization would merge this block with 'expects_h' in the + %% second case, as the latter is only reachable from the former. + %% + %% ... but this broke down when the move elimination optimization didn't + %% take the fail label of the first select_val into account. This caused it + %% to believe that the only way to reach 'expects_h' was through the second + %% case when 'Tag' =:= 'h', which made it remove the move instruction + %% added in the first case, passing garbage to expects_h/2. + TagInt = Int band 2#111, + Tag = case TagInt of + 0 -> a; + 1 -> b; + 2 -> c; + 3 -> d; + 4 -> e; + 5 -> f; + 6 -> g; + 7 -> h + end, + case Tag of + g -> expects_g(TagInt, Tag); + h -> expects_h(TagInt, Tag); + _ -> Tag = id(Tag), ok + end. + +expects_g(6, Atom) -> + Atom = id(g), + ok. + +expects_h(7, Atom) -> + Atom = id(h), + ok. + -record(message2, {id, p1}). -record(message3, {id, p1, p2}). diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 2660bf222c..265da43f9d 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -107,13 +107,12 @@ xrange(Config) when is_list(Config) -> Errors = do_val(xrange, Config), [{{t,sum_1,2}, {{bif,'+',{f,0},[{x,-1},{x,1}],{x,0}},4, - {uninitialized_reg,{x,-1}}}}, + {bad_register,{x,-1}}}}, {{t,sum_2,2}, - {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4, - {uninitialized_reg,{x,1023}}}}, + {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4,limit}}, {{t,sum_3,2}, {{bif,'+',{f,0},[{x,0},{x,1}],{x,-1}},4, - {invalid_store,{x,-1},number}}}, + {bad_register,{x,-1}}}}, {{t,sum_4,2}, {{bif,'+',{f,0},[{x,0},{x,1}],{x,1023}},4,limit}}] = Errors, ok. @@ -122,15 +121,15 @@ yrange(Config) when is_list(Config) -> Errors = do_val(yrange, Config), [{{t,sum_1,2}, {{move,{x,1},{y,-1}},5, - {invalid_store,{y,-1},term}}}, + {bad_register,{y,-1}}}}, {{t,sum_2,2}, {{bif,'+',{f,0},[{x,0},{y,1024}],{x,0}},7, - {uninitialized_reg,{y,1024}}}}, + limit}}, {{t,sum_3,2}, {{move,{x,1},{y,1024}},5,limit}}, {{t,sum_4,2}, {{move,{x,1},{y,-1}},5, - {invalid_store,{y,-1},term}}}] = Errors, + {bad_register,{y,-1}}}}] = Errors, ok. stack(Config) when is_list(Config) -> @@ -178,7 +177,7 @@ unsafe_catch(Config) when is_list(Config) -> Errors = do_val(unsafe_catch, Config), [{{t,small,2}, {{bs_put_integer,{f,0},{integer,16},1, - {field_flags,[unsigned,big]},{y,0}}, + {field_flags,[unsigned,big]},{y,0}}, 20, {unassigned,{y,0}}}}] = Errors, ok. @@ -223,7 +222,7 @@ bad_catch_try(Config) when is_list(Config) -> {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}}, {{bad_catch_try,bad_6,1}, {{move,{integer,1},{y,1}},7, - {invalid_store,{y,1},{integer,1}}}}] = Errors, + {invalid_store,{y,1}}}}] = Errors, ok. cons_guard(Config) when is_list(Config) -> @@ -247,7 +246,7 @@ freg_range(Config) when is_list(Config) -> {{t,sum_3,2}, {{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,-1}}, 7, - {bad_target,{fr,-1}}}}, + {bad_register,{fr,-1}}}}, {{t,sum_4,2}, {{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,1024}}, 7, diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 12108445f0..0038eb1a4b 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -25,7 +25,8 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, - wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1]). + wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1, + match_built_terms/1]). -include_lib("common_test/include/ct.hrl"). @@ -45,7 +46,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [recv,coverage,otp_7980,ref_opt,export,wait, - recv_in_try,double_recv,receive_var_zero]}]. + recv_in_try,double_recv,receive_var_zero, + match_built_terms]}]. init_per_suite(Config) -> @@ -400,5 +402,29 @@ receive_var_zero(Config) when is_list(Config) -> zero() -> 0. +%% ERL-862; the validator would explode when a term was constructed in a +%% receive guard. + +-define(MATCH_BUILT_TERM(Ref, Expr), + (fun() -> + Ref = make_ref(), + A = id($a), + B = id($b), + Built = id(Expr), + self() ! {Ref, A, B}, + receive + {Ref, A, B} when Expr =:= Built -> + ok + after 5000 -> + ct:fail("Failed to match message with term built in " + "receive guard.") + end + end)()). + +match_built_terms(Config) when is_list(Config) -> + ?MATCH_BUILT_TERM(Ref, [A, B]), + ?MATCH_BUILT_TERM(Ref, {A, B}), + ?MATCH_BUILT_TERM(Ref, <<A, B>>), + ?MATCH_BUILT_TERM(Ref, #{ 1 => A, 2 => B}). id(I) -> I. diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index 8b320e01a9..988d95a8bc 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -7,7 +7,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ crypto_bench_SUITE \ - blowfish_SUITE \ crypto_SUITE \ engine_SUITE diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl deleted file mode 100644 index a931ebb47e..0000000000 --- a/lib/crypto/test/blowfish_SUITE.erl +++ /dev/null @@ -1,300 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(blowfish_SUITE). - -%% Note: This directive should only be used in test suites. --compile(export_all). - --include_lib("common_test/include/ct.hrl"). - --define(TIMEOUT, 120000). % 2 min - --define(KEY, to_bin("0123456789ABCDEFF0E1D2C3B4A59687")). --define(IVEC, to_bin("FEDCBA9876543210")). -%% "7654321 Now is the time for " (includes trailing '\0') --define(DATA, to_bin("37363534333231204E6F77206973207468652074696D6520666F722000")). --define(DATA_PADDED, to_bin("37363534333231204E6F77206973207468652074696D6520666F722000000000")). - -%% Test server callback functions -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initialization before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- -init_per_suite(Config) -> - case catch crypto:start() of - ok -> - catch ct:comment("~s",[element(3,hd(crypto:info_lib()))]), - catch ct:log("crypto:info_lib() -> ~p~n" - "crypto:supports() -> ~p~n" - "crypto:version() -> ~p~n" - ,[crypto:info_lib(), crypto:supports(), crypto:version()]), - Config; - _Else -> - {skip,"Could not start crypto!"} - end. - -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- -end_per_suite(_Config) -> - crypto:stop(). - -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initialization before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%% Description: Initialization before each test case -%%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config0) -> - Config = lists:keydelete(watchdog, 1, Config0), - Dog = test_server:timetrap(?TIMEOUT), - [{watchdog, Dog} | Config]. - -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- -end_per_testcase(_TestCase, Config) -> - Dog = ?config(watchdog, Config), - case Dog of - undefined -> - ok; - _ -> - test_server:timetrap_cancel(Dog) - end. - -%%-------------------------------------------------------------------- -%% Function: all(Clause) -> TestCases -%% Clause - atom() - suite | doc -%% TestCases - [Case] -%% Case - atom() -%% Name of a test case. -%% Description: Returns a list of all test cases in this test suite -%%-------------------------------------------------------------------- -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> -[{group, fips}, - {group, non_fips}]. - -groups() -> - [{fips, [], [no_ecb, no_cbc, no_cfb64, no_ofb64]}, - {non_fips, [], [ecb, cbc, cfb64, ofb64]}]. - -init_per_group(fips, Config) -> - case crypto:info_fips() of - enabled -> - Config; - not_enabled -> - case crypto:enable_fips_mode(true) of - true -> - enabled = crypto:info_fips(), - Config; - false -> - {skip, "Failed to enable FIPS mode"} - end; - not_supported -> - {skip, "FIPS mode not supported"} - end; -init_per_group(non_fips, Config) -> - case crypto:info_fips() of - enabled -> - true = crypto:enable_fips_mode(false), - not_enabled = crypto:info_fips(), - Config; - _NotEnabled -> - Config - end; -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%% Test cases start here. -%%-------------------------------------------------------------------- - -ecb_test(KeyBytes, ClearBytes, CipherBytes) -> - {Key, Clear, Cipher} = - {to_bin(KeyBytes), to_bin(ClearBytes), to_bin(CipherBytes)}, - ?line m(crypto:block_encrypt(blowfish_ecb, Key, Clear), Cipher), - true. - -ecb(doc) -> - "Test that ECB mode is OK"; -ecb(suite) -> - []; -ecb(Config) when is_list(Config) -> - true = ecb_test("0000000000000000", "0000000000000000", "4EF997456198DD78"), - true = ecb_test("FFFFFFFFFFFFFFFF", "FFFFFFFFFFFFFFFF", "51866FD5B85ECB8A"), - true = ecb_test("3000000000000000", "1000000000000001", "7D856F9A613063F2"), - true = ecb_test("1111111111111111", "1111111111111111", "2466DD878B963C9D"), - true = ecb_test("0123456789ABCDEF", "1111111111111111", "61F9C3802281B096"), - true = ecb_test("1111111111111111", "0123456789ABCDEF", "7D0CC630AFDA1EC7"), - true = ecb_test("0000000000000000", "0000000000000000", "4EF997456198DD78"), - true = ecb_test("FEDCBA9876543210", "0123456789ABCDEF", "0ACEAB0FC6A0A28D"), - true = ecb_test("7CA110454A1A6E57", "01A1D6D039776742", "59C68245EB05282B"), - true = ecb_test("0131D9619DC1376E", "5CD54CA83DEF57DA", "B1B8CC0B250F09A0"), - true = ecb_test("07A1133E4A0B2686", "0248D43806F67172", "1730E5778BEA1DA4"), - true = ecb_test("3849674C2602319E", "51454B582DDF440A", "A25E7856CF2651EB"), - true = ecb_test("04B915BA43FEB5B6", "42FD443059577FA2", "353882B109CE8F1A"), - true = ecb_test("0113B970FD34F2CE", "059B5E0851CF143A", "48F4D0884C379918"), - true = ecb_test("0170F175468FB5E6", "0756D8E0774761D2", "432193B78951FC98"), - true = ecb_test("43297FAD38E373FE", "762514B829BF486A", "13F04154D69D1AE5"), - true = ecb_test("07A7137045DA2A16", "3BDD119049372802", "2EEDDA93FFD39C79"), - true = ecb_test("04689104C2FD3B2F", "26955F6835AF609A", "D887E0393C2DA6E3"), - true = ecb_test("37D06BB516CB7546", "164D5E404F275232", "5F99D04F5B163969"), - true = ecb_test("1F08260D1AC2465E", "6B056E18759F5CCA", "4A057A3B24D3977B"), - true = ecb_test("584023641ABA6176", "004BD6EF09176062", "452031C1E4FADA8E"), - true = ecb_test("025816164629B007", "480D39006EE762F2", "7555AE39F59B87BD"), - true = ecb_test("49793EBC79B3258F", "437540C8698F3CFA", "53C55F9CB49FC019"), - true = ecb_test("4FB05E1515AB73A7", "072D43A077075292", "7A8E7BFA937E89A3"), - true = ecb_test("49E95D6D4CA229BF", "02FE55778117F12A", "CF9C5D7A4986ADB5"), - true = ecb_test("018310DC409B26D6", "1D9D5C5018F728C2", "D1ABB290658BC778"), - true = ecb_test("1C587F1C13924FEF", "305532286D6F295A", "55CB3774D13EF201"), - true = ecb_test("0101010101010101", "0123456789ABCDEF", "FA34EC4847B268B2"), - true = ecb_test("1F1F1F1F0E0E0E0E", "0123456789ABCDEF", "A790795108EA3CAE"), - true = ecb_test("E0FEE0FEF1FEF1FE", "0123456789ABCDEF", "C39E072D9FAC631D"), - true = ecb_test("0000000000000000", "FFFFFFFFFFFFFFFF", "014933E0CDAFF6E4"), - true = ecb_test("FFFFFFFFFFFFFFFF", "0000000000000000", "F21E9A77B71C49BC"), - true = ecb_test("0123456789ABCDEF", "0000000000000000", "245946885754369A"), - true = ecb_test("FEDCBA9876543210", "FFFFFFFFFFFFFFFF", "6B5C5A9C5D9E0A5A"), - ok. - -cbc(doc) -> - "Test that CBC mode is OK"; -cbc(suite) -> - []; -cbc(Config) when is_list(Config) -> - true = crypto:block_encrypt(blowfish_cbc, ?KEY, ?IVEC, ?DATA_PADDED) =:= - to_bin("6B77B4D63006DEE605B156E27403979358DEB9E7154616D959F1652BD5FF92CC"), - ok. - -cfb64(doc) -> - "Test that CFB64 mode is OK"; -cfb64(suite) -> - []; -cfb64(Config) when is_list(Config) -> - true = crypto:block_encrypt(blowfish_cfb64, ?KEY, ?IVEC, ?DATA) =:= - to_bin("E73214A2822139CAF26ECF6D2EB9E76E3DA3DE04D1517200519D57A6C3"), - ok. - -ofb64(doc) -> - "Test that OFB64 mode is OK"; -ofb64(suite) -> - []; -ofb64(Config) when is_list(Config) -> - true = crypto:block_encrypt(blowfish_ofb64, ?KEY, ?IVEC, ?DATA) =:= - to_bin("E73214A2822139CA62B343CC5B65587310DD908D0C241B2263C2CF80DA"), - ok. - -no_ecb(doc) -> - "Test that ECB mode is disabled"; -no_ecb(suite) -> - []; -no_ecb(Config) when is_list(Config) -> - notsup(fun crypto:block_encrypt/3, - [blowfish_ecb, - to_bin("0000000000000000"), - to_bin("FFFFFFFFFFFFFFFF")]). - -no_cbc(doc) -> - "Test that CBC mode is disabled"; -no_cbc(suite) -> - []; -no_cbc(Config) when is_list(Config) -> - notsup(fun crypto:block_encrypt/4, - [blowfish_cbc, ?KEY, ?IVEC, ?DATA_PADDED]). - -no_cfb64(doc) -> - "Test that CFB64 mode is disabled"; -no_cfb64(suite) -> - []; -no_cfb64(Config) when is_list(Config) -> - notsup(fun crypto:block_encrypt/4, - [blowfish_cfb64, ?KEY, ?IVEC, ?DATA]), - ok. - -no_ofb64(doc) -> - "Test that OFB64 mode is disabled"; -no_ofb64(suite) -> - []; -no_ofb64(Config) when is_list(Config) -> - notsup(fun crypto:block_encrypt/4, - [blowfish_ofb64, ?KEY, ?IVEC, ?DATA]). - -%% Helper functions - -%% Assert function fails with notsup error -notsup(Fun, Args) -> - ok = try - {error, {return, apply(Fun, Args)}} - catch - error:notsup -> - ok; - Class:Error -> - {error, {Class, Error}} - end. - - -%% Convert a hexadecimal string to a binary. --spec(to_bin(L::string()) -> binary()). -to_bin(L) -> - to_bin(L, []). - -%% @spec dehex(char()) -> integer() -%% @doc Convert a hex digit to its integer value. --spec(dehex(char()) -> integer()). -dehex(C) when C >= $0, C =< $9 -> - C - $0; -dehex(C) when C >= $a, C =< $f -> - C - $a + 10; -dehex(C) when C >= $A, C =< $F -> - C - $A + 10. - --spec(to_bin(L::string(), list()) -> binary()). -to_bin([], Acc) -> - iolist_to_binary(lists:reverse(Acc)); -to_bin([C1, C2 | Rest], Acc) -> - to_bin(Rest, [(dehex(C1) bsl 4) bor dehex(C2) | Acc]). - -m(X,X) -> ok. diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index c4323de83f..ab6d88deb2 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -101,6 +101,8 @@ groups() -> {group, rsa}, {group, dss}, {group, ecdsa}, + {group, no_ed25519}, + {group, no_ed448}, {group, dh}, {group, ecdh}, {group, no_srp}, @@ -115,8 +117,8 @@ groups() -> {group, no_blowfish_cfb64}, {group, no_blowfish_ofb64}, {group, aes_cbc128}, - {group, aes_cfb8}, - {group, aes_cfb128}, + {group, no_aes_cfb8}, + {group, no_aes_cfb128}, {group, aes_cbc256}, {group, no_aes_ige256}, {group, no_rc2_cbc}, @@ -187,8 +189,16 @@ groups() -> {chacha20, [], [stream]}, {poly1305, [], [poly1305]}, {aes_cbc, [], [block]}, + {no_aes_cfb8,[], [no_support, no_block]}, + {no_aes_cfb128,[], [no_support, no_block]}, {no_md4, [], [no_support, no_hash]}, {no_md5, [], [no_support, no_hash, no_hmac]}, + {no_ed25519, [], [no_support, no_sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {no_ed448, [], [no_support, no_sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, {no_ripemd160, [], [no_support, no_hash]}, {no_srp, [], [no_support, no_generate_compute]}, {no_des_cbc, [], [no_support, no_block]}, @@ -255,7 +265,7 @@ init_per_group(fips, Config) -> enabled = crypto:info_fips(), FIPSConfig; false -> - {skip, "Failed to enable FIPS mode"} + {fail, "Failed to enable FIPS mode"} end; not_supported -> {skip, "FIPS mode not supported"} @@ -405,17 +415,6 @@ block() -> block(Config) when is_list(Config) -> Fips = proplists:get_bool(fips, Config), Type = ?config(type, Config), - %% See comment about EVP_CIPHER_CTX_set_key_length in - %% block_crypt_nif in crypto.c. - case {Fips, Type} of - {true, aes_cfb8} -> - throw({skip, "Cannot test aes_cfb8 in FIPS mode because of key length issue"}); - {true, aes_cfb128} -> - throw({skip, "Cannot test aes_cfb128 in FIPS mode because of key length issue"}); - _ -> - ok - end, - Blocks = lazy_eval(proplists:get_value(block, Config)), lists:foreach(fun block_cipher/1, Blocks), lists:foreach(fun block_cipher/1, block_iolistify(Blocks)), @@ -504,6 +503,13 @@ sign_verify(Config) when is_list(Config) -> SignVerify = proplists:get_value(sign_verify, Config), lists:foreach(fun do_sign_verify/1, SignVerify). +%%-------------------------------------------------------------------- +no_sign_verify() -> + [{doc, "Test disabled sign/verify digital signatures"}]. +no_sign_verify(Config) when is_list(Config) -> + [SignVerifyHd|_] = proplists:get_value(sign_verify, Config), + notsup(fun do_sign_verify/1, [SignVerifyHd]). + %%-------------------------------------------------------------------- public_encrypt() -> [{doc, "Test public_encrypt/decrypt "}]. diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index b641118c5d..e9d62d3283 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -578,7 +578,7 @@ read_source(Name, Opts0) -> Opts = expand_opts(Opts0), case read_source_1(Name, Opts) of {ok, Forms} -> - check_forms(Forms, Name), + check_forms(Forms, Name, Opts), Forms; {error, R} -> edoc_report:error({"error reading file '~ts'.", @@ -692,13 +692,19 @@ fll([T | L], LastLine, Ts) -> fll(L, _LastLine, Ts) -> lists:reverse(L, Ts). -check_forms(Fs, Name) -> +check_forms(Fs, Name, Opts) -> Fun = fun (F) -> case erl_syntax:type(F) of error_marker -> case erl_syntax:error_marker_info(F) of {L, M, D} -> - edoc_report:error(L, Name, {format_error, M, D}); + edoc_report:error(L, Name, {format_error, M, D}), + case proplists:get_bool(preprocess, Opts) of + true -> + ok; + false -> + helpful_message(Name) + end; Other -> edoc_report:report(Name, "unknown error in " "source code: ~w.", [Other]) @@ -710,6 +716,11 @@ check_forms(Fs, Name) -> end, lists:foreach(Fun, Fs). +helpful_message(Name) -> + Ms = ["If the error is caused by too exotic macro", + "definitions or uses of macros, adding option", + "{preprocess, true} can help. See also edoc(3)."], + lists:foreach(fun(M) -> edoc_report:report(Name, M, []) end, Ms). %% @spec get_doc(File::filename()) -> {ModuleName, edoc_module()} %% @equiv get_doc(File, []) |