From 2ff88fe3687c4728e58cf7ac7e008ef7c5be1320 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 20 Apr 2015 14:40:05 +0200 Subject: sys_pre_expand: Remove unused fields in #expand{} record The compile, bitdefault, and bittypes records are not really used in the #expand{} record. --- lib/compiler/src/sys_pre_expand.erl | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index f99307c865..6cc849a9d5 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -38,7 +38,6 @@ -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports - compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks optional_callbacks=[] :: [fa()], %Optional callbacks @@ -46,9 +45,7 @@ vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function - fcount=0, %Local fun count - bitdefault, - bittypes + fcount=0 %Local fun count }). %% module(Forms, CompileOptions) @@ -69,15 +66,12 @@ module(Fs0, Opts0) -> %% Build initial expand record. St0 = #expand{exports=PreExp, - compile=Opts, - defined=PreExp, - bitdefault = erl_bits:system_bitdefault(), - bittypes = erl_bits:system_bittypes() + defined=PreExp }, %% Expand the functions. {Tfs,St1} = forms(Fs, define_functions(Fs, St0)), %% Get the correct list of exported functions. - Exports = case member(export_all, St1#expand.compile) of + Exports = case member(export_all, Opts) of true -> gb_sets:to_list(St1#expand.defined); false -> St1#expand.exports end, @@ -85,7 +79,7 @@ module(Fs0, Opts0) -> {Ats,St3} = module_attrs(St1#expand{exports = Exports}), {Mfs,St4} = module_predef_funcs(St3), {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, - St4#expand.compile}. + Opts}. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -- cgit v1.2.3 From 7effd4c9efc42d7afcef6390d18617e7e97275e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 21 Apr 2015 08:09:22 +0200 Subject: beam_validator: Correct merging of y registers When merging y registers, only the y registers that are found in both states should be retained. --- lib/compiler/src/beam_validator.erl | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index c55919dc73..ed94880d38 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1398,20 +1398,24 @@ merge_regs_1([], [_|_]) -> []; merge_regs_1([_|_], []) -> []. merge_y_regs(Rs0, Rs1) -> - Rs = merge_y_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)), - gb_trees_from_list(Rs). + 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([Same|Rs1], [Same|Rs2]) -> - [Same|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> - [{R1,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> - [{R2,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([], []) -> []; -merge_y_regs_1([], [_|_]=Rs) -> Rs; -merge_y_regs_1([_|_]=Rs, []) -> Rs. +merge_y_regs_1(Y, S, Regs0) when Y >= 0 -> + Type0 = gb_trees:get(Y, Regs0), + case gb_trees:get(Y, S) of + Type0 -> + merge_y_regs_1(Y-1, S, Regs0); + Type1 -> + Type = merge_types(Type0, Type1), + Regs = gb_trees:update(Y, Type, Regs0), + merge_y_regs_1(Y-1, S, Regs) + end; +merge_y_regs_1(_, _, Regs) -> Regs. %% merge_types(Type1, Type2) -> Type %% Return the most specific type possible. -- cgit v1.2.3 From 94a33dfb4becbf5ce4da487ac50cfa9d9d760708 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 21 Apr 2015 08:37:24 +0200 Subject: beam_validator: Correct merging of states When merging two states, the following fields should be merged between the states: #st.x, #st.y, #st.numy, #st.ct. Everything else should be set to the default values in a new state. --- lib/compiler/src/beam_validator.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index ed94880d38..d642bf9867 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1362,13 +1362,13 @@ merge_states(L, St, Branched) when L =/= 0 -> {value,OtherSt} -> merge_states_1(St, OtherSt) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}=St, +merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}, #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> NumY = merge_stk(NumY0, NumY1), Xs = merge_regs(Xs0, Xs1), Ys = merge_y_regs(Ys0, Ys1), Ct = merge_ct(Ct0, Ct1), - St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. + #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. -- cgit v1.2.3 From 16d97a57e5cd0f820884e4223b92f50e3ce39b01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 21 Apr 2015 09:27:40 +0200 Subject: beam_validator: Remove support for removed BIF fault/1,2 The fault/1,2 BIF was removed a long time ago. --- lib/compiler/src/beam_validator.erl | 2 -- .../test/beam_validator_SUITE_data/state_after_fault_in_catch.S | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index d642bf9867..c758a6095a 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1634,8 +1634,6 @@ return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> return_type_erl(exit, 1) -> exception; return_type_erl(throw, 1) -> exception; -return_type_erl(fault, 1) -> exception; -return_type_erl(fault, 2) -> exception; return_type_erl(error, 1) -> exception; return_type_erl(error, 2) -> exception; return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. diff --git a/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S b/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S index 8e27347ed5..c3656d6218 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S +++ b/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S @@ -14,7 +14,7 @@ {allocate,1,0}. {'catch',{y,0},{f,3}}. {move,{atom,apa},{x,0}}. - {call_ext,1,{extfunc,erlang,fault,1}}. + {call_ext,1,{extfunc,erlang,error,1}}. {label,3}. {catch_end,{y,0}}. {move,{x,1},{x,0}}. -- cgit v1.2.3 From edef41b07fea925d13f0b4eb6d122793ca9c075d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 21 Apr 2015 09:43:41 +0200 Subject: beam_validator: Clean up updating of types for y register set_type_y/3 is far too complicated. Note that we don't need to check the #st.numy field, because we will detect the error anyway because the information for the y register will be missing in the #st.y gb_tree. There is also a clause that would never match because of a spelling error (the first "n" was missing in "uninitialized"). That clause is not needed because the default clause will do fine. Furthermore, we can break out the special case for handling catch_end and similar instructions into a new function. --- lib/compiler/src/beam_validator.erl | 65 +++++++++------------- lib/compiler/test/beam_validator_SUITE.erl | 29 +++++----- .../test/beam_validator_SUITE_data/bad_catch_try.S | 8 +-- 3 files changed, 45 insertions(+), 57 deletions(-) diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index c758a6095a..ce6cd60ab1 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -411,37 +411,33 @@ valfun_1({'try',Dst,{f,Fail}}, Vst0) -> Vst = #vst{current=#st{ct=Fails}=St} = set_type_y({trytag,[Fail]}, Dst, Vst0), Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> case get_special_y_type(Reg, Vst0) of {catchtag,Fail} -> - Vst = #vst{current=St} = - set_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), + Vst = #vst{current=St} = set_catch_end(Reg, Vst0), Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; Type -> error({bad_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> case get_special_y_type(Reg, Vst0) of {trytag,Fail} -> Vst = case Fail of [FailLabel] -> branch_state(FailLabel, Vst0); _ -> Vst0 end, - set_type_reg(initialized_ct, Reg, - Vst#vst{current=St#st{ct=Fails,fls=undefined}}); + St = St0#st{ct=Fails,fls=undefined}, + set_catch_end(Reg, Vst#vst{current=St}); Type -> error({bad_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> case get_special_y_type(Reg, Vst0) of {trytag,Fail} -> - Vst = #vst{current=St} = - set_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), %XXX - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + Vst = #vst{current=St} = set_catch_end(Reg, Vst0), + Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; Type -> error({bad_type,Type}) end; @@ -1135,35 +1131,26 @@ set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) set_type_reg(Type, Reg, Vst) -> set_type_y(Type, Reg, Vst). -set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0,numy=NumY}=St}=Vst) +set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) when is_integer(Y), 0 =< Y -> limit_check(Y), - case {Y,NumY} of - {_,none} -> - error({no_stack_frame,Reg}); - {_,_} when Y > NumY -> - error({y_reg_out_of_range,Reg,NumY}); - {_,_} -> - Ys = if Type =:= initialized_ct -> - gb_trees:enter(Y, initialized, Ys0); - true -> - case gb_trees:lookup(Y, Ys0) of - none -> - gb_trees:insert(Y, Type, Ys0); - {value,uinitialized} -> - gb_trees:insert(Y, Type, Ys0); - {value,{catchtag,_}=Tag} -> - error(Tag); - {value,{trytag,_}=Tag} -> - error(Tag); - {value,_} -> - gb_trees:update(Y, Type, Ys0) - end - end, - Vst#vst{current=St#st{y=Ys}} - end; + 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, + Vst#vst{current=St#st{y=Ys}}; set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}). +set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) -> + Ys = gb_trees:update(Y, initialized, Ys0), + Vst#vst{current=St#st{y=Ys}}. + assert_term(Src, Vst) -> get_term_type(Src, Vst), ok. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 551cf7661b..6779a2cfec 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -211,20 +211,21 @@ accessing_tags(Config) when is_list(Config) -> bad_catch_try(Config) when is_list(Config) -> Errors = do_val(bad_catch_try, Config), - ?line [{{bad_catch_try,bad_1,1}, - {{'catch',{x,0},{f,3}}, - 5,{invalid_store,{x,0},{catchtag,[3]}}}}, - {{bad_catch_try,bad_2,1}, - {{catch_end,{x,9}}, - 8,{source_not_y_reg,{x,9}}}}, - {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, - {{bad_catch_try,bad_4,1}, - {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, - {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{bad_type,term}}}, - {{bad_catch_try,bad_6,1}, - {{try_end,{y,1}},8,{bad_type,{integer,1}}}}] = Errors, + [{{bad_catch_try,bad_1,1}, + {{'catch',{x,0},{f,3}}, + 5,{invalid_store,{x,0},{catchtag,[3]}}}}, + {{bad_catch_try,bad_2,1}, + {{catch_end,{x,9}}, + 8,{source_not_y_reg,{x,9}}}}, + {{bad_catch_try,bad_3,1}, + {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, + {{bad_catch_try,bad_4,1}, + {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, + {{bad_catch_try,bad_5,1}, + {{try_case,{y,1}},12,{bad_type,term}}}, + {{bad_catch_try,bad_6,1}, + {{move,{integer,1},{y,1}},7, + {invalid_store,{y,1},{integer,1}}}}] = Errors, ok. cons_guard(Config) when is_list(Config) -> diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S b/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S index 2a53f0dd93..6035f23506 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S @@ -63,11 +63,11 @@ {label,9}. {func_info,{atom,bad_catch_try},{atom,bad_3},1}. {label,10}. - {allocate,1,1}. + {allocate,2,1}. + {move,{atom,kalle},{y,1}}. {'catch',{y,0},{f,11}}. {call,1,{f,26}}. {label,11}. - {move,{atom,kalle},{y,1}}. {catch_end,{y,1}}. {test,is_tuple,{f,12},[{x,0}]}. {test,test_arity,{f,12},[{x,0},2]}. @@ -106,7 +106,7 @@ {label,17}. {func_info,{atom,bad_catch_try},{atom,bad_5},1}. {label,18}. - {allocate_zero,1,1}. + {allocate_zero,2,1}. {'try',{y,0},{f,19}}. {call,1,{f,26}}. {try_end,{y,0}}. @@ -131,7 +131,7 @@ {'try',{y,0},{f,23}}. {call,1,{f,26}}. {move,{integer,1},{y,1}}. - {try_end,{y,1}}. + {try_end,{y,0}}. {move,{atom,ok},{x,0}}. {jump,{f,24}}. {label,23}. -- cgit v1.2.3 From 8c32dda686d2b964b08cc4614ba9c445039b3dd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 23 Apr 2015 07:29:41 +0200 Subject: beam_validator: Stop validating the 'aligned' flag for binaries The run-time system stopped paying attention the 'aligned' flag in bit syntax construction and matching when bitstrings were introduced in language. The beam_asm compiler pass will crash if the 'aligned' flag is given in bit syntax instructions. beam_validator still validates the 'aligned' flag. Before 912fea0b712a (which removed the possibility to validate existing BEAM files), the 'aligned' flag could actually be encountered when validating a BEAM file. Since the validation of 'aligned' no longer serves any useful purpose, remove the validation code. --- lib/compiler/src/beam_validator.erl | 99 +++++----------------- lib/compiler/test/beam_validator_SUITE.erl | 19 +---- .../test/beam_validator_SUITE_data/bin_aligned.S | 47 ---------- .../test/beam_validator_SUITE_data/unsafe_catch.S | 8 +- 4 files changed, 27 insertions(+), 146 deletions(-) delete mode 100644 lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index ce6cd60ab1..780826b126 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -28,7 +28,7 @@ -include("beam_disasm.hrl"). --import(lists, [reverse/1,foldl/3,foreach/2,member/2,dropwhile/2]). +-import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). -define(MAXREG, 1024). @@ -153,7 +153,6 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> hf=0, %Available heap size for floats. fls=undefined, %Floating point state. ct=[], %List of hot catch/try labels - bits=undefined, %Number of bits in bit syntax binary. setelem=false %Previous instruction was setelement/3. }). @@ -696,8 +695,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -709,8 +707,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -718,43 +715,35 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bits, Vst0), assert_term(Bin, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = bs_zero_bits(Vst1), + Vst = branch_state(Fail, Vst0), set_type_reg(binary, Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; -valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf8,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf16,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf32,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -1067,55 +1056,7 @@ bsm_restore(Reg, SavePoint, Vst) -> end; _ -> error({illegal_restore,SavePoint,range}) end. - - -%%% -%%% Validation of alignment in the bit syntax. (Currently, construction only.) -%%% -%%% We make sure that the aligned flag is only set when we can be sure of the -%%% aligment. -%%% -bs_zero_bits(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{bits=0}}. - -bs_align_check({bs_put_utf8,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf16,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf32,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({_,_,Sz,U,Flags,_}, #vst{current=#st{bits=Bits}=St}=Vst) -> - bs_verify_flags(Flags, St), - bs_update_bits(Bits, Sz, U, St, Vst). - -bs_update_bits(undefined, _, _, _, Vst) -> Vst; -bs_update_bits(Bits0, {integer,Sz}, U, St, Vst) -> - Bits = Bits0 + U*Sz, - Vst#vst{current=St#st{bits=Bits}}; -bs_update_bits(_, {atom,all}, _, _, Vst) -> - %% A binary will not change the alignment. - Vst; -bs_update_bits(_, _, U, _, Vst) when U rem 8 =:= 0 -> - %% Units of 8, 16, and so on will not change the aligment. - Vst; -bs_update_bits(_, _, _, St, Vst) -> - %% We can no longer be sure about aligment. - Vst#vst{current=St#st{bits=undefined}}. - -bs_verify_flags({field_flags,Fl}, #st{bits=Bits}) -> - case bs_is_aligned(Fl) of - false -> ok; - true when is_integer(Bits), Bits rem 8 =:= 0 -> ok; - true -> error({aligned_flag_set,{bits,Bits}}) - end. - -bs_is_aligned(Fl) when is_integer(Fl) -> Fl band 1 =:= 1; -bs_is_aligned(Fl) when is_list(Fl) -> member(aligned, Fl). - %%% %%% Keeping track of types. %%% diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 6779a2cfec..e64dd6b9c3 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -28,7 +28,7 @@ overwrite_catchtag/1,overwrite_trytag/1,accessing_tags/1,bad_catch_try/1, cons_guard/1, freg_range/1,freg_uninit/1,freg_state/1, - bad_bin_match/1,bin_aligned/1,bad_dsetel/1, + bad_bin_match/1,bad_dsetel/1, state_after_fault_in_catch/1,no_exception_in_catch/1, undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1]). @@ -57,7 +57,7 @@ groups() -> unsafe_catch,dead_code, overwrite_catchtag,overwrite_trytag,accessing_tags, bad_catch_try,cons_guard,freg_range,freg_uninit, - freg_state,bad_bin_match,bin_aligned,bad_dsetel, + freg_state,bad_bin_match,bad_dsetel, state_after_fault_in_catch,no_exception_in_catch, undef_label,illegal_instruction,failing_gc_guard_bif, map_field_lists]}]. @@ -178,7 +178,7 @@ unsafe_catch(Config) when is_list(Config) -> ?line [{{t,small,2}, {{bs_put_integer,{f,0},{integer,16},1, - {field_flags,[aligned,unsigned,big]},{y,0}}, + {field_flags,[unsigned,big]},{y,0}}, 20, {unassigned,{y,0}}}}] = Errors, ok. @@ -299,19 +299,6 @@ bad_bin_match(Config) when is_list(Config) -> do_val(bad_bin_match, Config), ok. -bin_aligned(Config) when is_list(Config) -> - Errors = do_val(bin_aligned, Config), - ?line - [{{t,decode,1}, - {{bs_put_integer,{f,0}, - {integer,5}, - 1, - {field_flags,[unsigned,big,aligned]}, - {integer,0}}, - 10, - {aligned_flag_set,{bits,3}}}}] = Errors, - ok. - bad_dsetel(Config) when is_list(Config) -> Errors = do_val(bad_dsetel, Config), ?line diff --git a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S b/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S deleted file mode 100644 index a59f7ccc03..0000000000 --- a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S +++ /dev/null @@ -1,47 +0,0 @@ -{module, bin_aligned}. %% version = 0 - -{exports, [{decode,1},{module_info,0},{module_info,1}]}. - -{attributes, []}. - -{labels, 7}. - - -{function, decode, 1, 2}. - {label,1}. - {func_info,{atom,t},{atom,decode},1}. - {label,2}. - {move,{integer,1},{x,1}}. - {bif,size,{f,0},[{x,0}],{x,2}}. - {bs_add,{f,0},[{x,1},{x,2},1],{x,1}}. - {bs_init2,{f,0},{x,1},0,1,{field_flags,[]},{x,1}}. - {bs_put_integer,{f,0}, - {integer,3}, - 1, - {field_flags,[aligned,unsigned,big]}, - {integer,0}}. - {bs_put_binary,{f,0},{atom,all},8,{field_flags,[unsigned,big]},{x,0}}. - {bs_put_integer,{f,0}, - {integer,5}, - 1, - {field_flags,[unsigned,big,aligned]}, - {integer,0}}. - {move,{x,1},{x,0}}. - return. - - -{function, module_info, 0, 4}. - {label,3}. - {func_info,{atom,t},{atom,module_info},0}. - {label,4}. - {move,{atom,t},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - - -{function, module_info, 1, 6}. - {label,5}. - {func_info,{atom,t},{atom,module_info},1}. - {label,6}. - {move,{x,0},{x,1}}. - {move,{atom,t},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S b/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S index 500ac11377..f7d3f805b3 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S +++ b/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S @@ -17,7 +17,7 @@ {bs_put_integer,{f,0}, {integer,8}, 1, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {x,0}}. {move,{x,1},{y,0}}. {move,{x,2},{x,0}}. @@ -34,7 +34,7 @@ {bs_put_integer,{f,0}, {integer,16}, 1, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {y,0}}. {move,{x,0},{y,0}}. {move,{x,1},{x,0}}. @@ -55,12 +55,12 @@ {bs_put_binary,{f,0}, {atom,all}, 8, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {y,0}}. {bs_put_binary,{f,0}, {atom,all}, 8, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {x,0}}. {move,{x,1},{x,0}}. {deallocate,2}. -- cgit v1.2.3 From 61eaa7570811d81e2a91d0126461a2dac22786dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 21 Apr 2015 15:21:48 +0200 Subject: beam_utils: Be less conservative about liveness for exit instructions beam_utils used to be overly conservative about liveness for exit instructions such as: call_ext erlang:exit/1 beam_utils would consider all y registers to be used, to avoid overwriting a catch or try tag. That does not seem to be a real risk. However, we miss opportunities for stack trimming if we consider y registers used by an exit instruction. --- lib/compiler/src/beam_utils.erl | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index fd666be41e..fca13497ba 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -344,14 +344,10 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> false -> check_liveness(R, Is, St); true -> - %% We must make sure we don't check beyond this instruction - %% or we will fall through into random unrelated code and - %% get stuck in a loop. - %% - %% We don't want to overwrite a 'catch', so consider this - %% register in use. - %% - {used,St} + %% We must make sure we don't check beyond this + %% instruction or we will fall through into random + %% unrelated code and get stuck in a loop. + {killed,St} end end; check_liveness(R, [{call_fun,Live}|Is], St) -> -- cgit v1.2.3 From 5440c67570b9d436301cdb2f8234730a1fa8287f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 21 Apr 2015 17:47:01 +0200 Subject: Teach beam_trim to handle map instructions --- lib/compiler/src/beam_trim.erl | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index fad9c42584..8181e555a1 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -172,6 +172,10 @@ remap([{bif,Name,Fail,Ss,D}|Is], Map, Acc) -> remap([{gc_bif,Name,Fail,Live,Ss,D}|Is], Map, Acc) -> I = {gc_bif,Name,Fail,Live,[Map(S) || S <- Ss],Map(D)}, remap(Is, Map, [I|Acc]); +remap([{get_map_elements,Fail,M,{list,L0}}|Is], Map, Acc) -> + L = [Map(E) || E <- L0], + I = {get_map_elements,Fail,Map(M),{list,L}}, + remap(Is, Map, [I|Acc]); remap([{bs_init,Fail,Info,Live,Ss0,Dst0}|Is], Map, Acc) -> Ss = [Map(Src) || Src <- Ss0], Dst = Map(Dst0), @@ -275,6 +279,8 @@ frame_size([{kill,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{get_map_elements,{f,L},_,_}|Is], Safe) -> + frame_size_branch(L, Is, Safe); frame_size([{deallocate,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); -- cgit v1.2.3 From 808e43007754cb68dbe947ec6752698167b1c470 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 21 Apr 2015 18:00:27 +0200 Subject: beam_utils: Teach check_liveness/3 to understand get_map_elements Understanding get_map_elements improves the stack trimming done by beam_trim. --- lib/compiler/src/beam_utils.erl | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index fca13497ba..a0132b99e3 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -468,6 +468,22 @@ check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> check_liveness_at(R, Fail, St); check_liveness(R, [{line,_}|Is], St) -> check_liveness(R, Is, St); +check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> + {Ss,Ds} = split_even(L), + case member(R, [S|Ss]) of + true -> + {used,St0}; + false -> + case check_liveness_at(R, Fail, St0) of + {killed,St}=Killed -> + case member(R, Ds) of + true -> Killed; + false -> check_liveness(R, Is, St) + end; + Other -> + Other + end + end; check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> -- cgit v1.2.3 From d44be2bdc194e7c0afbf6fbd1de998aff097f030 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 23 Apr 2015 16:14:58 +0200 Subject: sys_core_fold: Suppress warnings better 86fbd6d76d strengthened type optimization in lets. As a result of the stronger optimizations, special care had to be taken to suppress false warnings. It turns out that false warnings can still slip through. Slapping on a 'compiler_generated' annotation at the top-level of a complex term such as #c_tuple{} may not suppress all warnings. We will need to go deeper into the term to eliminate all warnings. --- lib/compiler/src/sys_core_fold.erl | 25 +++++++++++++++++++++---- lib/compiler/test/warnings_SUITE.erl | 6 ++++++ 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index beab2ce897..6f8279f65e 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2532,18 +2532,35 @@ maybe_suppress_warnings(Arg, _, _, effect) -> %% Don't suppress any warnings in effect context. Arg; maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> - case suppress_warning(Arg) of + case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. false -> case is_any_var_used(Vs, PrevBody) of true -> - cerl:set_ann(Arg, [compiler_generated]); + suppress_warning([Arg]); false -> Arg end end. +%% Suppress warnings for a Core Erlang expression whose value will +%% be ignored. +suppress_warning([H|T]) -> + case cerl:is_literal(H) of + true -> + suppress_warning(T); + false -> + case cerl:is_data(H) of + true -> + suppress_warning(cerl:data_es(H) ++ T); + false -> + Arg = cerl:set_ann(H, [compiler_generated]), + cerl:c_seq(Arg, suppress_warning(T)) + end + end; +suppress_warning([]) -> void(). + move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, body=InnerArg0}=Outer, clauses=InnerClauses}=Inner, Sub) -> @@ -3093,7 +3110,7 @@ add_bin_opt_info(Core, Term) -> end. add_warning(Core, Term) -> - case suppress_warning(Core) of + case should_suppress_warning(Core) of true -> ok; false -> @@ -3118,7 +3135,7 @@ get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen -suppress_warning(Core) -> +should_suppress_warning(Core) -> is_compiler_generated(Core) orelse is_result_unwanted(Core). diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index e996a55db6..f6ba75577d 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -733,6 +733,12 @@ no_warnings(Config) when is_list(Config) -> false -> Var; true -> [] end. + + c() -> + R0 = {r,\"abc\",undefined,os:timestamp()}, %No warning. + case R0 of + {r,V1,_V2,V3} -> {r,V1,\"def\",V3} + end. ">>, [], []}], -- cgit v1.2.3 From 41c1f4c3eab54d776e2287cab09cc4ab0f7ee25e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 24 Apr 2015 07:40:11 +0200 Subject: cerl_inline: Replace old-style 'catch' with 'try'...'catch' Using 'try'...'catch' simplifies the code and improves coverage because we don't have to re-throw accidentally caught errors. --- lib/compiler/src/cerl_inline.erl | 61 ++++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 34 deletions(-) diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index f8489a800b..02cdb966ce 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -445,15 +445,14 @@ i_var_1(R, Opnd, Ctxt, Env, S) -> residualize_var(R, S); false -> S1 = st__mark_inner_pending(L, S), - case catch {ok, visit(Opnd, S1)} of - {ok, {E, S2}} -> + try visit(Opnd, S1) of + {E, S2} -> %% Note that we pass the current environment and %% context to `copy', but not the current renaming. S3 = st__clear_inner_pending(L, S2), - copy(R, Opnd, E, Ctxt, Env, S3); - {'EXIT', X} -> - exit(X); - X -> + copy(R, Opnd, E, Ctxt, Env, S3) + catch + throw:X -> %% If we use destructive update for the %% `inner-pending' flag, we must make sure to clear %% it also if we make a nonlocal return. @@ -1128,8 +1127,8 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> %% Note that we extract the results of argument expessions here; the %% expressions could still be sequences with side effects. Vs = [concrete(result(A)) || A <- As], - case catch {ok, apply(atom_val(M), atom_val(F), Vs)} of - {ok, V} -> + try apply(atom_val(M), atom_val(F), Vs) of + V -> %% Evaluation completed normally - try to turn the result %% back into a syntax tree (representing a literal). case is_literal_term(V) of @@ -1142,8 +1141,9 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> false -> %% The result could not be represented as a literal. i_call_4(M, F, As, E, Ctxt, Env, S) - end; - _ -> + end + catch + error:_ -> %% The evaluation attempt did not complete normally. i_call_4(M, F, As, E, Ctxt, Env, S) end. @@ -1736,12 +1736,11 @@ copy_1(R, Opnd, E, Ctxt, Env, S) -> copy_inline(R, Opnd, E, Ctxt, Env, S) -> S1 = st__mark_outer_pending(Opnd#opnd.loc, S), - case catch {ok, copy_inline_1(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> - {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)}; - {'EXIT', X} -> - exit(X); - X -> + try copy_inline_1(R, E, Ctxt, Env, S1) of + {E1, S2} -> + {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)} + catch + throw:X -> %% If we use destructive update for the `outer-pending' %% flag, we must make sure to clear it upon a nonlocal %% return. @@ -1758,19 +1757,16 @@ copy_inline_1(R, E, Ctxt, Env, S) -> copy_inline_2(R, E, Ctxt, Env, S); false -> S1 = new_active_effort(get_effort_limit(S), S), - case catch {ok, copy_inline_2(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> + try copy_inline_2(R, E, Ctxt, Env, S1) of + {E1, S2} -> %% Revert to the old effort counter. - {E1, revert_effort(S, S2)}; - {counter_exceeded, effort, _} -> + {E1, revert_effort(S, S2)} + catch + throw:{counter_exceeded, effort, _} -> %% Aborted this inlining attempt because too much %% effort was spent. Residualize the variable and %% revert to the previous state. - residualize_var(R, S); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S) end end. @@ -1796,11 +1792,12 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% close to zero at this point. (This is an extension to the %% original algorithm.) S1 = new_active_size(Limit + apply_size(length(Ctxt#app.opnds)), S), - case catch {ok, inline(E, Ctxt, ren__identity(), Env, S1)} of - {ok, {E1, S2}} -> + try inline(E, Ctxt, ren__identity(), Env, S1) of + {E1, S2} -> %% Revert to the old size counter. - {E1, revert_size(S, S2)}; - {counter_exceeded, size, S2} -> + {E1, revert_size(S, S2)} + catch + throw:{counter_exceeded, size, S2} -> %% Aborted this inlining attempt because it got too big. %% Residualize the variable and revert to the old size %% counter. (It is important that we do not also revert the @@ -1813,11 +1810,7 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% must make sure to clear the flags of any nested %% app-contexts upon aborting; see `inline' for details. S4 = reset_nested_apps(Ctxt, S3), % for effect - residualize_var(R, S4); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S4) end. reset_nested_apps(#app{ctxt = Ctxt, loc = L}, S) -> -- cgit v1.2.3 From 2838a341f074dbc4597d90af86e2dda6647dd083 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 24 Apr 2015 10:03:42 +0200 Subject: v3_core, v3_codegen: Eliminate old-style catches --- lib/compiler/src/v3_codegen.erl | 8 +++++--- lib/compiler/src/v3_core.erl | 6 +++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 15a54a5886..aa2ebc0f85 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -2140,9 +2140,11 @@ put_stack(Val, [free|Stk]) -> [{Val}|Stk]; put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)]. put_stack_carefully(Val, Stk0) -> - case catch put_stack_carefully1(Val, Stk0) of - error -> error; - Stk1 when is_list(Stk1) -> Stk1 + try + put_stack_carefully1(Val, Stk0) + catch + throw:error -> + error end. put_stack_carefully1(_, []) -> throw(error); diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index ed7b55df07..2d12d832a3 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -869,10 +869,10 @@ constant_bin_1(Es) -> ({float,_,F}, B) -> {value,F,B}; ({atom,_,undefined}, B) -> {value,undefined,B} end, - case catch eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of + try eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of {value,Bin,EmptyBindings} -> - Bin; - _ -> + Bin + catch error:_ -> error end. -- cgit v1.2.3 From d58c7c1021f2b9810ba9b52bd517f30de5be727e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 25 Apr 2015 07:18:49 +0200 Subject: beam_listing: Optimize writing of .S files The test suites generates listing files, so we can slightly speed up running of test suites (especially when running 'cover') by optimizing writing of .S files. --- lib/compiler/src/beam_listing.erl | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 50d1f3cdb1..726bb7f5eb 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -46,8 +46,8 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> fun ({function,Name,Arity,Entry,Asm}) -> io:format(Stream, "\n\n{function, ~w, ~w, ~w}.\n", [Name, Arity, Entry]), - foreach(fun(Op) -> print_op(Stream, Op) end, Asm) end, - Code); + io:put_chars(Stream, format_asm(Asm)) + end, Code); module(Stream, {Mod,Exp,Inter}) -> %% Other kinds of intermediate formats. io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]), @@ -56,10 +56,11 @@ module(Stream, [_|_]=Fs) -> %% Form-based abstract format. foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). -print_op(Stream, Label) when element(1, Label) == label -> - io:format(Stream, " ~p.\n", [Label]); -print_op(Stream, Op) -> - io:format(Stream, " ~p.\n", [Op]). +format_asm([{label,L}|Is]) -> + [" {label,",integer_to_list(L),"}.\n"|format_asm(Is)]; +format_asm([I|Is]) -> + [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)]; +format_asm([]) -> []. function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> io:nl(File), -- cgit v1.2.3 From 31779e0772006d822bb35b3f3fe0f0623d021aff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 25 Apr 2015 08:06:14 +0200 Subject: compilation_SUITE: Speed up the self_compile test cases It is not necessary to compile the compile three times. After the second compilation, we compare the generated .beam files with the .beam files that were used when compiling them. Doing one more round will not find more bugs. While we are it, remove the ?line macros and the unused make_current/1 function. --- lib/compiler/test/compilation_SUITE.erl | 55 +++++++++++++-------------------- 1 file changed, 22 insertions(+), 33 deletions(-) diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 51e1da2cb6..f570d94f7d 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -428,41 +428,35 @@ self_compile_old_inliner(Config) when is_list(Config) -> self_compile_1(Config, "old", [verbose,{inline,500}]). self_compile_1(Config, Prefix, Opts) -> - ?line Dog = test_server:timetrap(test_server:minutes(40)), + Dog = test_server:timetrap(test_server:minutes(40)), - ?line Priv = ?config(priv_dir,Config), - ?line Version = compiler_version(), + Priv = ?config(priv_dir,Config), + Version = compiler_version(), %% Compile the compiler. (In this node to get better coverage.) - ?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), - ?line VsnA = Version ++ ".0", + CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), + VsnA = Version ++ ".0", compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]), %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) CompilerB = Prefix++"compiler_b", CompB = make_compiler_dir(Priv, CompilerB), - ?line VsnB = VsnA ++ ".0", + VsnB = VsnA ++ ".0", self_compile_node(CompA, CompB, VsnB, Opts), - %% Compare compiler directories. - ?line compare_compilers(CompA, CompB), + %% Compare compiler directories. The compiler directories should + %% be equal (except for beam_asm that contains the compiler version). + compare_compilers(CompA, CompB), - %% Compile and compare compiler C. - ?line CompilerC = Prefix++"compiler_c", - ?line CompC = make_compiler_dir(Priv, CompilerC), - ?line VsnC = VsnB ++ ".0", - self_compile_node(CompB, CompC, VsnC, Opts), - ?line compare_compilers(CompB, CompC), - - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. self_compile_node(CompilerDir, OutDir, Version, Opts) -> - ?line Dog = test_server:timetrap(test_server:minutes(15)), - ?line Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ + Dog = test_server:timetrap(test_server:minutes(15)), + Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " -pa " ++ CompilerDir, - ?line Files = compiler_src(), + Files = compiler_src(), %% We don't want the cover server started on the other node, %% because it will load the same cover-compiled code as on this @@ -472,7 +466,7 @@ self_compile_node(CompilerDir, OutDir, Version, Opts) -> fun() -> compile_compiler(Files, OutDir, Version, Opts) end, Pa), - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. compile_compiler(Files, OutDir, Version, InlineOpts) -> @@ -499,27 +493,22 @@ compiler_modules(Dir) -> [list_to_atom(filename:rootname(filename:basename(F))) || F <- Files]. make_compiler_dir(Priv, Dir0) -> - ?line Dir = filename:join(Priv, Dir0), - ?line ok = file:make_dir(Dir), + Dir = filename:join(Priv, Dir0), + ok = file:make_dir(Dir), Dir. -make_current(Dir) -> - true = code:add_patha(Dir), - lists:foreach(fun(File) -> - c:l(File) - end, compiler_modules(Dir)), - io:format("~p\n", [code:which(compile)]). - compiler_version() -> - {value,{version,Version}} = lists:keysearch(version, 1, - compile:module_info(compile)), + {version,Version} = lists:keyfind(version, 1, + compile:module_info(compile)), Version. compare_compilers(ADir, BDir) -> {[],[],D} = beam_lib:cmp_dirs(ADir, BDir), - [] = [T || {A,_}=T <- D, - filename:basename(A) =/= "beam_asm.beam"]. %Contains compiler version. + %% beam_asm.beam contains compiler version and therefore it *must* + %% compare unequal. + ["beam_asm.beam"] = [filename:basename(A) || {A,_} <- D], + ok. %%% %%% The only test of the following code is that it compiles. -- cgit v1.2.3 From c64199f4fce6c47323014b29623f78d0b3aad24f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 26 Apr 2015 07:12:26 +0200 Subject: beam_asm: Speed up encoding of large numbers The misc_SUITE:integer_encoding/1 test case is annoyingly slow. Rewrite the encoding of integers in beam_asm to use the binary:encode_unsigned/1 BIF. Also tweak the test case itself. Scale the down the maximum size of the numbers being generated, but also add test of numbers around boundaries of power of two (which are the numbers most likely to expose bugs in the encoding). --- lib/compiler/src/beam_asm.erl | 44 ++++++++++++++++------------------------ lib/compiler/test/misc_SUITE.erl | 20 +++++++++++------- 2 files changed, 30 insertions(+), 34 deletions(-) diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 084686def7..73694b96ce 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -431,45 +431,35 @@ encode_alloc_list_1([], Dict, Acc) -> {iolist_to_binary(Acc),Dict}. encode(Tag, N) when N < 0 -> - encode1(Tag, negative_to_bytes(N, [])); + encode1(Tag, negative_to_bytes(N)); encode(Tag, N) when N < 16 -> (N bsl 4) bor Tag; encode(Tag, N) when N < 16#800 -> [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff]; encode(Tag, N) -> - encode1(Tag, to_bytes(N, [])). + encode1(Tag, to_bytes(N)). encode1(Tag, Bytes) -> - case length(Bytes) of + case iolist_size(Bytes) of Num when 2 =< Num, Num =< 8 -> [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes]; Num when 8 < Num -> [2#11111000 bor Tag, encode(?tag_u, Num-9)| Bytes] end. - -to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - 0 -> - to_bytes_1(N0, Acc); - N -> - to_bytes(N, binary_to_list(<>) ++ Acc) - end. - -to_bytes_1(0, [B|_]=Done) when B < 128 -> Done; -to_bytes_1(N, Acc) -> to_bytes(N bsr 8, [N band 16#ff|Acc]). - -negative_to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - -1 -> - negative_to_bytes_1(N0, Acc); - N -> - negative_to_bytes_1(N, binary_to_list(<>) ++ Acc) +to_bytes(N) -> + Bin = binary:encode_unsigned(N), + case Bin of + <<0:1,_/bits>> -> Bin; + <<1:1,_/bits>> -> [0,Bin] end. -negative_to_bytes_1(-1, [B1,_B2|_]=Done) when B1 > 127 -> - Done; -negative_to_bytes_1(N, Acc) -> - negative_to_bytes_1(N bsr 8, [N band 16#ff|Acc]). +negative_to_bytes(N) when N >= -16#8000 -> + <>; +negative_to_bytes(N) -> + Bytes = byte_size(binary:encode_unsigned(-N)), + Bin = <>, + case Bin of + <<0:1,_/bits>> -> [16#ff,Bin]; + <<1:1,_/bits>> -> Bin + end. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 68a31f14d5..f3b92aad5b 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -338,8 +338,16 @@ integer_encoding_1(Config) -> ?line do_integer_encoding(-(id(1) bsl 10000), Src, Data), ?line do_integer_encoding(id(1) bsl 10000, Src, Data), - ?line do_integer_encoding(2048, 0, Src, Data), - + do_integer_encoding(1024, 0, Src, Data), + _ = [begin + B = 1 bsl I, + do_integer_encoding(-B-1, Src, Data), + do_integer_encoding(-B, Src, Data), + do_integer_encoding(-B+1, Src, Data), + do_integer_encoding(B-1, Src, Data), + do_integer_encoding(B, Src, Data), + do_integer_encoding(B+1, Src, Data) + end || I <- lists:seq(1, 128)], io:put_chars(Src, "Last].\n\n"), ?line ok = file:close(Src), io:put_chars(Data, "0].\n\n"), @@ -372,11 +380,9 @@ do_integer_encoding(N, I0, Src, Data) -> do_integer_encoding(I, Src, Data) -> Str = integer_to_list(I), - io:put_chars(Src, Str), - io:put_chars(Src, ", \n"), - io:put_chars(Data, Str), - io:put_chars(Data, ", \n"). - + io:put_chars(Src, [Str,",\n"]), + io:put_chars(Data, [Str,",\n"]). + id(I) -> I. -- cgit v1.2.3 From cc322a3749218d1e704a351f8c815d653e8c24a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 26 Apr 2015 11:26:09 +0200 Subject: beam_utils: Re-use the local helper function drop_labels/1 In 8470558, the drop_labels/1 function was added to beam_utils as a minor optimization. Since the function is already available, we might as well use it in index_label/3 too. --- lib/compiler/src/beam_utils.erl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index a0132b99e3..b82bcd0e95 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -128,8 +128,7 @@ empty_label_index() -> %% Add an index for a label. index_label(Lbl, Is0, Acc) -> - Is = lists:dropwhile(fun({label,_}) -> true; - (_) -> false end, Is0), + Is = drop_labels(Is0), gb_trees:enter(Lbl, Is, Acc). -- cgit v1.2.3 From fa237854a74a24ac7b940b1333828d4fffec7b5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 26 Apr 2015 22:50:59 +0200 Subject: beam_dict: Correct comparison in opcode/2 The intention of the comparison is to avoid unnecessary updates of the ">=" instead of ">". With the ">" comparison, typically every line instruction would cause the #asm{} record to be updated. --- lib/compiler/src/beam_dict.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index ea51673fa3..68dc104dd3 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -65,7 +65,7 @@ new() -> %% Remember the highest opcode. -spec opcode(non_neg_integer(), bdict()) -> bdict(). -opcode(Op, Dict) when Dict#asm.highest_opcode > Op -> Dict; +opcode(Op, Dict) when Dict#asm.highest_opcode >= Op -> Dict; opcode(Op, Dict) -> Dict#asm{highest_opcode=Op}. %% Returns the highest opcode encountered. -- cgit v1.2.3 From f4adfc60acb46a86f49627397913b6841b744ed2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 27 Apr 2015 06:15:24 +0200 Subject: test_lib: Simplify uniq/0 Simplify the uniq/0 function by using erlang:unique_integer/1. --- lib/compiler/test/test_lib.erl | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index a5e2855f8c..4ffac95489 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -57,10 +57,8 @@ parallel() -> end. uniq() -> - U0 = erlang:ref_to_list(make_ref()), - U1 = re:replace(U0, "^#Ref", ""), - U = re:replace(U1, "[^[A-Za-z0-9_]+", "_", [global]), - re:replace(U, "_*$", "", [{return,list}]). + U = erlang:unique_integer([positive]), + "_" ++ integer_to_list(U). %% Retrieve the "interesting" compiler options (options for optimization %% and compatibility) for the given module. -- cgit v1.2.3