diff options
Diffstat (limited to 'lib/compiler/src')
-rw-r--r-- | lib/compiler/src/beam_asm.erl | 5 | ||||
-rw-r--r-- | lib/compiler/src/beam_bool.erl | 50 | ||||
-rw-r--r-- | lib/compiler/src/beam_dict.erl | 11 | ||||
-rw-r--r-- | lib/compiler/src/beam_validator.erl | 26 | ||||
-rw-r--r-- | lib/compiler/src/cerl.erl | 11 | ||||
-rw-r--r-- | lib/compiler/src/compile.erl | 24 | ||||
-rw-r--r-- | lib/compiler/src/rec_env.erl | 11 | ||||
-rw-r--r-- | lib/compiler/src/sys_core_dsetel.erl | 36 | ||||
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 6 | ||||
-rw-r--r-- | lib/compiler/src/sys_pre_expand.erl | 179 | ||||
-rw-r--r-- | lib/compiler/src/v3_codegen.erl | 58 | ||||
-rw-r--r-- | lib/compiler/src/v3_core.erl | 2 | ||||
-rw-r--r-- | lib/compiler/src/v3_kernel.erl | 17 |
13 files changed, 167 insertions, 269 deletions
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index a3201b0f4a..95be471de3 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -30,11 +30,12 @@ module(Code, Abst, SourceFile, Opts) -> {ok,assemble(Code, Abst, SourceFile, Opts)}. -assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> +assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), + Exp = cerl_sets:from_list(Exp0), {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts). @@ -61,7 +62,7 @@ insert_on_load_instruction(Is0, Entry) -> Bef ++ [El,on_load|Is]. assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) -> - Dict1 = case member({Name,Arity}, Exp) of + Dict1 = case cerl_sets:is_element({Name,Arity}, Exp) of true -> beam_dict:export(Name, Arity, Entry, Dict0); false -> diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index c9e103eae9..efd935f666 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -140,11 +140,6 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> - failed; - %% The optimization is not safe. (A register %% used by the instructions following the %% optimized code is either not assigned a @@ -213,37 +208,14 @@ ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> false -> throw(all_registers_not_killed); true -> ok end, - Same = assigned_same_value(Bl, NewCode), MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), - ordsets:union(MustBeKilled, Same)), + MustBeKilled), case none_used(MustBeUnused, OldIs, Fail, St) of false -> throw(registers_used); true -> ok end, ok. -%% assigned_same_value(OldCode, NewCodeReversed) -> [DestinationRegs] -%% Return an ordset with a list of all y registers that are always -%% assigned the same value in the old and new code. Currently, we -%% are very conservative in that we only consider identical move -%% instructions in the same order. -%% -assigned_same_value(Old, New) -> - case reverse(New) of - [{block,Bl}|_] -> - assigned_same_value(Old, Bl, []); - _ -> - ordsets:new() - end. - -assigned_same_value([{set,[{y,_}=D],[S],move}|T1], - [{set,[{y,_}=D],[S],move}|T2], Acc) -> - assigned_same_value(T1, T2, [D|Acc]); -assigned_same_value(_, _, Acc) -> - ordsets:from_list(Acc). - -update_fail_label([{set,_,_,move}=I|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [I|Acc]); update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> @@ -312,8 +284,6 @@ split_block_1(Is, Fail, ProhibitFailLabel) -> end end. -split_block_2([{set,_,_,move}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> @@ -341,8 +311,6 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); -dst_regs([{set,[D],_,move}|Is], Acc) -> - dst_regs(Is, [D|Acc]); dst_regs([_|Is], Acc) -> dst_regs(Is, Acc); dst_regs([], Acc) -> ordsets:from_list(Acc). @@ -409,13 +377,6 @@ bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> _Res -> throw(not_boolean_expr) end; -bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> - case {Src,Dst} of - {{tmp,_},_} -> throw(move); - {_,{tmp,_}} -> throw(move); - _ -> ok - end, - bopt_tree(Is, Forest, [Move|Pre]); bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> Ar = length(As), case safe_bool_op(N, Ar) of @@ -587,10 +548,6 @@ free_variables(Is) -> E = gb_sets:empty(), free_vars_1(Is, E, E, E). -free_vars_1([{set,Ds,As,move}|Is], F0, N0, A) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), N = gb_sets:union(N0, var_list(Ds)), @@ -630,8 +587,6 @@ free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. rename_regs(Is, Regs) -> rename_regs(Is, Regs, []). -rename_regs([{set,_,_,move}=I|Is], Regs, Acc) -> - rename_regs(Is, Regs, [I|Acc]); rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> Live = live_regs(Regs0), Ss = rename_sources(Ss0, Regs0), @@ -735,8 +690,7 @@ ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> Sub1 = gb_trees:update(R, NewReg, Sub0), Sub = gb_trees:insert(NewReg, NewReg, Sub1), Ssa#ssa{sub=Sub} - end; -ssa_assign(_, Ssa) -> Ssa. + end. ssa_sub_list(List, Sub) -> [ssa_sub(E, Sub) || E <- List]. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 2b5f8c1b7f..654fb47dbd 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -44,7 +44,7 @@ locals = [] :: [{label(), arity(), label()}], imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool - lambdas = [], %[{...}] + lambdas = {0,[]}, %[{...}] literals = dict:new() :: literal_tab(), fnames = #{} :: fname_tab(), lines = #{} :: line_tab(), @@ -145,15 +145,14 @@ string(Str, Dict) when is_list(Str) -> -spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) -> - OldIndex = length(Lambdas0), +lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) -> %% Set Index the same as OldIndex. Index = OldIndex, %% Initialize OldUniq to 0. It will be set to an unique value %% based on the MD5 checksum of the BEAM code for the module. OldUniq = 0, Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], - {OldIndex,Dict#asm{lambdas=Lambdas}}. + {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}. %% Returns the index for a literal (adding it to the literal table if necessary). %% literal(Literal, Dict) -> {Index,Dict'} @@ -236,13 +235,13 @@ string_table(#asm{strings=Strings,string_offset=Size}) -> -spec lambda_table(bdict()) -> {non_neg_integer(), [<<_:192>>]}. -lambda_table(#asm{locals=Loc0,lambdas=Lambdas0}) -> +lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) -> Lambdas1 = sofs:relation(Lambdas0), Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]), Lambdas2 = sofs:relative_product1(Lambdas1, Loc), Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> || {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)], - {length(Lambdas),Lambdas}. + {NumLambdas,Lambdas}. %% Returns the literal table. %% literal_table(Dict) -> {NumLiterals, [<<TermSize>>,TermInExternalFormat]} diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index cdace42a68..fd38fc0095 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -31,13 +31,6 @@ -import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). -%%-define(DEBUG, 1). --ifdef(DEBUG). --define(DBG_FORMAT(F, D), (io:format((F), (D)))). --else. --define(DBG_FORMAT(F, D), ok). --endif. - %% To be called by the compiler. module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> @@ -168,29 +161,18 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> % in the module (those that start with bs_start_match2). }). --ifdef(DEBUG). -print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) -> - io:format(" #st{x=~p~n" - " y=~p~n" - " numy=~p,h=~p,ct=~w~n", - [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]). --endif. - validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]}, Name, Arity, Entry, Ft) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls1), - ?DBG_FORMAT(" ~p.~n", [_F]), validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1, Ft); validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}). validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls2), Offset = 1 + length(Ls1) + 1 + length(Ls2), - EntryOK = (Entry =:= undefined) orelse lists:member(Entry, Ls2), + EntryOK = lists:member(Entry, Ls2), if EntryOK -> St = init_state(Arity), @@ -258,7 +240,6 @@ valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> error({MFA,Error}) end; valfun([I|Is], MFA, Offset, Vst0) -> - ?DBG_FORMAT(" ~p.\n", [I]), valfun(Is, MFA, Offset+1, try Vst = val_dsetel(I, Vst0), @@ -276,7 +257,6 @@ valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) -> valfun_1(_I, #vst{current=none}=Vst) -> %% Ignore instructions after erlang:error/1,2, which %% the original R10B compiler thought would return. - ?DBG_FORMAT("Ignoring ~p\n", [_I]), Vst; valfun_1({badmatch,Src}, Vst) -> assert_term(Src, Vst), @@ -1626,8 +1606,4 @@ min(A, B) when is_integer(A), is_integer(B) -> B. gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)). --ifdef(DEBUG). -error(Error) -> exit(Error). --else. error(Error) -> throw(Error). --endif. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 010327b5e3..e7a2b8177a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1598,13 +1598,20 @@ is_c_map(#c_literal{val = V}) when is_map(V) -> is_c_map(_) -> false. --spec map_es(c_map()) -> [c_map_pair()]. +-spec map_es(c_map() | c_literal()) -> [c_map_pair()]. +map_es(#c_literal{anno=As,val=M}) when is_map(M) -> + [ann_c_map_pair(As, + #c_literal{anno=As,val='assoc'}, + #c_literal{anno=As,val=K}, + #c_literal{anno=As,val=V}) || {K,V} <- maps:to_list(M)]; map_es(#c_map{es = Es}) -> Es. --spec map_arg(c_map()) -> c_map() | c_literal(). +-spec map_arg(c_map() | c_literal()) -> c_map() | c_literal(). +map_arg(#c_literal{anno=As,val=M}) when is_map(M) -> + #c_literal{anno=As,val=#{}}; map_arg(#c_map{arg=M}) -> M. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index a2a23a2b90..72f1a767ed 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -40,6 +40,8 @@ %%---------------------------------------------------------------------- +-type abstract_code() :: [erl_parse:abstract_form()]. + -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. -type err_info() :: {erl_anno:line() | 'none', @@ -48,6 +50,9 @@ -type warnings() :: [{file:filename(), [err_info()]}]. -type mod_ret() :: {'ok', module()} | {'ok', module(), cerl:c_module()} %% with option 'to_core' + | {'ok', %% with option 'to_pp' + module() | [], %% module() if 'to_exp' + abstract_code()} | {'ok', module(), warnings()}. -type bin_ret() :: {'ok', module(), binary()} | {'ok', module(), binary(), warnings()}. @@ -78,7 +83,11 @@ file(File, Opts) when is_list(Opts) -> file(File, Opt) -> file(File, [Opt|?DEFAULT_OPTIONS]). -forms(File) -> forms(File, ?DEFAULT_OPTIONS). +-spec forms(abstract_code()) -> comp_ret(). + +forms(Forms) -> forms(Forms, ?DEFAULT_OPTIONS). + +-spec forms(abstract_code(), [option()] | option()) -> comp_ret(). forms(Forms, Opts) when is_list(Opts) -> do_compile({forms,Forms}, [binary|Opts++env_default_opts()]); @@ -106,6 +115,8 @@ noenv_file(File, Opts) when is_list(Opts) -> noenv_file(File, Opt) -> noenv_file(File, [Opt|?DEFAULT_OPTIONS]). +-spec noenv_forms(abstract_code(), [option()] | option()) -> comp_ret(). + noenv_forms(Forms, Opts) when is_list(Opts) -> do_compile({forms,Forms}, [binary|Opts]); noenv_forms(Forms, Opt) when is_atom(Opt) -> @@ -1306,21 +1317,12 @@ generate_key(String) when is_list(String) -> encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> Bin1 = case byte_size(Bin0) rem BlockSize of 0 -> Bin0; - N -> list_to_binary([Bin0,random_bytes(BlockSize-N)]) + N -> list_to_binary([Bin0,crypto:rand_bytes(BlockSize-N)]) end, Bin = crypto:block_encrypt(Type, Key, IVec, Bin1), TypeString = atom_to_list(Type), list_to_binary([0,length(TypeString),TypeString,Bin]). -random_bytes(N) -> - _ = random:seed(erlang:time_offset(), - erlang:monotonic_time(), - erlang:unique_integer()), - random_bytes_1(N, []). - -random_bytes_1(0, Acc) -> Acc; -random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). - save_core_code(St) -> {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 0e9e12d1ad..5a4a870769 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -598,7 +598,16 @@ start_range(Env) -> %% (pseudo-)randomly distributed over the range. generate(_N, Range) -> - random:uniform(Range). % works well + %% We must use the same sequence of random variables to ensure + %% that two compilations of the same source code generates the + %% same BEAM code. + case rand:export_seed() of + undefined -> + rand:seed(exsplus, {1,42,2053}); + _ -> + ok + end, + rand:uniform(Range). % works well %% ===================================================================== diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index ac32db10fe..c6cfdbae7e 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -72,7 +72,7 @@ module(M0, _Options) -> {ok,M}. visit_module(#c_module{defs=Ds0}=R) -> - Env = dict:new(), + Env = #{}, Ds = visit_module_1(Ds0, Env, []), R#c_module{defs=Ds}. @@ -95,9 +95,11 @@ visit(Env, #c_var{name={_,_}}=R) -> {R, Env}; visit(Env0, #c_var{name=X}=R) -> %% There should not be any free variables. If there are, - %% the next line will cause an exception. - {ok, N} = dict:find(X, Env0), - {R, dict:store(X, N+1, Env0)}; + %% the case will fail with an exception. + case Env0 of + #{X:=N} -> + {R, Env0#{X:=N+1}} + end; visit(Env, #c_literal{}=R) -> {R, Env}; visit(Env0, #c_tuple{es=Es0}=R) -> @@ -203,7 +205,7 @@ bind_vars(Vs, Env) -> bind_vars(Vs, Env, []). bind_vars([#c_var{name=X}|Vs], Env0, Xs)-> - bind_vars(Vs, dict:store(X, 0, Env0), [X|Xs]); + bind_vars(Vs, Env0#{X=>0}, [X|Xs]); bind_vars([], Env,Xs) -> {Xs, Env}. @@ -217,7 +219,7 @@ visit_pats([], Env, Vs) -> {Vs, Env}. visit_pat(Env0, #c_var{name=V}, Vs) -> - {[V|Vs], dict:store(V, 0, Env0)}; + {[V|Vs], Env0#{V=>0}}; visit_pat(Env0, #c_tuple{es=Es}, Vs) -> visit_pats(Es, Env0, Vs); visit_pat(Env0, #c_map{es=Es}, Vs) -> @@ -235,23 +237,25 @@ visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) -> case Sz of #c_var{name=V} -> %% We don't tolerate free variables. - {ok, N} = dict:find(V, Env0), - {Vs0, dict:store(V, N+1, Env0)}; + case Env0 of + #{V:=N} -> + {Vs0, Env0#{V:=N+1}} + end; _ -> visit_pat(Env0, Sz, Vs0) end, visit_pat(Env1, Val, Vs1); visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) -> - visit_pat(dict:store(V, 0, Env0), P, [V|Vs]); + visit_pat(Env0#{V=>0}, P, [V|Vs]); visit_pat(Env, #c_literal{}, Vs) -> {Vs, Env}. restore_vars([V|Vs], Env0, Env1) -> - case dict:find(V, Env0) of - {ok, N} -> - restore_vars(Vs, Env0, dict:store(V, N, Env1)); - error -> - restore_vars(Vs, Env0, dict:erase(V, Env1)) + case Env0 of + #{V:=N} -> + restore_vars(Vs, Env0, Env1#{V=>N}); + _ -> + restore_vars(Vs, Env0, maps:remove(V, Env1)) end; restore_vars([], _, Env1) -> Env1. @@ -349,8 +353,8 @@ is_safe(#c_literal{}) -> true; is_safe(_) -> false. is_single_use(V, Env) -> - case dict:find(V, Env) of - {ok, 1} -> + case Env of + #{V:=1} -> true; _ -> false diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 0a16776bd4..43ce9a7172 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -3097,12 +3097,12 @@ bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) -> bsm_ensure_no_partition_2([_|Ps], N, G, _, S) -> bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S). -bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) -> +bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) -> case nth(Pos, Ps) of #c_var{} -> bsm_ensure_no_partition_after(Cs, Pos); - P -> - bsm_problem(P, bin_partition) + _ -> + bsm_problem(C, bin_partition) end; bsm_ensure_no_partition_after([], _) -> ok. diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index d9cc4b530c..7ab4e1845c 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -29,30 +29,26 @@ %% Main entry point. -export([module/2]). --import(ordsets, [from_list/1,union/2]). -import(lists, [member/2,foldl/3,foldr/3]). --include("../include/erl_bits.hrl"). - -type fa() :: {atom(), arity()}. -record(expand, {module=[], %Module name exports=[], %Exports - imports=[], %Imports attributes=[], %Attributes callbacks=[], %Callbacks optional_callbacks=[] :: [fa()], %Optional callbacks - defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function - fcount=0 %Local fun count + fcount=0, %Local fun count + ctype %Call type map }). %% module(Forms, CompileOptions) %% {ModuleName,Exports,TransformedForms,CompileOptions'} -%% Expand the forms in one module. N.B.: the lists of predefined -%% exports and imports are really ordsets! +%% Expand the forms in one module. +%% %% CompileOptions is augmented with options from -compile attributes. module(Fs0, Opts0) -> @@ -65,19 +61,28 @@ module(Fs0, Opts0) -> %% Set pre-defined exported functions. PreExp = [{module_info,0},{module_info,1}], + %% Build the set of defined functions and the initial call + %% type map. + Defined = defined_functions(Fs, PreExp), + Ctype = maps:from_list([{K,local} || K <- Defined]), + %% Build initial expand record. St0 = #expand{exports=PreExp, - defined=PreExp + ctype=Ctype }, + %% Expand the functions. - {Tfs,St1} = forms(Fs, define_functions(Fs, St0)), + {Tfs,St1} = forms(Fs, St0), + %% Get the correct list of exported functions. Exports = case member(export_all, Opts) of - true -> gb_sets:to_list(St1#expand.defined); + true -> Defined; false -> St1#expand.exports end, + St2 = St1#expand{exports=Exports,ctype=undefined}, + %% Generate all functions from stored info. - {Ats,St3} = module_attrs(St1#expand{exports = Exports}), + {Ats,St3} = module_attrs(St2), {Mfs,St4} = module_predef_funcs(St3), {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, Opts}. @@ -85,14 +90,14 @@ module(Fs0, Opts0) -> compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -%% define_function(Form, State) -> State. +%% defined_function(Forms, Predef) -> Functions. %% Add function to defined if form is a function. -define_functions(Forms, #expand{defined=Predef}=St) -> +defined_functions(Forms, Predef) -> Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc]; (_, Acc) -> Acc end, Predef, Forms), - St#expand{defined=gb_sets:from_list(Fs)}. + ordsets:from_list(Fs). module_attrs(#expand{attributes=Attributes}=St) -> Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], @@ -113,23 +118,21 @@ is_fa_list([{FuncName, Arity}|L]) is_fa_list([]) -> true; is_fa_list(_) -> false. -module_predef_funcs(St) -> - {Mpf1,St1}=module_predef_func_beh_info(St), - {Mpf2,St2}=module_predef_funcs_mod_info(St1), +module_predef_funcs(St0) -> + {Mpf1,St1} = module_predef_func_beh_info(St0), + Mpf2 = module_predef_funcs_mod_info(St1), Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2], - {Mpf,St2}. + {Mpf,St1}. module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; module_predef_func_beh_info(#expand{callbacks=Callbacks, optional_callbacks=OptionalCallbacks, - defined=Defined, exports=Exports}=St) -> - PreDef=[{behaviour_info,1}], - PreExp=PreDef, + PreDef0 = [{behaviour_info,1}], + PreDef = ordsets:from_list(PreDef0), {[gen_beh_info(Callbacks, OptionalCallbacks)], - St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), - exports=union(from_list(PreExp), Exports)}}. + St#expand{exports=ordsets:union(PreDef, Exports)}}. gen_beh_info(Callbacks, OptionalCallbacks) -> List = make_list(Callbacks), @@ -156,20 +159,16 @@ make_optional_list([{Name,Arity}|Rest]) -> {integer,0,Arity}]}, make_optional_list(Rest)}. -module_predef_funcs_mod_info(St) -> - PreDef = [{module_info,0},{module_info,1}], - PreExp = PreDef, - {[{function,0,module_info,0, - [{clause,0,[],[], +module_predef_funcs_mod_info(#expand{module=Mod}) -> + ModAtom = {atom,0,Mod}, + [{function,0,module_info,0, + [{clause,0,[],[], [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, - [{atom,0,St#expand.module}]}]}]}, - {function,0,module_info,1, - [{clause,0,[{var,0,'X'}],[], + [ModAtom]}]}]}, + {function,0,module_info,1, + [{clause,0,[{var,0,'X'}],[], [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, - [{atom,0,St#expand.module},{var,0,'X'}]}]}]}], - St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), - St#expand.defined), - exports=union(from_list(PreExp), St#expand.exports)}}. + [ModAtom,{var,0,'X'}]}]}]}]. %% forms(Forms, State) -> %% {TransformedForms,State'} @@ -196,7 +195,8 @@ attribute(module, Module, _L, St) -> true = is_atom(Module), St#expand{module=Module}; attribute(export, Es, _L, St) -> - St#expand{exports=union(from_list(Es), St#expand.exports)}; + St#expand{exports=ordsets:union(ordsets:from_list(Es), + St#expand.exports)}; attribute(import, Is, _L, St) -> import(Is, St); attribute(compile, _C, _L, St) -> @@ -231,8 +231,6 @@ head(As, St) -> pattern_list(As, St). %% {TransformedPattern,State'} %% -pattern({var,_,'_'}=Var, St) -> %Ignore anonymous variable. - {Var,St}; pattern({var,_,_}=Var, St) -> {Var,St}; pattern({char,_,_}=Char, St) -> @@ -385,19 +383,19 @@ expr({block,Line,Es0}, St0) -> {Es,St1} = exprs(Es0, St0), {{block,Line,Es},St1}; expr({'if',Line,Cs0}, St0) -> - {Cs,St1} = icr_clauses(Cs0, St0), + {Cs,St1} = clauses(Cs0, St0), {{'if',Line,Cs},St1}; expr({'case',Line,E0,Cs0}, St0) -> {E,St1} = expr(E0, St0), - {Cs,St2} = icr_clauses(Cs0, St1), + {Cs,St2} = clauses(Cs0, St1), {{'case',Line,E,Cs},St2}; expr({'receive',Line,Cs0}, St0) -> - {Cs,St1} = icr_clauses(Cs0, St0), + {Cs,St1} = clauses(Cs0, St0), {{'receive',Line,Cs},St1}; expr({'receive',Line,Cs0,To0,ToEs0}, St0) -> {To,St1} = expr(To0, St0), {ToEs,St2} = exprs(ToEs0, St1), - {Cs,St3} = icr_clauses(Cs0, St2), + {Cs,St3} = clauses(Cs0, St2), {{'receive',Line,Cs,To,ToEs},St3}; expr({'fun',Line,Body}, St) -> fun_tq(Line, Body, St); @@ -406,21 +404,15 @@ expr({named_fun,Line,Name,Cs}, St) -> expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), - case defined(N,Ar,St1) of - true -> + Key = {N,Ar}, + case St1#expand.ctype of + #{Key:=local} -> {{call,Line,Atom,As},St1}; + #{Key:={imported,Mod}} -> + {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1}; _ -> - case imported(N, Ar, St1) of - {yes,Mod} -> - {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1}; - no -> - case erl_internal:bif(N, Ar) of - true -> - {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}; - false -> %% This should have been handled by erl_lint - {{call,Line,Atom,As},St1} - end - end + true = erl_internal:bif(N, Ar), + {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1} end; expr({call,Line,{remote,Lr,M0,F},As0}, St0) -> {[M1,F1|As1],St1} = expr_list([M0,F|As0], St0), @@ -430,12 +422,11 @@ expr({call,Line,F,As0}, St0) -> {{call,Line,Fun1,As1},St1}; expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) -> {Es1,St1} = exprs(Es0, St0), - {Scs1,St2} = icr_clauses(Scs0, St1), - {Ccs1,St3} = icr_clauses(Ccs0, St2), + {Scs1,St2} = clauses(Scs0, St1), + {Ccs1,St3} = clauses(Ccs0, St2), {As1,St4} = exprs(As0, St3), {{'try',Line,Es1,Scs1,Ccs1,As1},St4}; expr({'catch',Line,E0}, St0) -> - %% Catch exports no new variables. {E,St1} = expr(E0, St0), {{'catch',Line,E},St1}; expr({match,Line,P0,E0}, St0) -> @@ -456,21 +447,6 @@ expr_list([E0|Es0], St0) -> {[E|Es],St2}; expr_list([], St) -> {[],St}. -%% icr_clauses([Clause], State) -> {[TransformedClause],State'} -%% Be very careful here to return the variables that are really used -%% and really new. - -icr_clauses([], St) -> {[],St}; -icr_clauses(Clauses, St) -> icr_clauses2(Clauses, St). - -icr_clauses2([{clause,Line,H0,G0,B0}|Cs0], St0) -> - {H,St1} = head(H0, St0), - {G,St2} = guard(G0, St1), - {B,St3} = exprs(B0, St2), - {Cs,St4} = icr_clauses2(Cs0, St3), - {[{clause,Line,H,G,B}|Cs],St4}; -icr_clauses2([], St) -> {[],St}. - %% lc_tq(Line, Qualifiers, State) -> %% {[TransQual],State'} @@ -486,16 +462,9 @@ lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) -> {Qs1,St3} = lc_tq(Line, Qs0, St2), {[{b_generate,Lg,P1,G1}|Qs1],St3}; lc_tq(Line, [F0 | Qs0], St0) -> - case erl_lint:is_guard_test(F0) of - true -> - {F1,St1} = guard_test(F0, St0), - {Qs1,St2} = lc_tq(Line, Qs0, St1), - {[F1|Qs1],St2}; - false -> - {F1,St1} = expr(F0, St0), - {Qs1,St2} = lc_tq(Line, Qs0, St1), - {[F1 | Qs1],St2} - end; + {F1,St1} = expr(F0, St0), + {Qs1,St2} = lc_tq(Line, Qs0, St1), + {[F1|Qs1],St2}; lc_tq(_Line, [], St0) -> {[],St0}. @@ -527,7 +496,7 @@ fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) -> fun_tq(Lf, {function,_,_,_}=ExtFun, St) -> {{'fun',Lf,ExtFun},St}; fun_tq(Lf, {clauses,Cs0}, St0) -> - {Cs1,St1} = fun_clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), {Fname,St2} = new_fun_name(St1), %% Set dummy values for Index and Uniq -- the real values will %% be assigned by beam_asm. @@ -535,18 +504,10 @@ fun_tq(Lf, {clauses,Cs0}, St0) -> {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. fun_tq(Line, Cs0, St0, Name) -> - {Cs1,St1} = fun_clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), {Fname,St2} = new_fun_name(St1, Name), {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}. -fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> - {H,St1} = head(H0, St0), - {G,St2} = guard(G0, St1), - {B,St3} = exprs(B0, St2), - {Cs,St4} = fun_clauses(Cs0, St3), - {[{clause,L,H,G,B}|Cs],St4}; -fun_clauses([], St) -> {[],St}. - %% new_fun_name(State) -> {FunName,State}. new_fun_name(St) -> @@ -571,7 +532,6 @@ pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) -> {[{bin_element,Line,Expr,Size,Type}|Es],St2}. pat_bit_size(default, St) -> {default,St}; -pat_bit_size({atom,_La,all}=All, St) -> {All,St}; pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St}; pat_bit_size(Size, St) -> Line = element(2, Size), @@ -592,8 +552,7 @@ coerce_to_float({integer,L,I}=E, [float|_]) -> try {float,L,float(I)} catch - error:badarg -> E; - error:badarith -> E + error:badarg -> E end; coerce_to_float(E, _) -> E. @@ -647,25 +606,11 @@ string_to_conses(Line, Cs, Tail) -> %% import(Line, Imports, State) -> %% State' -%% imported(Name, Arity, State) -> -%% {yes,Module} | no -%% Handle import declarations and test for imported functions. No need to -%% check when building imports as code is correct. +%% Handle import declarations. -import({Mod,Fs}, St) -> +import({Mod,Fs}, #expand{ctype=Ctype0}=St) -> true = is_atom(Mod), - Mfs = from_list(Fs), - St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}. - -add_imports(Mod, [F|Fs], Is) -> - add_imports(Mod, Fs, orddict:store(F, Mod, Is)); -add_imports(_, [], Is) -> Is. - -imported(F, A, St) -> - case orddict:find({F,A}, St#expand.imports) of - {ok,Mod} -> {yes,Mod}; - error -> no - end. - -defined(F, A, St) -> - gb_sets:is_element({F,A}, St#expand.defined). + Ctype = foldl(fun(F, A) -> + A#{F=>{imported,Mod}} + end, Ctype0, Fs), + St#expand{ctype=Ctype}. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 5083995f30..6f1912c616 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1330,12 +1330,13 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% that we save any variable that will be live after this BIF call. MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), - {Sis,Int0} = case St0#cg.in_catch andalso - St0#cg.bfail =:= 0 andalso - MayFail of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = + case MayFail of + true -> + maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0); + false -> + {[],Bef} + end, Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), Int = Int1#sr{reg=Reg}, @@ -1366,11 +1367,7 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% Currently, we are somewhat pessimistic in %% that we save any variable that will be live after this BIF call. - {Sis,Int0} = - case St0#cg.in_catch andalso St0#cg.bfail =:= 0 of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), @@ -1515,8 +1512,7 @@ set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, Ret = fetch_reg(R, Int1#sr.reg), {[{put_list,S1,S2,Ret}], Int1, St}; -set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, - #cg{in_catch=InCatch, bfail=Bfail}=St) -> +set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> %% At run-time, binaries are constructed in three stages: %% 1) First the size of the binary is calculated. %% 2) Then the binary is allocated. @@ -1535,11 +1531,7 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% First generate the code that constructs each field. Fail = {f,Bfail}, PutCode = cg_bin_put(Segs, Fail, Bef), - {Sis,Int1} = - case InCatch of - true -> adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Int0} - end, + {Sis,Int1} = maybe_adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb, St), MaxRegs = max_reg(Bef#sr.reg), Aft = clear_dead(Int1, Le#l.i, Vdb), @@ -1548,14 +1540,11 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, {Sis++Code,Aft,St}; % Map single variable key set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), + SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -1576,17 +1565,13 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, % Map (possibly) multiple literal keys set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> %% assert key literals [] = [Var||{map_pair,{var,_}=Var,_} <- Es], Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -2041,6 +2026,19 @@ trim_free([R|Rs0]) -> end; trim_free([]) -> []. +%% maybe_adjust_stack(Bef, FirstBefore, LastFrom, Vdb, St) -> {[Ainstr],Aft}. +%% Adjust the stack, but only if the code is inside a catch and not +%% inside a guard. Use this funtion before instructions that may +%% cause an exception. + +maybe_adjust_stack(Bef, Fb, Lf, Vdb, St) -> + case St of + #cg{in_catch=true,bfail=0} -> + adjust_stack(Bef, Fb, Lf, Vdb); + #cg{} -> + {[],Bef} + end. + %% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}. %% Do complete stack adjustment by compressing stack and adding %% variables to be saved. Try to optimise ordering on stack by diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 7c229210a0..8074456be2 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -805,7 +805,7 @@ map_op(map_field_assoc) -> #c_literal{val=assoc}; map_op(map_field_exact) -> #c_literal{val=exact}. is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; -is_valid_map_src(#c_var{}) -> true; +is_valid_map_src(#c_var{}=Var) -> not cerl:is_c_fname(Var); is_valid_map_src(_) -> false. %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 7ee564683b..011748df3a 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -117,7 +117,7 @@ copy_anno(Kdst, Ksrc) -> fcount=0, %Fun counter ds=cerl_sets:new() :: cerl_sets:set(), %Defined variables funs=[], %Fun functions - free=[], %Free variables + free=#{}, %Free variables ws=[] :: [warning()], %Warnings. guard_refc=0}). %> 0 means in guard @@ -1837,14 +1837,17 @@ handle_reuse_anno_1(V, _St) -> V. %% get_free(Name, Arity, State) -> [Free]. %% store_free(Name, Arity, [Free], State) -> State. -get_free(F, A, St) -> - case orddict:find({F,A}, St#kern.free) of - {ok,Val} -> Val; - error -> [] +get_free(F, A, #kern{free=FreeMap}) -> + Key = {F,A}, + case FreeMap of + #{Key:=Val} -> Val; + _ -> [] end. -store_free(F, A, Free, St) -> - St#kern{free=orddict:store({F,A}, Free, St#kern.free)}. +store_free(F, A, Free, #kern{free=FreeMap0}=St) -> + Key = {F,A}, + FreeMap = FreeMap0#{Key=>Free}, + St#kern{free=FreeMap}. break_rets({break,Rs}) -> Rs; break_rets(return) -> []. |