diff options
Diffstat (limited to 'lib')
58 files changed, 1301 insertions, 1186 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 9b22e5197b..9e96147787 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -93,16 +93,14 @@ MODULES = \ v3_codegen \ v3_core \ v3_kernel \ - v3_kernel_pp \ - v3_life + v3_kernel_pp BEAM_H = $(wildcard ../priv/beam_h/*.h) HRL_FILES= \ beam_disasm.hrl \ core_parse.hrl \ - v3_kernel.hrl \ - v3_life.hrl + v3_kernel.hrl YRL_FILE = core_parse.yrl @@ -187,7 +185,7 @@ release_docs_spec: # ---------------------------------------------------- $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl -$(EBIN)/beam_listing.beam: v3_life.hrl +$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl $(EBIN)/beam_validator.beam: beam_disasm.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl @@ -200,8 +198,7 @@ $(EBIN)/sys_core_dsetel.beam: core_parse.hrl $(EBIN)/sys_core_fold.beam: core_parse.hrl $(EBIN)/sys_core_fold_lists.beam: core_parse.hrl $(EBIN)/sys_core_inline.beam: core_parse.hrl -$(EBIN)/v3_codegen.beam: v3_life.hrl +$(EBIN)/v3_codegen.beam: v3_kernel.hrl $(EBIN)/v3_core.beam: core_parse.hrl $(EBIN)/v3_kernel.beam: core_parse.hrl v3_kernel.hrl $(EBIN)/v3_kernel_pp.beam: v3_kernel.hrl -$(EBIN)/v3_life.beam: v3_kernel.hrl v3_life.hrl diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 94b47cf568..9422f9a78a 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -23,14 +23,12 @@ -include("core_parse.hrl"). -include("v3_kernel.hrl"). --include("v3_life.hrl"). -import(lists, [foreach/2]). -type code() :: cerl:c_module() | beam_utils:module_code() | #k_mdef{} - | {module(),_,_,_} %v3_life | [_]. %form-based format -spec module(file:io_device(), code()) -> 'ok'. @@ -42,13 +40,9 @@ module(File, #k_mdef{}=Kern) -> %% This is a kernel module. io:put_chars(File, v3_kernel_pp:format(Kern)); %%io:put_chars(File, io_lib:format("~p~n", [Kern])); -module(File, {Mod,Exp,Attr,Kern}) -> - %% This is output from beam_life (v3). - io:fwrite(File, "~w.~n~p.~n~p.~n", [Mod,Exp,Attr]), - foreach(fun (F) -> function(File, F) end, Kern); module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> - %% This is output from beam_codegen. - io:format(Stream, "{module, ~p}. %% version = ~w\n", + %% This is output from v3_codegen. + io:format(Stream, "{module, ~p}. %% version = ~w\n", [Mod, beam_opcodes:format_number()]), io:format(Stream, "\n{exports, ~p}.\n", [Exp]), io:format(Stream, "\n{attributes, ~p}.\n", [Attr]), @@ -68,60 +62,3 @@ format_asm([{label,L}|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), - io:format(File, "function ~p/~p.\n", [Name,Arity]), - io:format(File, " ~p.\n", [Args]), - print_vdb(File, Vdb), - put(beam_listing_nl, false), - nl(File), - foreach(fun(F) -> format(File, F, []) end, Body), - nl(File), - erase(beam_listing_nl). - -format(File, #l{ke=Ke,i=I,vdb=Vdb}, Ind) -> - nl(File), - ind_format(File, Ind, "~p ", [I]), - print_vdb(File, Vdb), - nl(File), - format(File, Ke, Ind); -format(File, Tuple, Ind) when is_tuple(Tuple) -> - ind_format(File, Ind, "{", []), - format_list(File, tuple_to_list(Tuple), [$\s|Ind]), - ind_format(File, Ind, "}", []); -format(File, List, Ind) when is_list(List) -> - ind_format(File, Ind, "[", []), - format_list(File, List, [$\s|Ind]), - ind_format(File, Ind, "]", []); -format(File, F, Ind) -> - ind_format(File, Ind, "~p", [F]). - -format_list(File, [F], Ind) -> - format(File, F, Ind); -format_list(File, [F|Fs], Ind) -> - format(File, F, Ind), - ind_format(File, Ind, ",", []), - format_list(File, Fs, Ind); -format_list(_, [], _) -> ok. - - -print_vdb(File, [{Var,F,E}|Vs]) -> - io:format(File, "~p:~p..~p ", [Var,F,E]), - print_vdb(File, Vs); -print_vdb(_, []) -> ok. - -ind_format(File, Ind, Format, Args) -> - case get(beam_listing_nl) of - true -> - put(beam_listing_nl, false), - io:put_chars(File, Ind); - false -> ok - end, - io:format(File, Format, Args). - -nl(File) -> - case put(beam_listing_nl, true) of - true -> ok; - false -> io:nl(File) - end. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 1b359d1e59..bc519264fc 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -733,8 +733,6 @@ kernel_passes() -> ?pass(v3_kernel), {iff,dkern,{listing,"kernel"}}, {iff,'to_kernel',{done,"kernel"}}, - {pass,v3_life}, - {iff,dlife,{listing,"life"}}, {pass,v3_codegen}, {iff,dcg,{listing,"codegen"}} | asm_passes()]. @@ -1947,7 +1945,6 @@ pre_load() -> sys_core_fold, v3_codegen, v3_core, - v3_kernel, - v3_life], + v3_kernel], _ = code:ensure_modules_loaded(L), ok. diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 703cf1d1b8..cf32fd251c 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -68,8 +68,7 @@ v3_codegen, v3_core, v3_kernel, - v3_kernel_pp, - v3_life + v3_kernel_pp ]}, {registered, []}, {applications, [kernel, stdlib]}, diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index ee5bafbc5c..006a6a82d2 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -19,25 +19,6 @@ %% %% Purpose : Code generator for Beam. -%% The following assumptions have been made: -%% -%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return -%% values; no variables are exported. If the match would have returned -%% extra variables then these have been transformed to multiple return -%% values. -%% -%% 2. All BIF's called in guards are gc-safe so there is no need to -%% put thing on the stack in the guard. While this would in principle -%% work it would be difficult to keep track of the stack depth when -%% trimming. -%% -%% The code generation uses variable lifetime information added by -%% the v3_life module to save variables, allocate registers and -%% move registers to the stack when necessary. -%% -%% We try to use a consistent variable name scheme throughout. The -%% StackReg record is always called Bef,Int<n>,Aft. - -module(v3_codegen). %% The main interface. @@ -45,12 +26,14 @@ -import(lists, [member/2,keymember/3,keysort/2,keydelete/3, append/1,flatmap/2,filter/2,foldl/3,foldr/3,mapfoldl/3, - sort/1,reverse/1,reverse/2]). --import(v3_life, [vdb_find/2]). + sort/1,reverse/1,reverse/2,map/2]). +-import(ordsets, [add_element/2,intersection/2,union/2]). -%%-compile([export_all]). +-include("v3_kernel.hrl"). --include("v3_life.hrl"). +%% These are not defined in v3_kernel.hrl. +get_kanno(Kthing) -> element(2, Kthing). +set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). %% Main codegen structure. -record(cg, {lcount=1, %Label counter @@ -61,38 +44,273 @@ functable=#{}, %Map of local functions: {Name,Arity}=>Label in_catch=false, %Inside a catch or not. need_frame, %Need a stack frame. - ultimate_failure %Label for ultimate match failure. - }). + ultimate_failure, %Label for ultimate match failure. + ctx %Match context. + }). %% Stack/register state record. -record(sr, {reg=[], %Register table stk=[], %Stack table res=[]}). %Reserved regs: [{reserved,I,V}] --type life_module() :: {module(),_,_,[_]}. +%% Internal records. +-record(cg_need_heap, {anno=[] :: term(), + h=0 :: integer()}). +-record(cg_block, {anno=[] :: term(), + es=[] :: [term()]}). + +-type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}. + +-record(l, {i=0 :: non_neg_integer(), %Op number + vdb=[] :: [vdb_entry()], %Variable database + a=[] :: [term()]}). %Core annotation --spec module(life_module(), [compile:option()]) -> {'ok',beam_asm:module_code()}. +-spec module(#k_mdef{}, [compile:option()]) -> {'ok',beam_asm:module_code()}. -module({Mod,Exp,Attr,Forms}, _Options) -> - {Fs,St} = functions(Forms, {atom,Mod}), - {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. +module(#k_mdef{name=Mod,exports=Es,attributes=Attr,body=Forms}, _Opts) -> + {Asm,St} = functions(Forms, {atom,Mod}), + {ok,{Mod,Es,Attr,Asm,St#cg.lcount}}. functions(Forms, AtomMod) -> mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms). -function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) -> +function(#k_fdef{anno=#k{a=Anno},func=Name,arity=Arity, + vars=As,body=Kb}, AtomMod, St0) -> try - {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, - {Name,Arity}, Anno, St0), - Func = {function,Name,Arity,EntryLabel,Asm}, - {Func,St} + %% Annotate kernel records with variable usage. + #k_match{} = Kb, %Assertion. + Vdb0 = init_vars(As), + {Body,_,Vdb} = body(Kb, 1, Vdb0), + + %% Generate the BEAM assembly code. + {Asm,EntryLabel,St} = cg_fun(Body, As, Vdb, AtomMod, + {Name,Arity}, Anno, St0), + Func = {function,Name,Arity,EntryLabel,Asm}, + {Func,St} catch - Class:Error -> - Stack = erlang:get_stacktrace(), - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) end. +%% This pass creates beam format annotated with variable lifetime +%% information. Each thing is given an index and for each variable we +%% store the first and last index for its occurrence. The variable +%% database, VDB, attached to each thing is only relevant internally +%% for that thing. +%% +%% For nested things like matches the numbering continues locally and +%% the VDB for that thing refers to the variable usage within that +%% thing. Variables which live through a such a thing are internally +%% given a very large last index. Internally the indexes continue +%% after the index of that thing. This creates no problems as the +%% internal variable info never escapes and externally we only see +%% variable which are alive both before or after. +%% +%% This means that variables never "escape" from a thing and the only +%% way to get values from a thing is to "return" them, with 'break' or +%% 'return'. Externally these values become the return values of the +%% thing. This is no real limitation as most nested things have +%% multiple threads so working out a common best variable usage is +%% difficult. + +%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. +%% Handle a body. + +body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> + %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), + A = get_kanno(Ke), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), + {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), + E = expr(Ke, I, Vdb2), + {[E|Es],MaxI,Vdb2}; +body(Ke, I, Vdb0) -> + %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), + A = get_kanno(Ke), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), + E = expr(Ke, I, Vdb1), + {[E],I,Vdb1}. + +%% expr(Kexpr, I, Vdb) -> Expr. + +expr(#k_test{anno=A}=Test, I, _Vdb) -> + Test#k_test{anno=#l{i=I,a=A#k.a}}; +expr(#k_call{anno=A}=Call, I, _Vdb) -> + Call#k_call{anno=#l{i=I,a=A#k.a}}; +expr(#k_enter{anno=A}=Enter, I, _Vdb) -> + Enter#k_enter{anno=#l{i=I,a=A#k.a}}; +expr(#k_bif{anno=A}=Bif, I, _Vdb) -> + Bif#k_bif{anno=#l{i=I,a=A#k.a}}; +expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> + %% Work out imported variables which need to be locked. + Mdb = vdb_sub(I, I+1, Vdb), + M = match(Kb, A#k.us, I+1, Mdb), + L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}, + #k_match{anno=L,body=M,ret=Rs}; +expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> + %% Work out imported variables which need to be locked. + Mdb = vdb_sub(I, I+1, Vdb), + M = match(Kb, A#k.us, I+1, Mdb), + L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}, + #k_guard_match{anno=L,body=M,ret=Rs}; +expr(#k_protected{}=Protected, I, Vdb) -> + protected(Protected, I, Vdb); +expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}=Try, I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the try. + Tdb0 = vdb_sub(I, I+1, Vdb), + %% This is the tricky bit. Lock variables in Arg that are used in + %% the body and handler. Add try tag 'variable'. + Ab = get_kanno(Kb), + Ah = get_kanno(Kh), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), + Tdb2 = vdb_sub(I, I+2, Tdb1), + Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names + {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), + L = #l{i=I,vdb=Tdb1,a=A#k.a}, + Try#k_try{anno=L, + arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}}, + vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}}, + evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}}; +expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the try. + Tdb0 = vdb_sub(I, I+1, Vdb), + %% This is the tricky bit. Lock variables in Arg that are used in + %% the body and handler. Add try tag 'variable'. + Ab = get_kanno(Kb), + Ah = get_kanno(Kh), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), + Tdb2 = vdb_sub(I, I+2, Tdb1), + Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names + {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), + L = #l{i=I,vdb=Tdb1,a=A#k.a}, + #k_try_enter{anno=L, + arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}}, + vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}}, + evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}}; +expr(#k_catch{anno=A,body=Kb}=Catch, I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the catch. + %% Add catch tag 'variable'. + Cdb0 = vdb_sub(I, I+1, Vdb), + {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)), + L = #l{i=I,vdb=Cdb1,a=A#k.a}, + Catch#k_catch{anno=L,body=#cg_block{es=Es}}; +expr(#k_receive{anno=A,var=V,body=Kb,action=Ka}=Recv, I, Vdb) -> + %% Work out imported variables which need to be locked. + Rdb = vdb_sub(I, I+1, Vdb), + M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, + new_vars([V#k_var.name], I, Rdb)), + {Tes,_,Adb} = body(Ka, I+1, Rdb), + Le = #l{i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a}, + Recv#k_receive{anno=Le,body=M, + action=#cg_block{anno=#l{i=I+1,vdb=Adb,a=[]},es=Tes}}; +expr(#k_receive_accept{anno=A}, I, _Vdb) -> + #k_receive_accept{anno=#l{i=I,a=A#k.a}}; +expr(#k_receive_next{anno=A}, I, _Vdb) -> + #k_receive_next{anno=#l{i=I,a=A#k.a}}; +expr(#k_put{anno=A}=Put, I, _Vdb) -> + Put#k_put{anno=#l{i=I,a=A#k.a}}; +expr(#k_break{anno=A}=Break, I, _Vdb) -> + Break#k_break{anno=#l{i=I,a=A#k.a}}; +expr(#k_guard_break{anno=A}=Break, I, Vdb) -> + Locked = [V || {V,_,_} <- Vdb], + L = #l{i=I,a=A#k.a}, + Break#k_guard_break{anno=L,locked=Locked}; +expr(#k_return{anno=A}=Ret, I, _Vdb) -> + Ret#k_return{anno=#l{i=I,a=A#k.a}}. + +%% protected(Kprotected, I, Vdb) -> Protected. +%% Only used in guards. + +protected(#k_protected{anno=A,arg=Ts}=Prot, I, Vdb) -> + %% Lock variables that are alive before try and used afterwards. + %% Don't lock variables that are only used inside the protected + %% expression. + Pdb0 = vdb_sub(I, I+1, Vdb), + {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), + Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values + Prot#k_protected{arg=T,anno=#l{i=I,a=A#k.a,vdb=Pdb2}}. + +%% match(Kexpr, [LockVar], I, Vdb) -> Expr. +%% Convert match tree to old format. + +match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Vdb0) -> + Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), + F = match(Kf, Ls, I+1, Vdb1), + T = match(Kt, Ls, I+1, Vdb1), + #k_alt{anno=[],first=F,then=T}; +match(#k_select{anno=A,var=V,types=Kts}=Select, Ls0, I, Vdb0) -> + Vanno = get_kanno(V), + Ls1 = case member(no_usage, Vanno) of + false -> add_element(V#k_var.name, Ls0); + true -> Ls0 + end, + Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), + Ts = [type_clause(Tc, Ls1, I+1, Vdb1) || Tc <- Kts], + Select#k_select{anno=[],types=Ts}; +match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Vdb0) -> + Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), + Cs = [guard_clause(G, Ls, I+1, Vdb1) || G <- Kcs], + #k_guard{anno=[],clauses=Cs}; +match(Other, Ls, I, Vdb0) -> + Vdb1 = use_vars(Ls, I, Vdb0), + {B,_,Vdb2} = body(Other, I+1, Vdb1), + Le = #l{i=I,vdb=Vdb2,a=[]}, + #cg_block{anno=Le,es=B}. + +type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Vdb0) -> + %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]), + Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0), + Vs = [val_clause(Vc, Ls, I+1, Vdb1) || Vc <- Kvs], + #k_type_clause{anno=[],type=T,values=Vs}. + +val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Vdb0) -> + New = (get_kanno(V))#k.ns, + Bus = (get_kanno(Kb))#k.us, + %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]), + Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety + Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)), + B = match(Kb, Ls1, I+1, Vdb1), + Le = #l{i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}, + #k_val_clause{anno=Le,val=V,body=B}. + +guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Vdb0) -> + Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), + Gdb = vdb_sub(I+1, I+2, Vdb1), + G = protected(Kg, I+1, Gdb), + B = match(Kb, Ls, I+2, Vdb1), + Le = #l{i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),a=A#k.a}, + #k_guard_clause{anno=Le,guard=G,body=B}. + + +%% Here follows the code generator pass. +%% +%% The following assumptions have been made: +%% +%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return +%% values; no variables are exported. If the match would have returned +%% extra variables then these have been transformed to multiple return +%% values. +%% +%% 2. All BIF's called in guards are gc-safe so there is no need to +%% put thing on the stack in the guard. While this would in principle +%% work it would be difficult to keep track of the stack depth when +%% trimming. +%% +%% The code generation uses variable lifetime information added by +%% the previous pass to save variables, allocate registers and +%% move registers to the stack when necessary. +%% +%% We try to use a consistent variable name scheme throughout. The +%% StackReg record is always called Bef,Int<n>,Aft. + %% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State} cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> @@ -114,14 +332,14 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> %% Note that and 'if_end' instruction does not need any %% live x registers, so it will always be safe to jump to %% it. (We never ever expect the jump to be taken, and in - %% must functions there will never be any references to + %% most functions there will never be any references to %% the label in the first place.) %% {UltimateMatchFail,St3} = new_label(St2), %% Create initial stack/register state, clear unused arguments. - Bef = clear_dead(#sr{reg=foldl(fun ({var,V}, Reg) -> + Bef = clear_dead(#sr{reg=foldl(fun (#k_var{name=V}, Reg) -> put_reg(V, Reg) end, [], Hvs), stk=[]}, 0, Vdb), @@ -136,45 +354,43 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> %% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. %% Generate code for a kexpr. -%% Split function into two steps for clarity, not efficiency. -cg(Le, Vdb, Bef, St) -> - cg(Le#l.ke, Le, Vdb, Bef, St). - -cg({block,Es}, Le, Vdb, Bef, St) -> +cg(#cg_block{anno=Le,es=Es}, Vdb, Bef, St) -> block_cg(Es, Le, Vdb, Bef, St); -cg({match,M,Rs}, Le, Vdb, Bef, St) -> +cg(#k_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) -> match_cg(M, Rs, Le, Vdb, Bef, St); -cg({guard_match,M,Rs}, Le, Vdb, Bef, St) -> +cg(#k_guard_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) -> guard_match_cg(M, Rs, Le, Vdb, Bef, St); -cg({call,Func,As,Rs}, Le, Vdb, Bef, St) -> +cg(#k_call{anno=Le,op=Func,args=As,ret=Rs}, Vdb, Bef, St) -> call_cg(Func, As, Rs, Le, Vdb, Bef, St); -cg({enter,Func,As}, Le, Vdb, Bef, St) -> +cg(#k_enter{anno=Le,op=Func,args=As}, Vdb, Bef, St) -> enter_cg(Func, As, Le, Vdb, Bef, St); -cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) -> - bif_cg(Bif, As, Rs, Le, Vdb, Bef, St); -cg({gc_bif,Bif,As,Rs}, Le, Vdb, Bef, St) -> - gc_bif_cg(Bif, As, Rs, Le, Vdb, Bef, St); -cg({internal,Bif,As,Rs}, Le, Vdb, Bef, St) -> - internal_cg(Bif, As, Rs, Le, Vdb, Bef, St); -cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) -> +cg(#k_bif{anno=Le}=Bif, Vdb, Bef, St) -> + bif_cg(Bif, Le, Vdb, Bef, St); +cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs}, + Vdb, Bef, St) -> recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St); -cg(receive_next, Le, Vdb, Bef, St) -> +cg(#k_receive_next{anno=Le}, Vdb, Bef, St) -> recv_next_cg(Le, Vdb, Bef, St); -cg(receive_accept, _Le, _Vdb, Bef, St) -> {[remove_message],Bef,St}; -cg({'try',Ta,Vs,Tb,Evs,Th,Rs}, Le, Vdb, Bef, St) -> +cg(#k_receive_accept{}, _Vdb, Bef, St) -> + {[remove_message],Bef,St}; +cg(#k_try{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th,ret=Rs}, + Vdb, Bef, St) -> try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St); -cg({try_enter,Ta,Vs,Tb,Evs,Th}, Le, Vdb, Bef, St) -> +cg(#k_try_enter{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th}, + Vdb, Bef, St) -> try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St); -cg({'catch',Cb,R}, Le, Vdb, Bef, St) -> +cg(#k_catch{anno=Le,body=Cb,ret=[R]}, Vdb, Bef, St) -> catch_cg(Cb, R, Le, Vdb, Bef, St); -cg({set,Var,Con}, Le, Vdb, Bef, St) -> - set_cg(Var, Con, Le, Vdb, Bef, St); -cg({return,Rs}, Le, Vdb, Bef, St) -> return_cg(Rs, Le, Vdb, Bef, St); -cg({break,Bs}, Le, Vdb, Bef, St) -> break_cg(Bs, Le, Vdb, Bef, St); -cg({guard_break,Bs,N}, Le, Vdb, Bef, St) -> +cg(#k_put{anno=Le,arg=Con,ret=Var}, Vdb, Bef, St) -> + put_cg(Var, Con, Le, Vdb, Bef, St); +cg(#k_return{anno=Le,args=Rs}, Vdb, Bef, St) -> + return_cg(Rs, Le, Vdb, Bef, St); +cg(#k_break{anno=Le,args=Bs}, Vdb, Bef, St) -> + break_cg(Bs, Le, Vdb, Bef, St); +cg(#k_guard_break{anno=Le,args=Bs,locked=N}, Vdb, Bef, St) -> guard_break_cg(Bs, N, Le, Vdb, Bef, St); -cg({need_heap,H}, _Le, _Vdb, Bef, St) -> +cg(#cg_need_heap{h=H}, _Vdb, Bef, St) -> {[{test_heap,H,max_reg(Bef#sr.reg)}],Bef,St}. %% cg_list([Kexpr], FirstI, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. @@ -191,11 +407,11 @@ cg_list(Kes, I, Vdb, Bef, St0) -> %% Insert need_heap instructions in Kexpr list. Try to be smart and %% collect them together as much as possible. -need_heap(Kes0, I) -> +need_heap(Kes0, _I) -> {Kes,H} = need_heap_0(reverse(Kes0), 0, []), %% Prepend need_heap if necessary. - need_heap_need(I, H) ++ Kes. + need_heap_need(H) ++ Kes. need_heap_0([Ke|Kes], H0, Acc) -> {Ns,H} = need_heap_1(Ke, H0), @@ -203,27 +419,54 @@ need_heap_0([Ke|Kes], H0, Acc) -> need_heap_0([], H, Acc) -> {Acc,H}. -need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) -> - {need_heap_need(I, H),0}; -need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) -> - {need_heap_need(I, H),0}; -need_heap_1(#l{ke={set,_,Val}}, H) -> +need_heap_1(#k_put{arg=#k_binary{}}, H) -> + {need_heap_need(H),0}; +need_heap_1(#k_put{arg=#k_map{}}, H) -> + {need_heap_need(H),0}; +need_heap_1(#k_put{arg=Val}, H) -> %% Just pass through adding to needed heap. {[],H + case Val of - {cons,_} -> 2; - {tuple,Es} -> 1 + length(Es); + #k_cons{} -> 2; + #k_tuple{es=Es} -> 1 + length(Es); _Other -> 0 end}; -need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H) -> - {[],H}; -need_heap_1(#l{i=I}, H) -> +need_heap_1(#k_bif{}=Bif, H) -> + case is_gc_bif(Bif) of + false -> + {[],H}; + true -> + {need_heap_need(H),0} + end; +need_heap_1(_Ke, H) -> %% Call or call-like instruction such as set_tuple_element/3. - {need_heap_need(I, H),0}. - -need_heap_need(_I, 0) -> []; -need_heap_need(I, H) -> [#l{ke={need_heap,H},i=I}]. - -%% match_cg(Match, [Ret], Le, Vdb, StackReg, State) -> + {need_heap_need(H),0}. + +need_heap_need(0) -> []; +need_heap_need(H) -> [#cg_need_heap{h=H}]. + +%% is_gc_bif(#k_bif{}) -> true|false. +%% is_gc_bif(Name, Arity) -> true|false. +%% Determines whether the BIF Name/Arity might do a GC. + +is_gc_bif(#k_bif{op=#k_remote{name=#k_atom{val=Name}},args=Args}) -> + is_gc_bif(Name, length(Args)); +is_gc_bif(#k_bif{op=#k_internal{}}) -> + true. + +is_gc_bif(hd, 1) -> false; +is_gc_bif(tl, 1) -> false; +is_gc_bif(self, 0) -> false; +is_gc_bif(node, 0) -> false; +is_gc_bif(node, 1) -> false; +is_gc_bif(element, 2) -> false; +is_gc_bif(get, 1) -> false; +is_gc_bif(tuple_size, 1) -> false; +is_gc_bif(Bif, Arity) -> + not (erl_internal:bool_op(Bif, Arity) orelse + erl_internal:new_type_test(Bif, Arity) orelse + erl_internal:comp_op(Bif, Arity)). + +%% match_cg(Matc, [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. %% Generate code for a match. First save all variables on the stack %% that are to survive after the match. We leave saved variables in @@ -252,7 +495,7 @@ guard_match_cg(M, Rs, Le, Vdb, Bef, St0) -> clear_dead(Aft#sr{reg=Reg}, I, Vdb), St2#cg{break=St1#cg.break}}. -guard_match_regs([{I,gbreakvar}|Rs], [{var,V}|Vs]) -> +guard_match_regs([{I,gbreakvar}|Rs], [#k_var{name=V}|Vs]) -> [{I,V}|guard_match_regs(Rs, Vs)]; guard_match_regs([R|Rs], Vs) -> [R|guard_match_regs(Rs, Vs)]; @@ -264,17 +507,14 @@ guard_match_regs([], []) -> []. %% down as each level which uses this takes its own internal Vdb not %% the outer one. -match_cg(Le, Fail, Bef, St) -> - match_cg(Le#l.ke, Le, Fail, Bef, St). - -match_cg({alt,F,S}, _Le, Fail, Bef, St0) -> +match_cg(#k_alt{first=F,then=S}, Fail, Bef, St0) -> {Tf,St1} = new_label(St0), {Fis,Faft,St2} = match_cg(F, Tf, Bef, St1), {Sis,Saft,St3} = match_cg(S, Fail, Bef, St2), Aft = sr_merge(Faft, Saft), {Fis ++ [{label,Tf}] ++ Sis,Aft,St3}; -match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) -> - ReuseForContext = member(reuse_for_context, Anno) andalso +match_cg(#k_select{var=#k_var{anno=Vanno,name=Vname}=V,types=Scs0}, Fail, Bef, St) -> + ReuseForContext = member(reuse_for_context, Vanno) andalso find_reg(Vname, Bef#sr.reg) =/= error, Scs = case ReuseForContext of false -> Scs0; @@ -283,10 +523,10 @@ match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) -> match_fmf(fun (S, F, Sta) -> select_cg(S, V, F, Fail, Bef, Sta) end, Fail, St, Scs); -match_cg({guard,Gcs}, _Le, Fail, Bef, St) -> +match_cg(#k_guard{clauses=Gcs}, Fail, Bef, St) -> match_fmf(fun (G, F, Sta) -> guard_clause_cg(G, F, Bef, Sta) end, Fail, St, Gcs); -match_cg({block,Es}, Le, _Fail, Bef, St) -> +match_cg(#cg_block{anno=Le,es=Es}, _Fail, Bef, St) -> %% Must clear registers and stack of dead variables. Int = clear_dead(Bef, Le#l.i, Le#l.vdb), block_cg(Es, Le, Int, St). @@ -294,8 +534,8 @@ match_cg({block,Es}, Le, _Fail, Bef, St) -> %% bsm_rename_ctx([Clause], Var) -> [Clause] %% We know from an annotation that the register for a binary can %% be reused for the match context because the two are not truly -%% alive at the same time (even though the conservative life time -%% information calculated by v3_life says so). +%% alive at the same time (even though the life time information +%% says so). %% %% The easiest way to have those variables share the same register is %% to rename the variable with the shortest life-span (the match @@ -306,12 +546,14 @@ match_cg({block,Es}, Le, _Fail, Bef, St) -> %% We must also remove all information about the match context %% variable from all life-time information databases (Vdb). -bsm_rename_ctx([#l{ke={type_clause,binary, - [#l{ke={val_clause,{binary,{var,Old}},Ke0}}=L2]}}=L1|Cs], New) -> +bsm_rename_ctx([#k_type_clause{type=k_binary,values=Vcs}=TC|Cs], New) -> + [#k_val_clause{val=#k_binary{segs=#k_var{name=Old}}=Bin, + body=Ke0}=VC0] = Vcs, Ke = bsm_rename_ctx(Ke0, Old, New, false), - [L1#l{ke={type_clause,binary, - [L2#l{ke={val_clause,{binary,{var,New}},Ke}}]}}|bsm_rename_ctx(Cs, New)]; -bsm_rename_ctx([C|Cs], New) -> + VC = VC0#k_val_clause{val=Bin#k_binary{segs=#k_var{name=New}}, + body=Ke}, + [TC#k_type_clause{values=[VC]}|bsm_rename_ctx(Cs, New)]; +bsm_rename_ctx([C|Cs], New) -> [C|bsm_rename_ctx(Cs, New)]; bsm_rename_ctx([], _) -> []. @@ -321,34 +563,24 @@ bsm_rename_ctx([], _) -> []. %% only complicatate things to recurse into blocks not in a protected %% (the match context variable is not live inside them). -bsm_rename_ctx(#l{ke={select,{var,V},Cs0}}=L, Old, New, InProt) -> +bsm_rename_ctx(#k_select{var=#k_var{name=V},types=Cs0}=Sel, + Old, New, InProt) -> Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt), - L#l{ke={select,{var,bsm_rename_var(V, Old, New)},Cs}}; -bsm_rename_ctx(#l{ke={type_clause,Type,Cs0}}=L, Old, New, InProt) -> + Sel#k_select{var=#k_var{name=bsm_rename_var(V, Old, New)},types=Cs}; +bsm_rename_ctx(#k_type_clause{values=Cs0}=TC, Old, New, InProt) -> Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt), - L#l{ke={type_clause,Type,Cs}}; -bsm_rename_ctx(#l{ke={val_clause,{bin_end,V},Ke0}}=L, Old, New, InProt) -> - Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,{bin_end,bsm_rename_var(V, Old, New)},Ke}}; -bsm_rename_ctx(#l{ke={val_clause,{bin_seg,V,Sz,U,Type,Fl,Vs},Ke0}}=L, - Old, New, InProt) -> - Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,{bin_seg,bsm_rename_var(V, Old, New),Sz,U,Type,Fl,Vs},Ke}}; -bsm_rename_ctx(#l{ke={val_clause,{bin_int,V,Sz,U,Fl,Val,Vs},Ke0}}=L, - Old, New, InProt) -> - Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,{bin_int,bsm_rename_var(V, Old, New),Sz,U,Fl,Val,Vs},Ke}}; -bsm_rename_ctx(#l{ke={val_clause,Val,Ke0}}=L, Old, New, InProt) -> + TC#k_type_clause{values=Cs}; +bsm_rename_ctx(#k_val_clause{body=Ke0}=VC, Old, New, InProt) -> Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - L#l{ke={val_clause,Val,Ke}}; -bsm_rename_ctx(#l{ke={alt,F0,S0}}=L, Old, New, InProt) -> + VC#k_val_clause{body=Ke}; +bsm_rename_ctx(#k_alt{first=F0,then=S0}=Alt, Old, New, InProt) -> F = bsm_rename_ctx(F0, Old, New, InProt), S = bsm_rename_ctx(S0, Old, New, InProt), - L#l{ke={alt,F,S}}; -bsm_rename_ctx(#l{ke={guard,Gcs0}}=L, Old, New, InProt) -> + Alt#k_alt{first=F,then=S}; +bsm_rename_ctx(#k_guard{clauses=Gcs0}=Guard, Old, New, InProt) -> Gcs = bsm_rename_ctx_list(Gcs0, Old, New, InProt), - L#l{ke={guard,Gcs}}; -bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) -> + Guard#k_guard{clauses=Gcs}; +bsm_rename_ctx(#k_guard_clause{guard=G0,body=B0}=GC, Old, New, InProt) -> G = bsm_rename_ctx(G0, Old, New, InProt), B = bsm_rename_ctx(B0, Old, New, InProt), %% A guard clause may cause unsaved variables to be saved on the stack. @@ -356,49 +588,49 @@ bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) -> %% same register), it is neither in the stack nor register descriptor %% lists and we would crash when we didn't find it unless we remove %% it from the database. - bsm_forget_var(L#l{ke={guard_clause,G,B}}, Old); -bsm_rename_ctx(#l{ke={protected,Ts0,Rs}}=L, Old, New, _InProt) -> + bsm_forget_var(GC#k_guard_clause{guard=G,body=B}, Old); +bsm_rename_ctx(#k_protected{arg=Ts0}=Prot, Old, New, _InProt) -> InProt = true, Ts = bsm_rename_ctx_list(Ts0, Old, New, InProt), - bsm_forget_var(L#l{ke={protected,Ts,Rs}}, Old); -bsm_rename_ctx(#l{ke={match,Ms0,Rs}}=L, Old, New, InProt) -> + bsm_forget_var(Prot#k_protected{arg=Ts}, Old); +bsm_rename_ctx(#k_match{body=Ms0}=Match, Old, New, InProt) -> Ms = bsm_rename_ctx(Ms0, Old, New, InProt), - L#l{ke={match,Ms,Rs}}; -bsm_rename_ctx(#l{ke={guard_match,Ms0,Rs}}=L, Old, New, InProt) -> + Match#k_match{body=Ms}; +bsm_rename_ctx(#k_guard_match{body=Ms0}=Match, Old, New, InProt) -> Ms = bsm_rename_ctx(Ms0, Old, New, InProt), - L#l{ke={guard_match,Ms,Rs}}; -bsm_rename_ctx(#l{ke={test,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={call,_,_,_}}=L, _, _, _) -> L; -bsm_rename_ctx(#l{ke={block,_}}=L, Old, _, false) -> + Match#k_guard_match{body=Ms}; +bsm_rename_ctx(#k_test{}=Test, _, _, _) -> Test; +bsm_rename_ctx(#k_bif{}=Bif, _, _, _) -> Bif; +bsm_rename_ctx(#k_put{}=Put, _, _, _) -> Put; +bsm_rename_ctx(#k_call{}=Call, _, _, _) -> Call; +bsm_rename_ctx(#cg_block{}=Block, Old, _, false) -> %% This block is not inside a protected. The match context variable cannot %% possibly be live inside the block. - bsm_forget_var(L, Old); -bsm_rename_ctx(#l{ke={block,Bl0}}=L, Old, New, true) -> + bsm_forget_var(Block, Old); +bsm_rename_ctx(#cg_block{es=Es0}=Block, Old, New, true) -> %% A block in a protected. We must recursively rename the variable %% inside the block. - Bl = bsm_rename_ctx_list(Bl0, Old, New, true), - bsm_forget_var(L#l{ke={block,Bl}}, Old); -bsm_rename_ctx(#l{ke={guard_break,Bs,Locked0}}=L0, Old, _New, _InProt) -> + Es = bsm_rename_ctx_list(Es0, Old, New, true), + bsm_forget_var(Block#cg_block{es=Es}, Old); +bsm_rename_ctx(#k_guard_break{locked=Locked0}=Break, Old, _New, _InProt) -> Locked = Locked0 -- [Old], - L = L0#l{ke={guard_break,Bs,Locked}}, - bsm_forget_var(L, Old). + bsm_forget_var(Break#k_guard_break{locked=Locked}, Old). bsm_rename_ctx_list([C|Cs], Old, New, InProt) -> [bsm_rename_ctx(C, Old, New, InProt)| bsm_rename_ctx_list(Cs, Old, New, InProt)]; bsm_rename_ctx_list([], _, _, _) -> []. - + bsm_rename_var(Old, Old, New) -> New; bsm_rename_var(V, _, _) -> V. %% bsm_forget_var(#l{}, Variable) -> #l{} %% Remove a variable from the variable life-time database. -bsm_forget_var(#l{vdb=Vdb}=L, V) -> - L#l{vdb=keydelete(V, 1, Vdb)}. +bsm_forget_var(Ke, V) -> + #l{vdb=Vdb} = L0 = get_kanno(Ke), + L = L0#l{vdb=keydelete(V, 1, Vdb)}, + set_kanno(Ke, L). %% block_cg([Kexpr], Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. %% block_cg([Kexpr], Le, StackReg, St) -> {[Ainstr],StackReg,St}. @@ -421,7 +653,7 @@ cg_block(Kes0, I, Vdb, Bef, St0) -> case basic_block(Kes0) of {Kes1,LastI,Args,Rest} -> Ke = hd(Kes1), - Fb = Ke#l.i, + #l{i=Fb} = get_kanno(Ke), cg_basic_block(Kes1, Fb, LastI, Args, Vdb, Bef, St0); {Kes1,Rest} -> cg_list(Kes1, I, Vdb, Bef, St0) @@ -431,36 +663,46 @@ cg_block(Kes0, I, Vdb, Bef, St0) -> basic_block(Kes) -> basic_block(Kes, []). -basic_block([Le|Les], Acc) -> - case collect_block(Le#l.ke) of - include -> basic_block(Les, [Le|Acc]); +basic_block([Ke|Kes], Acc) -> + case collect_block(Ke) of + include -> basic_block(Kes, [Ke|Acc]); {block_end,As} -> case Acc of [] -> - %% If the basic block does not contain any set instructions, + %% If the basic block does not contain any #k_put{} instructions, %% it serves no useful purpose to do basic block optimizations. - {[Le],Les}; + {[Ke],Kes}; _ -> - {reverse(Acc, [Le]),Le#l.i,As,Les} + #l{i=I} = get_kanno(Ke), + {reverse(Acc, [Ke]),I,As,Kes} end; - no_block -> {reverse(Acc, [Le]),Les} + no_block -> {reverse(Acc, [Ke]),Kes} end. -%% sets that may garbage collect are not allowed in basic blocks. - -collect_block({set,_,{binary,_}}) -> no_block; -collect_block({set,_,{map,_,_,_}}) -> no_block; -collect_block({set,_,_}) -> include; -collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]}; -collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)}; -collect_block({enter,{var,_}=Var,As})-> {block_end,As++[Var]}; -collect_block({enter,Func,As}) -> {block_end,As++func_vars(Func)}; -collect_block({return,Rs}) -> {block_end,Rs}; -collect_block({break,Bs}) -> {block_end,Bs}; +%% #k_put{} instructions that may garbage collect are not allowed in basic blocks. + +collect_block(#k_put{arg=#k_binary{}}) -> + no_block; +collect_block(#k_put{arg=#k_map{}}) -> + no_block; +collect_block(#k_put{}) -> + include; +collect_block(#k_call{op=#k_var{}=Var,args=As}) -> + {block_end,As++[Var]}; +collect_block(#k_call{op=Func,args=As}) -> + {block_end,As++func_vars(Func)}; +collect_block(#k_enter{op=#k_var{}=Var,args=As}) -> + {block_end,As++[Var]}; +collect_block(#k_enter{op=Func,args=As}) -> + {block_end,As++func_vars(Func)}; +collect_block(#k_return{args=Rs}) -> + {block_end,Rs}; +collect_block(#k_break{args=Bs}) -> + {block_end,Bs}; collect_block(_) -> no_block. -func_vars({remote,M,F}) when element(1, M) =:= var; - element(1, F) =:= var -> +func_vars(#k_remote{mod=M,name=F}) + when is_record(M, k_var); is_record(F, k_var) -> [M,F]; func_vars(_) -> []. @@ -478,18 +720,19 @@ cg_basic_block(Kes, Fb, Lf, As, Vdb, Bef, St0) -> {Int0,X0_v0,St0}, need_heap(Kes, Fb)), {Keis,Aft,St1}. -cg_basic_block(#l{ke={need_heap,_}}=Ke, {Inta,X0v,Sta}, _Lf, Vdb) -> +cg_basic_block(#cg_need_heap{}=Ke, {Inta,X0v,Sta}, _Lf, Vdb) -> {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta), {Keis, {Intb,X0v,Stb}}; cg_basic_block(Ke, {Inta,X0_v1,Sta}, Lf, Vdb) -> - {Sis,Intb} = save_carefully(Inta, Ke#l.i, Lf+1, Vdb), - {X0_v2,Intc} = allocate_x0(X0_v1, Ke#l.i, Intb), + #l{i=I} = get_kanno(Ke), + {Sis,Intb} = save_carefully(Inta, I, Lf+1, Vdb), + {X0_v2,Intc} = allocate_x0(X0_v1, I, Intb), Intd = reserve(Intc), {Keis,Inte,Stb} = cg(Ke, Vdb, Intd, Sta), {Sis ++ Keis, {Inte,X0_v2,Stb}}. make_reservation([], _) -> []; -make_reservation([{var,V}|As], I) -> [{I,V}|make_reservation(As, I+1)]; +make_reservation([#k_var{name=V}|As], I) -> [{I,V}|make_reservation(As, I+1)]; make_reservation([A|As], I) -> [{I,A}|make_reservation(As, I+1)]. reserve(Sr) -> Sr#sr{reg=reserve(Sr#sr.res, Sr#sr.reg, Sr#sr.stk)}. @@ -538,7 +781,7 @@ save_carefully([V|Vs], Bef, Acc) -> end. x0_vars([], _Fb, _Lf, _Vdb) -> []; -x0_vars([{var,V}|_], Fb, _Lf, Vdb) -> +x0_vars([#k_var{name=V}|_], Fb, _Lf, Vdb) -> {V,F,_L} = VFL = vdb_find(V, Vdb), x0_vars1([VFL], Fb, F, Vdb); x0_vars([X0|_], Fb, Lf, Vdb) -> @@ -640,23 +883,27 @@ turn_yreg(Other, _MaxY) -> %% wrong. These are different as in the second case there is no need %% to try the next type, it will always fail. -select_cg(#l{ke={type_clause,cons,[S]}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(#k_type_clause{type=Type,values=Vs}, Var, Tf, Vf, Bef, St) -> + #k_var{name=V} = Var, + select_cg(Type, Vs, V, Tf, Vf, Bef, St). + +select_cg(k_cons, [S], V, Tf, Vf, Bef, St) -> select_cons(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,nil,[S]}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(k_nil, [S], V, Tf, Vf, Bef, St) -> select_nil(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,binary,[S]}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(k_binary, [S], V, Tf, Vf, Bef, St) -> select_binary(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,bin_seg,S}}, {var,V}, Tf, _Vf, Bef, St) -> +select_cg(k_bin_seg, S, V, Tf, _Vf, Bef, St) -> select_bin_segs(S, V, Tf, Bef, St); -select_cg(#l{ke={type_clause,bin_int,S}}, {var,V}, Tf, _Vf, Bef, St) -> +select_cg(k_bin_int, S, V, Tf, _Vf, Bef, St) -> select_bin_segs(S, V, Tf, Bef, St); -select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, _Vf, Bef, St) -> +select_cg(k_bin_end, [S], V, Tf, _Vf, Bef, St) -> select_bin_end(S, V, Tf, Bef, St); -select_cg(#l{ke={type_clause,map,S}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(k_map, S, V, Tf, Vf, Bef, St) -> select_map(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,literal,S}}, {var,V}, Tf, Vf, Bef, St) -> +select_cg(k_literal, S, V, Tf, Vf, Bef, St) -> select_literal(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) -> +select_cg(Type, Scs, V, Tf, Vf, Bef, St0) -> {Vis,{Aft,St1}} = mapfoldl(fun (S, {Int,Sta}) -> {Val,Is,Inta,Stb} = select_val(S, V, Vf, Bef, Sta), @@ -666,22 +913,29 @@ select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) -> {Vls,Sis,St2} = select_labels(OptVls, St1, [], []), {select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}. -select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> +select_val_cg(k_tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; -select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> +select_val_cg(k_tuple, R, Vls, Tf, Vf, Sis) -> [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> - [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; + [{test,is_eq_exact,{f,Fail},[R,{type(Type),Val}]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,select_type_test(Type),{f,Tf},[R]}, - {test,is_eq_exact,{f,Vf},[R,{Type,Val}]}|Sis]; + {test,is_eq_exact,{f,Vf},[R,{type(Type),Val}]}|Sis]; select_val_cg(Type, R, Vls0, Tf, Vf, Sis) -> - Vls1 = [case Value of {f,_Lbl} -> Value; _ -> {Type,Value} end || Value <- Vls0], + Vls1 = [case Value of + {f,_Lbl} -> Value; + _ -> {type(Type),Value} + end || Value <- Vls0], [{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis]. - -select_type_test(integer) -> is_integer; -select_type_test(atom) -> is_atom; -select_type_test(float) -> is_float. + +type(k_atom) -> atom; +type(k_float) -> float; +type(k_int) -> integer. + +select_type_test(k_int) -> is_integer; +select_type_test(k_atom) -> is_atom; +select_type_test(k_float) -> is_float. combine([{Is,Vs1}, {Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]); combine([V|Vis]) -> [V|combine(Vis)]; @@ -706,36 +960,40 @@ select_literal(S, V, Tf, Vf, Bef, St) -> end, match_fmf(F, Tf, St, S). -select_cons(#l{ke={val_clause,{cons,Es},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) -> +select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B,anno=#l{i=I,vdb=Vdb}}, + V, Tf, Vf, Bef, St0) -> + Es = [Hd,Tl], {Eis,Int,St1} = select_extract_cons(V, Es, I, Vdb, Bef, St0), {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), {[{test,is_nonempty_list,{f,Tf},[fetch_var(V, Bef)]}] ++ Eis ++ Bis,Aft,St2}. -select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) -> +select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, Bef, St0) -> {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), {[{test,is_nil,{f,Tf},[fetch_var(V, Bef)]}] ++ Bis,Aft,St1}. -select_binary(#l{ke={val_clause,{binary,{var,V}},B},i=I,vdb=Vdb}, - V, Tf, Vf, Bef, St0) -> +select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=V}},body=B, + anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) -> + #cg{ctx=OldCtx} = St0, Int0 = clear_dead(Bef#sr{reg=Bef#sr.reg}, I, Vdb), - {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=V}), CtxReg = fetch_var(V, Int0), Live = max_reg(Bef#sr.reg), Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg}, {bs_save2,CtxReg,{V,V}}|Bis0], Bis = finish_select_binary(Bis1), - {Bis,Aft,St1}; -select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb}, - V, Tf, Vf, Bef, St0) -> + {Bis,Aft,St1#cg{ctx=OldCtx}}; +select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ivar}},body=B, + anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) -> + #cg{ctx=OldCtx} = St0, Regs = put_reg(Ivar, Bef#sr.reg), Int0 = clear_dead(Bef#sr{reg=Regs}, I, Vdb), - {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=Ivar}), CtxReg = fetch_var(Ivar, Int0), Live = max_reg(Bef#sr.reg), Bis1 = [{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg}, {bs_save2,CtxReg,{Ivar,Ivar}}|Bis0], Bis = finish_select_binary(Bis1), - {Bis,Aft,St1}. + {Bis,Aft,St1#cg{ctx=OldCtx}}. finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) -> [I|finish_select_binary(Is)]; @@ -757,9 +1015,16 @@ select_bin_segs(Scs, Ivar, Tf, Bef, St) -> select_bin_seg(S, Ivar, Fail, Bef, Sta) end, Tf, St, Scs). -select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a=A}, - Ivar, Fail, Bef, St0) -> +select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T, + seg=Seg,flags=Fs0,next=Next}, + body=B, + anno=#l{i=I,vdb=Vdb,a=A}}, Ivar, Fail, Bef, St0) -> + Ctx = St0#cg.ctx, Fs = [{anno,A}|Fs0], + Es = case Next of + [] -> [Seg]; + _ -> [Seg,Next] + end, {Mis,Int,St1} = select_extract_bin(Es, Size, U, T, Fs, Fail, I, Vdb, Bef, Ctx, B, St0), {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), @@ -772,9 +1037,12 @@ select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a= [{bs_restore2,CtxReg,{Ctx,Ivar}}|Mis++Bis] end, {Is,Aft,St2}; -select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb}, - Ivar, Fail, Bef, St0) -> - {Mis,Int,St1} = select_extract_int(Es, Val, Sz, U, Fs, Fail, +select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs, + val=Val,next=Next}, + body=B, + anno=#l{i=I,vdb=Vdb}}, Ivar, Fail, Bef, St0) -> + Ctx = St0#cg.ctx, + {Mis,Int,St1} = select_extract_int(Next, Val, Sz, U, Fs, Fail, I, Vdb, Bef, Ctx, St0), {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), CtxReg = fetch_var(Ctx, Bef), @@ -795,7 +1063,7 @@ select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb}, end, {[{bs_restore2,CtxReg,{Ctx,Ivar}}|Is],Aft,St2}. -select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf, +select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, I, Vdb, Bef, Ctx, St) -> Bits = U*Sz, Bin = case member(big, Fs) of @@ -816,7 +1084,7 @@ select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf, end, {Is,clear_dead(Bef, I, Vdb),St}. -select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf, +select_extract_bin([#k_var{name=Hd},#k_var{name=Tl}], Size0, Unit, Type, Flags, Vf, I, Vdb, Bef, Ctx, _Body, St) -> SizeReg = get_bin_size_reg(Size0, Bef), {Es,Aft} = @@ -839,11 +1107,11 @@ select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf, {bs_save2,CtxReg,{Ctx,Tl}}],Int1} end, {Es,clear_dead(Aft, I, Vdb),St}; -select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, +select_extract_bin([#k_var{name=Hd}], Size, Unit, binary, Flags, Vf, I, Vdb, Bef, Ctx, Body, St) -> %% Match the last segment of a binary. We KNOW that the size %% must be 'all'. - Size = {atom,all}, %Assertion. + #k_atom{val=all} = Size, %Assertion. {Es,Aft} = case vdb_find(Hd, Vdb) of {_,_,Lhd} when Lhd =< I -> @@ -868,7 +1136,7 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Bef#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,Size,Unit,{field_flags,Flags}],Rhd}], + [CtxReg,atomic(Size),Unit,{field_flags,Flags}],Rhd}], Int1}; true -> %% Since the matching context will not be used again, @@ -883,43 +1151,42 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Int1#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,Size,Unit,{field_flags,Flags}],CtxReg}], + [CtxReg,atomic(Size),Unit,{field_flags,Flags}],CtxReg}], Int1} end end, {Es,clear_dead(Aft, I, Vdb),St}. %% is_context_unused(Ke) -> true | false -%% Simple heurististic to determine whether the code that follows will -%% use the current matching context again. (The information of liveness -%% calculcated by v3_life is too conservative to be useful for this purpose.) -%% 'true' means that the code that follows will definitely not use the context -%% again (because it is a block, not guard or matching code); 'false' that we -%% are not sure (there could be more matching). - -is_context_unused(#l{ke=Ke}) -> - is_context_unused(Ke); -is_context_unused({alt,_First,Then}) -> - %% {alt,First,Then} can be used for different purposes. If the Then part +%% Simple heurististic to determine whether the code that follows +%% will use the current matching context again. (The liveness +%% information is too conservative to be useful for this purpose.) +%% 'true' means that the code that follows will definitely not use +%% the context again (because it is a block, not guard or matching +%% code); 'false' that we are not sure (there could be more +%% matching). + +is_context_unused(#k_alt{then=Then}) -> + %% #k_alt{} can be used for different purposes. If the Then part %% is a block, it means that matching has finished and is used for a guard %% to choose between the matched clauses. is_context_unused(Then); -is_context_unused({block,_}) -> +is_context_unused(#cg_block{}) -> true; is_context_unused(_) -> false. -select_bin_end(#l{ke={val_clause,{bin_end,Ctx},B}}, - Ivar, Tf, Bef, St0) -> +select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Ivar, Tf, Bef, St0) -> + Ctx = St0#cg.ctx, {Bis,Aft,St2} = match_cg(B, Tf, Bef, St0), CtxReg = fetch_var(Ctx, Bef), {[{bs_restore2,CtxReg,{Ctx,Ivar}}, {test,bs_test_tail2,{f,Tf},[CtxReg,0]}|Bis],Aft,St2}. -get_bin_size_reg({var,V}, Bef) -> +get_bin_size_reg(#k_var{name=V}, Bef) -> fetch_var(V, Bef); get_bin_size_reg(Literal, _Bef) -> - Literal. + atomic(Literal). build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags, Rhd) -> {Format,Name} = case Type of @@ -953,11 +1220,18 @@ build_skip_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags) -> {test,Name,{f,Vf},[CtxReg,Live,{field_flags,Flags}]} end. -select_val(#l{ke={val_clause,{tuple,Es},B},i=I,vdb=Vdb}, V, Vf, Bef, St0) -> +select_val(#k_val_clause{val=#k_tuple{es=Es},body=B,anno=#l{i=I,vdb=Vdb}}, + V, Vf, Bef, St0) -> {Eis,Int,St1} = select_extract_tuple(V, Es, I, Vdb, Bef, St0), {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), {length(Es),Eis ++ Bis,Aft,St2}; -select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) -> +select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, Bef, St0) -> + Val = case Val0 of + #k_atom{val=Lit} -> Lit; + #k_float{val=Lit} -> Lit; + #k_int{val=Lit} -> Lit; + #k_literal{val=Lit} -> Lit + end, {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), {Val,Bis,Aft,St1}. @@ -966,7 +1240,7 @@ select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) -> %% Extract tuple elements, but only if they do not immediately die. select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> - F = fun ({var,V}, {Int0,Elem}) -> + F = fun (#k_var{name=V}, {Int0,Elem}) -> case vdb_find(V, Vdb) of {V,_,L} when L =< I -> {[], {Int0,Elem+1}}; _Other -> @@ -983,9 +1257,10 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> select_map(Scs, V, Tf, Vf, Bef, St0) -> Reg = fetch_var(V, Bef), {Is,Aft,St1} = - match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> - select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) - end, Vf, St0, Scs), + match_fmf(fun(#k_val_clause{val=#k_map{op=exact,es=Es}, + body=B,anno=#l{i=I,vdb=Vdb}}, Fail, St1) -> + select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) + end, Vf, St0, Scs), {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) -> @@ -1002,29 +1277,32 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> %% Assume keys are term-sorted Rsrc = fetch_var(Src, Bef), - {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun - ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> - RK = fetch_var(K,Int0), - {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - RK = fetch_var(K,Int0), - RV = fetch_reg(V,Reg1), - {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} - end; - ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> - {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1} - end - end, {{[],[],[],[]},Bef}, Vs), + {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = + foldr(fun(#k_map_pair{key=#k_var{name=K},val=#k_var{name=V}}, + {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + RK = fetch_var(K,Int0), + {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + RK = fetch_var(K,Int0), + RV = fetch_reg(V,Reg1), + {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} + end; + (#k_map_pair{key=Key,val=#k_var{name=V}}, + {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + {{[atomic(Key)|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + {{HasKsi,[atomic(Key),fetch_reg(V, Reg1)|GetVsi], + HasVarVsi,GetVarVsi},Int1} + end + end, {{[],[],[],[]},Bef}, Vs), Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++ [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++ @@ -1033,7 +1311,7 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> {Code, Aft, St}. -select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> +select_extract_cons(Src, [#k_var{name=Hd}, #k_var{name=Tl}], I, Vdb, Bef, St) -> {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I -> %% Both head and tail are dead. No need to generate @@ -1056,7 +1334,7 @@ select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> {Es,Aft,St}. -guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) -> +guard_clause_cg(#k_guard_clause{anno=#l{vdb=Vdb},guard=G,body=B}, Fail, Bef, St0) -> {Gis,Int,St1} = guard_cg(G, Fail, Vdb, Bef, St0), {Bis,Aft,St} = match_cg(B, Fail, Int, St1), {Gis ++ Bis,Aft,St}. @@ -1069,11 +1347,13 @@ guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) -> %% the correct exit point. Primops and tests all go to the next %% instruction on success or jump to a failure label. -guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) -> +guard_cg(#k_protected{arg=Ts,ret=Rs,anno=#l{i=I,vdb=Pdb}}, Fail, _Vdb, Bef, St) -> protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St); -guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) -> +guard_cg(#cg_block{es=Ts,anno=#l{i=I,vdb=Bdb}}, Fail, _Vdb, Bef, St) -> guard_cg_list(Ts, Fail, I, Bdb, Bef, St); -guard_cg(#l{ke={test,Test,As,Inverted},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St0) -> +guard_cg(#k_test{anno=#l{i=I},op=Test0,args=As,inverted=Inverted}, + Fail, Vdb, Bef, St0) -> + #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0, case Inverted of false -> test_cg(Test, As, Fail, I, Vdb, Bef, St0); @@ -1107,7 +1387,7 @@ protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) -> St2#cg{bfail=Pfail}), %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]), %% Set return values to false. - Mis = [{move,{atom,false},fetch_var(V,Aft)}||{var,V} <- Rs], + Mis = [{move,{atom,false},fetch_var(V,Aft)}||#k_var{name=V} <- Rs], {Tis ++ [{jump,{f,Psucc}}, {label,Pfail}] ++ Mis ++ [{label,Psucc}], Aft,St3#cg{bfail=St0#cg.bfail}}. @@ -1132,7 +1412,7 @@ test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> Arg = cg_reg_arg_prefer_y(A, Bef), Aft = clear_dead(Bef, I, Vdb), {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; -test_cg(is_boolean, [{atom,Val}], Fail, I, Vdb, Bef, St) -> +test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) -> Aft = clear_dead(Bef, I, Vdb), Is = case is_boolean(Val) of true -> []; @@ -1178,7 +1458,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> %% frame size. Finally the actual call is made. Call then needs the %% return values filled in. -call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) -> +call_cg(#k_var{}=Var, As, Rs, Le, Vdb, Bef, St0) -> {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), %% Put return values in registers. Reg = load_vars(Rs, clear_regs(Int#sr.reg)), @@ -1187,9 +1467,8 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) -> {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft, need_stack_frame(St0)}; -call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) - when element(1, Mod) =:= var; - element(1, Name) =:= var -> +call_cg(#k_remote{mod=Mod,name=Name}, As, Rs, Le, Vdb, Bef, St0) + when is_record(Mod, k_var); is_record(Name, k_var) -> {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), %% Put return values in registers. Reg = load_vars(Rs, clear_regs(Int#sr.reg)), @@ -1207,8 +1486,9 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> %% %% move {atom,ok} DestReg %% jump FailureLabel - {remote,{atom,erlang},{atom,error}} = Func, %Assertion. - [{var,DestVar}] = Rs, + #k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=error}} = Func, %Assertion. + [#k_var{name=DestVar}] = Rs, Int0 = clear_dead(Bef, Le#l.i, Vdb), Reg = put_reg(DestVar, Int0#sr.reg), Int = Int0#sr{reg=Reg}, @@ -1227,11 +1507,11 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> {Sis ++ Frees ++ [line(Le)|Call],Aft,St1} end. -build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> +build_call(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> {[send],need_stack_frame(St0)}; -build_call({remote,{atom,Mod},{atom,Name}}, Arity, St0) -> +build_call(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) -> {[{call_ext,Arity,{extfunc,Mod,Name,Arity}}],need_stack_frame(St0)}; -build_call(Name, Arity, St0) when is_atom(Name) -> +build_call(#k_local{name=Name}, Arity, St0) when is_atom(Name) -> {Lbl,St1} = local_func_label(Name, Arity, need_stack_frame(St0)), {[{call,Arity,{f,Lbl}}],St1}. @@ -1247,16 +1527,15 @@ free_dead([Any|Stk], Y, Instr, StkAcc) -> free_dead(Stk, Y+1, Instr, [Any|StkAcc]); free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}. -enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) -> +enter_cg(#k_var{} = Var, As, Le, Vdb, Bef, St0) -> {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), {Sis ++ [line(Le),{call_fun,Arity},return], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), need_stack_frame(St0)}; -enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) - when element(1, Mod) =:= var; - element(1, Name) =:= var -> +enter_cg(#k_remote{mod=Mod,name=Name}, As, Le, Vdb, Bef, St0) + when is_record(Mod, k_var); is_record(Name, k_var) -> {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), @@ -1274,19 +1553,19 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) -> clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St1}. -build_enter({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> +build_enter(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> {[send,return],need_stack_frame(St0)}; -build_enter({remote,{atom,Mod},{atom,Name}}, Arity, St0) -> +build_enter(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) -> St1 = case trap_bif(Mod, Name, Arity) of true -> need_stack_frame(St0); false -> St0 end, {[{call_ext_only,Arity,{extfunc,Mod,Name,Arity}}],St1}; -build_enter(Name, Arity, St0) when is_atom(Name) -> +build_enter(#k_local{name=Name}, Arity, St0) when is_atom(Name) -> {Lbl,St1} = local_func_label(Name, Arity, St0), {[{call_only,Arity,{f,Lbl}}],St1}. -enter_line({remote,{atom,Mod},{atom,Name}}, Arity, Le) -> +enter_line(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, Le) -> case erl_bifs:is_safe(Mod, Name, Arity) of false -> %% Tail-recursive call, possibly to a BIF. @@ -1334,6 +1613,22 @@ trap_bif(erlang, group_leader, 2) -> true; trap_bif(erlang, exit, 2) -> true; trap_bif(_, _, _) -> false. +%% bif_cg(#k_bif{}, Le, Vdb, StackReg, State) -> +%% {[Ainstr],StackReg,State}. +%% Generate code a BIF. + +bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, Vdb, Bef, St) -> + internal_cg(Name, As, Rs, Le, Vdb, Bef, St); +bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, + args=As,ret=Rs}, Le, Vdb, Bef, St) -> + Ar = length(As), + case is_gc_bif(Name, Ar) of + false -> + bif_cg(Name, As, Rs, Le, Vdb, Bef, St); + true -> + gc_bif_cg(Name, As, Rs, Le, Vdb, Bef, St) + end. + %% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. @@ -1352,8 +1647,8 @@ internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> clear_dead(Bef, Le#l.i, Vdb), St0}; internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) -> %% This behaves more like a function call. - {atom,Func} = Func0, - {integer,Arity} = Arity0, + #k_atom{val=Func} = Func0, + #k_int{val=Arity} = Arity0, {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), Reg = load_vars(Rs, clear_regs(Int#sr.reg)), {FuncLbl,St1} = local_func_label(Func, Arity, St0), @@ -1373,7 +1668,7 @@ internal_cg(raise, As, Rs, Le, Vdb, Bef, St) -> %% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. -bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> +bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) -> Ars = cg_reg_args(As, Bef), %% If we are inside a catch and in a body (not in guard) and the @@ -1411,7 +1706,7 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% gc_bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. -gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> +gc_bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) -> Ars = cg_reg_args(As, Bef), %% If we are inside a catch and in a body (not in guard) and the @@ -1457,7 +1752,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> %% cg_recv_mesg( ) -> {[Ainstr],Aft,St}. -cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) -> +cg_recv_mesg(#k_var{name=R}, Rm, Tl, Bef, St0) -> Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, Ret = fetch_reg(R, Int0#sr.reg), %% Int1 = clear_dead(Int0, I, Rm#l.vdb), @@ -1467,22 +1762,22 @@ cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) -> %% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}. -cg_recv_wait({atom,infinity}, Tes, I, Bef, St0) -> +cg_recv_wait(#k_atom{val=infinity}, #cg_block{anno=Le,es=Tes}, I, Bef, St0) -> %% We know that the 'after' body will never be executed. %% But to keep the stack and register information up to date, %% we will generate the code for the 'after' body, and then discard it. - Int1 = clear_dead(Bef, I, Tes#l.vdb), - {_,Int2,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, - Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0), + Int1 = clear_dead(Bef, I, Le#l.vdb), + {_,Int2,St1} = cg_block(Tes, Le#l.i, Le#l.vdb, + Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0), {[{wait,{f,St1#cg.recv}}],Int2,St1}; -cg_recv_wait({integer,0}, Tes, _I, Bef, St0) -> - {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, Bef, St0), +cg_recv_wait(#k_int{val=0}, #cg_block{anno=Le,es=Tes}, _I, Bef, St0) -> + {Tis,Int,St1} = cg_block(Tes, Le#l.i, Le#l.vdb, Bef, St0), {[timeout|Tis],Int,St1}; -cg_recv_wait(Te, Tes, I, Bef, St0) -> +cg_recv_wait(Te, #cg_block{anno=Le,es=Tes}, I, Bef, St0) -> Reg = cg_reg_arg(Te, Bef), %% Must have empty registers here! Bug if anything in registers. - Int0 = clear_dead(Bef, I, Tes#l.vdb), - {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, + Int0 = clear_dead(Bef, I, Le#l.vdb), + {Tis,Int,St1} = cg_block(Tes, Le#l.i, Le#l.vdb, Int0#sr{reg=clear_regs(Int0#sr.reg)}, St0), {[{wait_timeout,{f,St1#cg.recv},Reg},timeout] ++ Tis,Int,St1}. @@ -1500,7 +1795,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) -> {B,St1} = new_label(St0), %Body label {H,St2} = new_label(St1), %Handler label {E,St3} = new_label(St2), %End label - TryTag = Ta#l.i, + #l{i=TryTag} = get_kanno(Ta), Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)}, TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk), {Ais,Int2,St4} = cg(Ta, Vdb, Int1, St3#cg{break=B,in_catch=true}), @@ -1520,7 +1815,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) -> try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) -> {B,St1} = new_label(St0), %Body label {H,St2} = new_label(St1), %Handler label - TryTag = Ta#l.i, + #l{i=TryTag} = get_kanno(Ta), Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)}, TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk), {Ais,Int2,St3} = cg(Ta, Vdb, Int1, St2#cg{break=B,in_catch=true}), @@ -1538,7 +1833,7 @@ try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) -> %% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> +catch_cg(#cg_block{es=C}, #k_var{name=R}, Le, Vdb, Bef, St0) -> {B,St1} = new_label(St0), CatchTag = Le#l.i, Int1 = Bef#sr{stk=put_catch(CatchTag, Bef#sr.stk)}, @@ -1552,8 +1847,8 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> clear_dead(Aft, Le#l.i, Vdb), St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}. -%% set_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% We have to be careful how a 'set' works. First the structure is +%% put_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. +%% We have to be careful how a 'put' works. First the structure is %% built, then it is filled and finally things can be cleared. The %% annotation must reflect this and make sure that the return %% variable is allocated first. @@ -1561,13 +1856,14 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> %% put_list and put_map are atomic instructions, both of %% which can safely resuse one of the source registers as target. -set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> - [S1,S2] = cg_reg_args(Es, Bef), +put_cg([#k_var{name=R}], #k_cons{hd=Hd,tl=Tl}, Le, Vdb, Bef, St) -> + [S1,S2] = cg_reg_args([Hd,Tl], Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), 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{bfail=Bfail}=St) -> +put_cg([#k_var{name=R}], #k_binary{segs=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. @@ -1595,7 +1891,9 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> {Sis++Code,Aft,St}; %% Map: single variable key. -set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) -> +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, + es=[#k_map_pair{key=#k_var{}=K,val=V}]}, + Le, Vdb, Bef, St0) -> {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), SrcReg = cg_reg_arg_prefer_y(Map, Int0), @@ -1610,22 +1908,23 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) -> Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, Target = fetch_reg(R, Aft#sr.reg), - {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0), + {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), {Sis++Is,Aft,St1}; %% Map: (possibly) multiple literal keys. -set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) -> +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, Vdb, Bef, St0) -> %% assert key literals - [] = [Var||{map_pair,{var,_}=Var,_} <- Es], + [] = [Var || #k_map_pair{key=#k_var{}=Var} <- Es], {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), %% fetch registers for values to be put into the map - Pairs = [{K,V} || {_,K,V} <- Es], - List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), + List = flatmap(fun(#k_map_pair{key=K,val=V}) -> + [atomic(K),cg_reg_arg(V, Int0)] + end, Es), Live = max_reg(Bef#sr.reg), @@ -1634,16 +1933,16 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) -> Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, Target = fetch_reg(R, Aft#sr.reg), - {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0), + {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), {Sis++Is,Aft,St1}; %% Everything else. -set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> +put_cg([#k_var{name=R}], Con, Le, Vdb, Bef, St) -> %% Find a place for the return register first. Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, Ret = fetch_reg(R, Int#sr.reg), Ais = case Con of - {tuple,Es} -> + #k_tuple{es=Es} -> [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); Other -> [{move,cg_reg_arg(Other, Int),Ret}] @@ -1651,7 +1950,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> {Ais,clear_dead(Int, Le#l.i, Vdb),St}. -set_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) -> +put_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) -> Bfail = St0#cg.bfail, Fail = {f,St0#cg.bfail}, Op = case Op0 of @@ -1865,7 +2164,8 @@ cg_bin_opt_1([I|Is]) -> cg_bin_opt_1([]) -> []. -cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) -> +cg_bin_put(#k_bin_seg{size=S0,unit=U,type=T,flags=Fs,seg=E0,next=Next}, + Fail, Bef) -> S1 = cg_reg_arg(S0, Bef), E1 = cg_reg_arg(E0, Bef), {Format,Op} = case T of @@ -1882,7 +2182,7 @@ cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) -> utf -> [{Op,Fail,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)] end; -cg_bin_put({bin_end,[]}, _, _) -> []. +cg_bin_put(#k_bin_end{}, _, _) -> []. cg_build_args(As, Bef) -> [{put,cg_reg_arg(A, Bef)} || A <- As]. @@ -1936,11 +2236,11 @@ get_locked_regs([], _) -> []. cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As]. -cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef); -cg_reg_arg(Literal, _) -> Literal. +cg_reg_arg(#k_var{name=V}, Bef) -> fetch_var(V, Bef); +cg_reg_arg(Literal, _) -> atomic(Literal). -cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef); -cg_reg_arg_prefer_y(Literal, _) -> Literal. +cg_reg_arg_prefer_y(#k_var{name=V}, Bef) -> fetch_var_prefer_y(V, Bef); +cg_reg_arg_prefer_y(Literal, _) -> atomic(Literal). %% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}. %% Do the complete setup for a call/enter. @@ -1978,9 +2278,9 @@ cg_call_args(As, Bef, I, Vdb) -> load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0). -load_arg_regs([_|Rs], [{var,V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)]; +load_arg_regs([_|Rs], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)]; load_arg_regs([_|Rs], [A|As], I) -> [{I,A}|load_arg_regs(Rs, As, I+1)]; -load_arg_regs([], [{var,V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)]; +load_arg_regs([], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)]; load_arg_regs([], [A|As], I) -> [{I,A}|load_arg_regs([], As, I+1)]; load_arg_regs(Rs, [], _) -> Rs. @@ -2016,12 +2316,13 @@ move_unsaved([], _, Regs, Acc) -> {Acc,Regs}. gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []). -gen_moves([{var,V}|As], Sr, I, Acc) -> +gen_moves([#k_var{name=V}|As], Sr, I, Acc) -> case fetch_var(V, Sr) of {x,I} -> gen_moves(As, Sr, I+1, Acc); Reg -> gen_moves(As, Sr, I+1, [{move,Reg,{x,I}}|Acc]) end; -gen_moves([A|As], Sr, I, Acc) -> +gen_moves([A0|As], Sr, I, Acc) -> + A = atomic(A0), gen_moves(As, Sr, I+1, [{move,A,{x,I}}|Acc]); gen_moves([], _, _, Acc) -> lists:keysort(3, Acc). @@ -2190,7 +2491,7 @@ fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) -> end. load_vars(Vs, Regs) -> - foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). + foldl(fun (#k_var{name=V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). %% put_reg(Val, Regs) -> Regs. %% find_reg(Val, Regs) -> {ok,r{R}} | error. @@ -2291,6 +2592,16 @@ put_catch(Tag, [Other|Stk], Acc) -> drop_catch(Tag, [{{catch_tag,Tag}}|Stk]) -> [free|Stk]; drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)]. +%% atomic(Klit) -> Lit. +%% atomic_list([Klit]) -> [Lit]. + +atomic(#k_literal{val=V}) -> {literal,V}; +atomic(#k_int{val=I}) -> {integer,I}; +atomic(#k_float{val=F}) -> {float,F}; +atomic(#k_atom{val=A}) -> {atom,A}; +%%atomic(#k_char{val=C}) -> {char,C}; +atomic(#k_nil{}) -> nil. + %% new_label(St) -> {L,St}. new_label(#cg{lcount=Next}=St) -> @@ -2333,3 +2644,86 @@ flatmapfoldl(F, Accu0, [Hd|Tail]) -> {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), {R++Rs,Accu2}; flatmapfoldl(_, Accu, []) -> {[],Accu}. + +%% Keep track of life time for variables. +%% +%% init_vars([{var,VarName}]) -> Vdb. +%% new_vars([VarName], I, Vdb) -> Vdb. +%% use_vars([VarName], I, Vdb) -> Vdb. +%% add_var(VarName, F, L, Vdb) -> Vdb. +%% +%% The list of variable names for new_vars/3 and use_vars/3 +%% must be sorted. + +init_vars(Vs) -> + vdb_new(Vs). + +new_vars([], _, Vdb) -> Vdb; +new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb); +new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). + +use_vars([], _, Vdb) -> + Vdb; +use_vars([V], I, Vdb) -> + case vdb_find(V, Vdb) of + {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb); + {V,_,_} -> Vdb; + error -> vdb_store_new(V, {V,I,I}, Vdb) + end; +use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). + +add_var(V, F, L, Vdb) -> + vdb_store_new(V, {V,F,L}, Vdb). + +%% vdb + +vdb_new(Vs) -> + ordsets:from_list([{V,0,0} || #k_var{name=V} <- Vs]). + +-type var() :: atom(). + +-spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry(). + +vdb_find(V, Vdb) -> + case lists:keyfind(V, 1, Vdb) of + false -> error; + Vd -> Vd + end. + +vdb_update(V, Update, [{V,_,_}|Vdb]) -> + [Update|Vdb]; +vdb_update(V, Update, [Vd|Vdb]) -> + [Vd|vdb_update(V, Update, Vdb)]. + +vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 -> + [Vd|vdb_store_new(V, New, Vdb)]; +vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 -> + [New|Vdb]; +vdb_store_new(_, New, []) -> [New]. + +vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> + [Vd|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) -> + %% Existing variable. + if + I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)]; + true -> [Vd|vdb_update_vars(Vs, Vdb, I)] + end; +vdb_update_vars([V|Vs], [], I) -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, [], I)]; +vdb_update_vars([], Vdb, _) -> Vdb. + +%% vdb_sub(Min, Max, Vdb) -> Vdb. +%% Extract variables which are used before and after Min. Lock +%% variables alive after Max. + +vdb_sub(Min, Max, Vdb) -> + [ if L >= Max -> {V,F,locked}; + true -> Vd + end || {V,F,L}=Vd <- Vdb, + F < Min, + L >= Min ]. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index cbc8bb1303..3eea058153 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -160,8 +160,7 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), {B1,_,St3} = ubody(B0, return, St2), %%B1 = B0, St3 = St2, %Null second pass - {#k_fdef{anno=#k{us=[],ns=[],a=Ab}, - func=F,arity=Arity,vars=Kvs,body=B1},St3} + {make_fdef(#k{us=[],ns=[],a=Ab}, F, Arity, Kvs, B1),St3} catch Class:Error -> Stack = erlang:get_stacktrace(), @@ -2262,9 +2261,8 @@ iletrec_funs_gen(Fs, FreeVs, St) -> Arity0 = length(Vs), {Fb1,_,Lst1} = ubody(Fb0, return, Lst0#kern{ff={N,Arity0}}), Arity = Arity0 + length(FreeVs), - Fun = #k_fdef{anno=#k{us=[],ns=[],a=Fa}, - func=N,arity=Arity, - vars=Vs ++ FreeVs,body=Fb1}, + Fun = make_fdef(#k{us=[],ns=[],a=Fa}, N, Arity, + Vs++FreeVs, Fb1), Lst1#kern{funs=[Fun|Lst1#kern.funs]} end, St, Fs). @@ -2408,8 +2406,7 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> %% No id annotation. Must invent a fun name. new_fun_name(St1) end, - Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, - vars=Vs ++ Fvs,body=B1}, + Fun = make_fdef(#k{us=[],ns=[],a=A}, Fname, Arity, Vs++Fvs, B1), {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, op=#k_internal{name=make_fun,arity=length(Free)+2}, args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs], @@ -2426,6 +2423,16 @@ uexpr(Lit, {break,Rs0}, St0) -> add_local_function(_, #kern{funs=ignore}=St) -> St; add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}. +%% Make a #k_fdef{}, making sure that the body is always a #k_match{}. +make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) -> + #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Body}; +make_fdef(Anno, Name, Arity, Vs, Body) -> + Ka = get_kanno(Body), + Match = #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, + vars=Vs,body=Body,ret=[]}, + #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Match}. + + %% handle_reuse_annos([#k_var{}], State) -> State. %% In general, it is only safe to reuse a variable for a match context %% if the original value of the variable will no longer be needed. diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index 7cd30b25a8..87011b7680 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -79,7 +79,7 @@ -record(k_guard_clause, {anno=[],guard,body}). -record(k_break, {anno=[],args=[]}). --record(k_guard_break, {anno=[],args=[]}). +-record(k_guard_break, {anno=[],args=[],locked=[]}). -record(k_return, {anno=[],args=[]}). %%k_get_anno(Thing) -> element(2, Thing). diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl deleted file mode 100644 index be3ade47ff..0000000000 --- a/lib/compiler/src/v3_life.erl +++ /dev/null @@ -1,468 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% 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% -%% -%% Purpose : Convert annotated kernel expressions to annotated beam format. - -%% This module creates beam format annotated with variable lifetime -%% information. Each thing is given an index and for each variable we -%% store the first and last index for its occurrence. The variable -%% database, VDB, attached to each thing is only relevant internally -%% for that thing. -%% -%% For nested things like matches the numbering continues locally and -%% the VDB for that thing refers to the variable usage within that -%% thing. Variables which live through a such a thing are internally -%% given a very large last index. Internally the indexes continue -%% after the index of that thing. This creates no problems as the -%% internal variable info never escapes and externally we only see -%% variable which are alive both before or after. -%% -%% This means that variables never "escape" from a thing and the only -%% way to get values from a thing is to "return" them, with 'break' or -%% 'return'. Externally these values become the return values of the -%% thing. This is no real limitation as most nested things have -%% multiple threads so working out a common best variable usage is -%% difficult. - --module(v3_life). - --export([module/2]). - --export([vdb_find/2]). - --import(lists, [member/2,map/2,reverse/1,sort/1]). --import(ordsets, [add_element/2,intersection/2,union/2]). - --include("v3_kernel.hrl"). --include("v3_life.hrl"). - --type fa() :: {atom(),arity()}. - -%% These are not defined in v3_kernel.hrl. -get_kanno(Kthing) -> element(2, Kthing). -%%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). - --spec module(#k_mdef{}, [compile:option()]) -> - {'ok',{module(),[fa()],[_],[_]}}. - -module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, _Opts) -> - Fs1 = functions(Fs0, []), - {ok,{M,Es,As,Fs1}}. - -functions([F|Fs], Acc) -> - functions(Fs, [function(F)|Acc]); -functions([], Acc) -> reverse(Acc). - -%% function(Kfunc) -> Func. - -function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> - try - As = var_list(Vs), - Vdb0 = init_vars(As), - %% Force a top-level match! - B0 = case Kb of - #k_match{} -> Kb; - _ -> - Ka = get_kanno(Kb), - #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, - vars=Vs,body=Kb,ret=[]} - end, - {B1,_,Vdb1} = body(B0, 1, Vdb0), - {function,F,Ar,As,B1,Vdb1,Anno} - catch - Class:Error -> - Stack = erlang:get_stacktrace(), - io:fwrite("Function: ~w/~w\n", [F,Ar]), - erlang:raise(Class, Error, Stack) - end. - -%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. -%% Handle a body. - -body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), - {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), - E = expr(Ke, I, Vdb2), - {[E|Es],MaxI,Vdb2}; -body(Ke, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), - E = expr(Ke, I, Vdb1), - {[E],I,Vdb1}. - -%% protected(Kprotected, I, Vdb) -> Protected. -%% Only used in guards. - -protected(#k_protected{anno=A,arg=Ts,ret=Rs}, I, Vdb) -> - %% Lock variables that are alive before try and used afterwards. - %% Don't lock variables that are only used inside the protected - %% expression. - Pdb0 = vdb_sub(I, I+1, Vdb), - {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), - Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values - #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}. - -%% expr(Kexpr, I, Vdb) -> Expr. - -expr(#k_test{anno=A,op=Op,args=As,inverted=Inverted}, I, _Vdb) -> - #l{ke={test,test_op(Op),atomic_list(As),Inverted},i=I,a=A#k.a}; -expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; -expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={enter,call_op(Op),atomic_list(As)},i=I,a=A#k.a}; -expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - Bif = k_bif(A, Op, As, Rs), - #l{ke=Bif,i=I,a=A#k.a}; -expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, [], Mdb), - #l{ke={match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, [], Mdb), - #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -expr(#k_try{}=Try, I, Vdb) -> - body_try(Try, I, Vdb); -expr(#k_protected{}=Protected, I, Vdb) -> - protected(Protected, I, Vdb); -expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), - #l{ke={try_enter,#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, - var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, - var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}}, - i=I,vdb=Tdb1,a=A#k.a}; -expr(#k_catch{anno=A,body=Kb,ret=[R]}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the catch. - %% Add catch tag 'variable'. - Cdb0 = vdb_sub(I, I+1, Vdb), - {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)), - #l{ke={'catch',Es,variable(R)},i=I,vdb=Cdb1,a=A#k.a}; -expr(#k_receive{anno=A,var=V,body=Kb,timeout=T,action=Ka,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Rdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, [], - new_vars([V#k_var.name], I, Rdb)), - {Tes,_,Adb} = body(Ka, I+1, Rdb), - #l{ke={receive_loop,atomic(T),variable(V),M, - #l{ke=Tes,i=I+1,vdb=Adb,a=[]},var_list(Rs)}, - i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a}; -expr(#k_receive_accept{anno=A}, I, _Vdb) -> - #l{ke=receive_accept,i=I,a=A#k.a}; -expr(#k_receive_next{anno=A}, I, _Vdb) -> - #l{ke=receive_next,i=I,a=A#k.a}; -expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) -> - #l{ke={set,var_list(Rs),literal(Arg, [])},i=I,a=A#k.a}; -expr(#k_break{anno=A,args=As}, I, _Vdb) -> - #l{ke={break,atomic_list(As)},i=I,a=A#k.a}; -expr(#k_guard_break{anno=A,args=As}, I, Vdb) -> - Locked = [V || {V,_,_} <- Vdb], - #l{ke={guard_break,atomic_list(As),Locked},i=I,a=A#k.a}; -expr(#k_return{anno=A,args=As}, I, _Vdb) -> - #l{ke={return,atomic_list(As)},i=I,a=A#k.a}. - -body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, - I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), - #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, - var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, - var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}, - var_list(Rs)}, - i=I,vdb=Tdb1,a=A#k.a}. - -%% call_op(Op) -> Op. -%% test_op(Op) -> Op. -%% Do any necessary name translations here to munge into beam format. - -call_op(#k_local{name=N}) -> N; -call_op(#k_remote{mod=M,name=N}) -> {remote,atomic(M),atomic(N)}; -call_op(Other) -> variable(Other). - -test_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N. - -%% k_bif(Anno, Op, [Arg], [Ret], Vdb) -> Expr. -%% Build bifs. - -k_bif(_A, #k_internal{name=Name}, As, Rs) -> - {internal,Name,atomic_list(As),var_list(Rs)}; -k_bif(_A, #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, As, Rs) -> - Ar = length(As), - case is_gc_bif(Name, Ar) of - false -> - {bif,Name,atomic_list(As),var_list(Rs)}; - true -> - {gc_bif,Name,atomic_list(As),var_list(Rs)} - end. - -%% match(Kexpr, [LockVar], I, Vdb) -> Expr. -%% Convert match tree to old format. - -match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Ctxt, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - F = match(Kf, Ls, I+1, Ctxt, Vdb1), - T = match(Kt, Ls, I+1, Ctxt, Vdb1), - #l{ke={alt,F,T},i=I,vdb=Vdb1,a=A#k.a}; -match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) -> - Vanno = get_kanno(V), - Ls1 = case member(no_usage, Vanno) of - false -> add_element(V#k_var.name, Ls0); - true -> Ls0 - end, - Anno = case member(reuse_for_context, Vanno) of - true -> [reuse_for_context|A#k.a]; - false -> A#k.a - end, - Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), - Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts], - #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; -match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs], - #l{ke={guard,Cs},i=I,vdb=Vdb1,a=A#k.a}; -match(Other, Ls, I, _Ctxt, Vdb0) -> - Vdb1 = use_vars(Ls, I, Vdb0), - {B,_,Vdb2} = body(Other, I+1, Vdb1), - #l{ke={block,B},i=I,vdb=Vdb2,a=[]}. - -type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Ctxt, Vdb0) -> - %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]), - Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0), - Vs = [val_clause(Vc, Ls, I+1, Ctxt, Vdb1) || Vc <- Kvs], - #l{ke={type_clause,type(T),Vs},i=I,vdb=Vdb1,a=A#k.a}. - -val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) -> - New = (get_kanno(V))#k.ns, - Bus = (get_kanno(Kb))#k.us, - %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]), - Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety - Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)), - Ctxt = case V of - #k_binary{segs=#k_var{name=C0}} -> C0; - _ -> Ctxt0 - end, - B = match(Kb, Ls1, I+1, Ctxt, Vdb1), - #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. - -guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), - Gdb = vdb_sub(I+1, I+2, Vdb1), - G = protected(Kg, I+1, Gdb), - B = match(Kb, Ls, I+2, Ctxt, Vdb1), - #l{ke={guard_clause,G,B}, - i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1), - a=A#k.a}. - -%% type(Ktype) -> Type. - -type(k_literal) -> literal; -type(k_int) -> integer; -%%type(k_char) -> integer; %Hhhmmm??? -type(k_float) -> float; -type(k_atom) -> atom; -type(k_nil) -> nil; -type(k_cons) -> cons; -type(k_tuple) -> tuple; -type(k_binary) -> binary; -type(k_bin_seg) -> bin_seg; -type(k_bin_int) -> bin_int; -type(k_bin_end) -> bin_end; -type(k_map) -> map. - -%% variable(Klit) -> Lit. -%% var_list([Klit]) -> [Lit]. - -variable(#k_var{name=N}) -> {var,N}. - -var_list(Ks) -> [variable(K) || K <- Ks]. - -%% atomic(Klit) -> Lit. -%% atomic_list([Klit]) -> [Lit]. - -atomic(#k_literal{val=V}) -> {literal,V}; -atomic(#k_var{name=N}) -> {var,N}; -atomic(#k_int{val=I}) -> {integer,I}; -atomic(#k_float{val=F}) -> {float,F}; -atomic(#k_atom{val=N}) -> {atom,N}; -%%atomic(#k_char{val=C}) -> {char,C}; -atomic(#k_nil{}) -> nil. - -atomic_list(Ks) -> [atomic(K) || K <- Ks]. - -%% literal(Klit) -> Lit. -%% literal_list([Klit]) -> [Lit]. - -literal(#k_var{name=N}, _) -> {var,N}; -literal(#k_literal{val=I}, _) -> {literal,I}; -literal(#k_int{val=I}, _) -> {integer,I}; -literal(#k_float{val=F}, _) -> {float,F}; -literal(#k_atom{val=N}, _) -> {atom,N}; -%%literal(#k_char{val=C}, _) -> {char,C}; -literal(#k_nil{}, _) -> nil; -literal(#k_cons{hd=H,tl=T}, Ctxt) -> - {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; -literal(#k_binary{segs=V}, Ctxt) -> - {binary,literal(V, Ctxt)}; -literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> - %% Only occurs in patterns. - {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]}; -literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> - {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs, - [literal(Seg, Ctxt),literal(N, Ctxt)]}; -literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> - %% Only occurs in patterns. - {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int, - [literal(N, Ctxt)]}; -literal(#k_bin_end{}, Ctxt) -> - {bin_end,Ctxt}; -literal(#k_tuple{es=Es}, Ctxt) -> - {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) -> - {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)}; -literal(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal(K, Ctxt),literal(V, Ctxt)}. - -literal_list(Ks, Ctxt) -> - [literal(K, Ctxt) || K <- Ks]. - - -%% is_gc_bif(Name, Arity) -> true|false -%% Determines whether the BIF Name/Arity might do a GC. - -is_gc_bif(hd, 1) -> false; -is_gc_bif(tl, 1) -> false; -is_gc_bif(self, 0) -> false; -is_gc_bif(node, 0) -> false; -is_gc_bif(node, 1) -> false; -is_gc_bif(element, 2) -> false; -is_gc_bif(get, 1) -> false; -is_gc_bif(tuple_size, 1) -> false; -is_gc_bif(Bif, Arity) -> - not (erl_internal:bool_op(Bif, Arity) orelse - erl_internal:new_type_test(Bif, Arity) orelse - erl_internal:comp_op(Bif, Arity)). - -%% Keep track of life time for variables. -%% -%% init_vars([{var,VarName}]) -> Vdb. -%% new_vars([VarName], I, Vdb) -> Vdb. -%% use_vars([VarName], I, Vdb) -> Vdb. -%% add_var(VarName, F, L, Vdb) -> Vdb. -%% -%% The list of variable names for new_vars/3 and use_vars/3 -%% must be sorted. - -init_vars(Vs) -> - vdb_new(Vs). - -new_vars([], _, Vdb) -> Vdb; -new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb); -new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). - -use_vars([], _, Vdb) -> - Vdb; -use_vars([V], I, Vdb) -> - case vdb_find(V, Vdb) of - {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb); - {V,_,_} -> Vdb; - error -> vdb_store_new(V, {V,I,I}, Vdb) - end; -use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). - -add_var(V, F, L, Vdb) -> - vdb_store_new(V, {V,F,L}, Vdb). - -%% vdb - -vdb_new(Vs) -> - sort([{V,0,0} || {var,V} <- Vs]). - --type var() :: atom(). - --spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry(). - -vdb_find(V, Vdb) -> - case lists:keyfind(V, 1, Vdb) of - false -> error; - Vd -> Vd - end. - -vdb_update(V, Update, [{V,_,_}|Vdb]) -> - [Update|Vdb]; -vdb_update(V, Update, [Vd|Vdb]) -> - [Vd|vdb_update(V, Update, Vdb)]. - -vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_store_new(V, New, Vdb)]; -vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 -> - [New|Vdb]; -vdb_store_new(_, New, []) -> [New]. - -vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> - [Vd|vdb_update_vars(Vs, Vdb, I)]; -vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> - %% New variable. - [{V,I,I}|vdb_update_vars(Vs, Vdb, I)]; -vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) -> - %% Existing variable. - if - I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)]; - true -> [Vd|vdb_update_vars(Vs, Vdb, I)] - end; -vdb_update_vars([V|Vs], [], I) -> - %% New variable. - [{V,I,I}|vdb_update_vars(Vs, [], I)]; -vdb_update_vars([], Vdb, _) -> Vdb. - -%% vdb_sub(Min, Max, Vdb) -> Vdb. -%% Extract variables which are used before and after Min. Lock -%% variables alive after Max. - -vdb_sub(Min, Max, Vdb) -> - [ if L >= Max -> {V,F,locked}; - true -> Vd - end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ]. diff --git a/lib/compiler/src/v3_life.hrl b/lib/compiler/src/v3_life.hrl deleted file mode 100644 index 5c76312067..0000000000 --- a/lib/compiler/src/v3_life.hrl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% 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% -%% -%% This record contains variable life-time annotation for a -%% kernel expression. Added by v3_life, used by v3_codegen. - --type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}. - --record(l, {ke, %Kernel expression - i=0 :: non_neg_integer(), %Op number - vdb=[] :: [vdb_entry()], %Variable database - a=[] :: [term()]}). %Core annotation - diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 25983c6012..e88a132d59 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -375,7 +375,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dcbsm, ".core_bsm"), do_listing(Simple, TargetDir, dsetel, ".dsetel"), do_listing(Simple, TargetDir, dkern, ".kernel"), - do_listing(Simple, TargetDir, dlife, ".life"), do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), do_listing(Simple, TargetDir, dexcept, ".except"), diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index ea4aaf40a9..b12bcbeeab 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -171,7 +171,7 @@ silly_coverage(Config) when is_list(Config) -> expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), - %% v3_life + %% v3_codegen BadKernel = {k_mdef,[],?MODULE, [{foo,0}], [], @@ -179,11 +179,7 @@ silly_coverage(Config) when is_list(Config) -> {k,[],[],[]}, f,0,[], seriously_bad_body}]}, - expect_error(fun() -> v3_life:module(BadKernel, []) end), - - %% v3_codegen - CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]}, - expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), + expect_error(fun() -> v3_codegen:module(BadKernel, []) end), %% beam_a BeamAInput = {?MODULE,[{foo,0}],[], diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 53fe233790..c4e80e3153 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -277,7 +277,7 @@ static HMAC_CTX *HMAC_CTX_new() static void HMAC_CTX_free(HMAC_CTX *ctx) { HMAC_CTX_cleanup(ctx); - return CRYPTO_free(ctx); + CRYPTO_free(ctx); } #define EVP_MD_CTX_new() EVP_MD_CTX_create() @@ -2846,7 +2846,7 @@ static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrimeLen, Generator) */ int prime_len, generator; - DH* dh_params; + DH* dh_params = NULL; int p_len, g_len; unsigned char *p_ptr, *g_ptr; ERL_NIF_TERM ret_p, ret_g; @@ -2857,8 +2857,8 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E return enif_make_badarg(env); } - dh_params = DH_generate_parameters(prime_len, generator, NULL, NULL); - if (dh_params == NULL) { + + if (DH_generate_parameters_ex(dh_params, prime_len, generator, NULL)) { return atom_error; } DH_get0_pqg(dh_params, &dh_p, &dh_q, &dh_g); diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 589e7d5145..eded788419 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -43,6 +43,23 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 2.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A fault introduced in diameter 2.1 could cause decode + errors to be ignored in AVPs following the header of a + Grouped AVP.</p> + <p> + Own Id: OTP-14684 Aux Id: ERIERL-85 </p> + </item> + </list> + </section> + +</section> + <section><title>diameter 2.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/src/base/diameter_gen.erl b/lib/diameter/src/base/diameter_gen.erl index d3b9f704fe..93ebe57685 100644 --- a/lib/diameter/src/base/diameter_gen.erl +++ b/lib/diameter/src/base/diameter_gen.erl @@ -320,8 +320,8 @@ decode(Bin, Code, Vid, DataLen, Pad, M, P, Name, Mod, Fmt, Strict, Opts0, index = Idx}, Dec = dec(Data, Name, NameT, Mod, Fmt, Opts, Avp), - Acc = decode(T, Name, Mod, Fmt, Strict, Opts, Idx+1, AM),%% recurse - acc(Acc, Dec, I, Field, Arity, Strict, Mod, Opts); + Acc = decode(T, Name, Mod, Fmt, Strict, Opts0, Idx+1, AM),%% recurse + acc(Acc, Dec, I, Field, Arity, Strict, Mod); _ -> {NameT, _Field, _Arity, {_, AM}} = incr(Name, Code, Vid, M, Mod, Strict, Opts0, AM0), @@ -574,15 +574,17 @@ dec_AVP(Dicts, Data, Name, Mod, Fmt, Opts, #diameter_avp{code = Code, %% Try to decode an AVP in the first alternate dictionary that defines %% it. -dec_AVP([Dict | Rest], Data, Name, Mod, Fmt, Opts, Code, Vid, Avp) -> +dec_AVP([Dict | Rest], Data, Name, Mod, Fmt, Opts0, Code, Vid, Avp) -> case Dict:avp_name(Code, Vid) of - {AvpName, Type} -> + {AvpName, Type} = NameT -> A = Avp#diameter_avp{name = AvpName, type = Type}, - #{failed_avp := Failed} = Opts, + #{failed_avp := Failed} + = Opts + = setopts(NameT, Name, Avp#diameter_avp.is_mandatory, Opts0), dec(Data, Name, AvpName, Type, Mod, Dict, Fmt, Failed, Opts, A); _ -> - dec_AVP(Rest, Data, Name, Mod, Fmt, Opts, Code, Vid, Avp) + dec_AVP(Rest, Data, Name, Mod, Fmt, Opts0, Code, Vid, Avp) end; dec_AVP([], _, _, _, _, _, _, _, Avp) -> @@ -680,30 +682,30 @@ set_failed('Failed-AVP', #{failed_avp := false} = Opts) -> set_failed(_, Opts) -> Opts. -%% acc/8 +%% acc/7 -acc([AM | Acc], As, I, Field, Arity, Strict, Mod, Opts) -> - [AM | acc1(Acc, As, I, Field, Arity, Strict, Mod, Opts)]. +acc([AM | Acc], As, I, Field, Arity, Strict, Mod) -> + [AM | acc1(Acc, As, I, Field, Arity, Strict, Mod)]. -%% acc1/8 +%% acc1/7 %% Faulty AVP, not grouped. -acc1(Acc, {_RC, Avp} = E, _, _, _, _, _, _) -> +acc1(Acc, {_RC, Avp} = E, _, _, _, _, _) -> [Avps, Failed | Rec] = Acc, [[Avp | Avps], [E | Failed] | Rec]; %% Faulty component in grouped AVP. -acc1(Acc, {RC, As, Avp}, _, _, _, _, _, _) -> +acc1(Acc, {RC, As, Avp}, _, _, _, _, _) -> [Avps, Failed | Rec] = Acc, [[As | Avps], [{RC, Avp} | Failed] | Rec]; %% Grouped AVP ... -acc1([Avps | Acc], [Avp|_] = As, I, Field, Arity, Strict, Mod, Opts) -> - [[As|Avps] | acc2(Acc, Avp, I, Field, Arity, Strict, Mod, Opts)]; +acc1([Avps | Acc], [Avp|_] = As, I, Field, Arity, Strict, Mod) -> + [[As|Avps] | acc2(Acc, Avp, I, Field, Arity, Strict, Mod)]; %% ... or not. -acc1([Avps | Acc], Avp, I, Field, Arity, Strict, Mod, Opts) -> - [[Avp|Avps] | acc2(Acc, Avp, I, Field, Arity, Strict, Mod, Opts)]. +acc1([Avps | Acc], Avp, I, Field, Arity, Strict, Mod) -> + [[Avp|Avps] | acc2(Acc, Avp, I, Field, Arity, Strict, Mod)]. %% The component list of a Grouped AVP is discarded when packing into %% the record (or equivalent): the values in an 'AVP' field are @@ -713,24 +715,24 @@ acc1([Avps | Acc], Avp, I, Field, Arity, Strict, Mod, Opts) -> %% retain the same structure as in diameter_packet.avps, but an 'AVP' %% list has always been flat. -%% acc2/8 +%% acc2/7 %% No errors, but nowhere to pack. -acc2(Acc, Avp, _, 'AVP', 0, _, _, _) -> +acc2(Acc, Avp, _, 'AVP', 0, _, _) -> [Failed | Rec] = Acc, [[{rc(Avp), Avp} | Failed] | Rec]; %% Relaxed arities. -acc2(Acc, Avp, _, Field, Arity, Strict, Mod, _) +acc2(Acc, Avp, _, Field, Arity, Strict, Mod) when Strict /= decode -> pack(Arity, Field, Avp, Mod, Acc); %% No maximum arity. -acc2(Acc, Avp, _, Field, {_,'*'} = Arity, _, Mod, _) -> +acc2(Acc, Avp, _, Field, {_,'*'} = Arity, _, Mod) -> pack(Arity, Field, Avp, Mod, Acc); %% Or check. -acc2(Acc, Avp, I, Field, Arity, _, Mod, _) -> +acc2(Acc, Avp, I, Field, Arity, _, Mod) -> Mx = max_arity(Arity), if Mx =< I -> [Failed | Rec] = Acc, diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index c2198de9ea..d0e58e8410 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -54,7 +54,9 @@ {"1.12.1", [{restart_application, diameter}]}, %% 19.1 {"1.12.2", [{restart_application, diameter}]}, %% 19.3 {"2.0", [{restart_application, diameter}]}, %% 20.0 - {"2.1", [{update, diameter_reg, {advanced, "2.1"}}]} %% 20.1 + {"2.1", [{load_module, diameter_gen}, %% 20.1 + {update, diameter_reg, {advanced, "2.1"}}]}, + {"2.1.1", [{load_module, diameter_gen}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -90,6 +92,7 @@ {"1.12.1", [{restart_application, diameter}]}, {"1.12.2", [{restart_application, diameter}]}, {"2.0", [{restart_application, diameter}]}, - {"2.1", [{restart_application, diameter}]} + {"2.1", [{restart_application, diameter}]}, + {"2.1.1", [{load_module, diameter_gen}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index f73f68da0b..bfb260ed8f 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -17,5 +17,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 2.1.1 +DIAMETER_VSN = 2.1.2 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/erl_docgen/priv/dtd/erlref.dtd b/lib/erl_docgen/priv/dtd/erlref.dtd index 615b88b61a..78d6771f52 100644 --- a/lib/erl_docgen/priv/dtd/erlref.dtd +++ b/lib/erl_docgen/priv/dtd/erlref.dtd @@ -33,4 +33,5 @@ <!ATTLIST name name CDATA #IMPLIED arity CDATA #IMPLIED clause_i CDATA #IMPLIED + anchor CDATA #IMPLIED n_vars CDATA #IMPLIED> diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index 75614392fb..5b7eae4f73 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -172,6 +172,7 @@ <xsl:template name="spec_name"> <xsl:variable name="name" select="@name"/> <xsl:variable name="arity" select="@arity"/> + <xsl:variable name="anchor" select="@anchor"/> <xsl:variable name="spec0"> <xsl:call-template name="find_spec"/> </xsl:variable> @@ -198,6 +199,11 @@ </xsl:otherwise> </xsl:choose> + <!-- Insert an anchor for "anchor" attribute --> + <xsl:if test="string-length($anchor) > 0"> + <a name="{$anchor}"></a> + </xsl:if> + <xsl:variable name="global_types" select="ancestor::erlref/datatypes"/> <xsl:variable name="local_types" select="../type[string-length(@name) > 0]"/> diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index 5b2280594f..fb750dd418 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -236,4 +236,4 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-3.4","kernel-5.3", - "erts-9.0","compiler-5.0"]}]}. + "erts-9.2","compiler-5.0"]}]}. diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 52ea5db382..bc215e3abe 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -195,8 +195,13 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab bs_validate_unicode -> [_Arg] = Args, - [hipe_rtl:mk_call([], bs_validate_unicode, Args, - TrueLblName, FalseLblName, not_remote)]; + [IsUnicode] = create_regs(1), + RetLbl = hipe_rtl:mk_new_label(), + [hipe_rtl:mk_call([IsUnicode], is_unicode, Args, + hipe_rtl:label_name(RetLbl), [], not_remote), + RetLbl, + hipe_rtl:mk_branch(IsUnicode, ne, hipe_rtl:mk_imm(0), + TrueLblName, FalseLblName, 0.99)]; bs_final -> Zero = hipe_rtl:mk_imm(0), diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 10ef84d7cf..1ff6aefaa7 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,39 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.4.2</title> + <section><title>Inets 6.4.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix broken handling of POST requests</p> + <p> + New chunk mechanism of body data in POST requests added + in 5d01c70ca399edf28e99dc760506329689fab6ba broke + handling of POST body data not using the new mechanism.</p> + <p> + Own Id: OTP-14656</p> + </item> + <item> + <p> + Make sure ints:stop/2 of the service httpd is synchronous</p> + <p> + Own Id: OTP-14696</p> + </item> + <item> + <p> + Honor status code returned by ESI script and modernize + "location" header handling.</p> + <p> + Own Id: OTP-14716</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.4.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index bd1d2e833a..6907bf5262 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -736,7 +736,7 @@ maybe_send_answer(Request, Answer, State) -> answer_request(Request, Answer, State). deliver_answer(#request{from = From} = Request) - when is_pid(From) -> + when From =/= answer_sent -> Response = httpc_response:error(Request, socket_closed_remotely), httpc_response:send(From, Response); deliver_answer(_Request) -> diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index b3b11b74ab..91638f5d2e 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -269,7 +269,7 @@ parse_headers(<<?LF,?LF,Body/binary>>, Header, Headers, MaxHeaderSize, Result, Relaxed); parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, - MaxHeaderSize, Result, _) -> + MaxHeaderSize, Result, Relaxed) -> HTTPHeaders = [lists:reverse(Header) | Headers], Length = lists:foldl(fun(H, Acc) -> length(H) + Acc end, 0, HTTPHeaders), @@ -277,8 +277,42 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, true -> ResponseHeaderRcord = http_response:headers(HTTPHeaders, #http_response_h{}), - {ok, list_to_tuple( - lists:reverse([Body, ResponseHeaderRcord | Result]))}; + + %% RFC7230, Section 3.3.3 + %% If a message is received with both a Transfer-Encoding and a + %% Content-Length header field, the Transfer-Encoding overrides the + %% Content-Length. Such a message might indicate an attempt to + %% perform request smuggling (Section 9.5) or response splitting + %% (Section 9.4) and ought to be handled as an error. A sender MUST + %% remove the received Content-Length field prior to forwarding such + %% a message downstream. + case ResponseHeaderRcord#http_response_h.'transfer-encoding' of + undefined -> + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcord | Result]))}; + Value -> + TransferEncoding = string:lowercase(Value), + ContentLength = ResponseHeaderRcord#http_response_h.'content-length', + if + %% Respond without error but remove Content-Length field in relaxed mode + (Relaxed =:= true) + andalso (TransferEncoding =:= "chunked") + andalso (ContentLength =/= "-1") -> + ResponseHeaderRcordFixed = + ResponseHeaderRcord#http_response_h{'content-length' = "-1"}, + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcordFixed | Result]))}; + %% Respond with error in default (not relaxed) mode + (Relaxed =:= false) + andalso (TransferEncoding =:= "chunked") + andalso (ContentLength =/= "-1") -> + throw({error, {headers_conflict, {'content-length', + 'transfer-encoding'}}}); + true -> + {ok, list_to_tuple( + lists:reverse([Body, ResponseHeaderRcord | Result]))} + end + end; false -> throw({error, {header_too_long, MaxHeaderSize, MaxHeaderSize-Length}}) diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index 0b632d24e3..540e68e749 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -99,7 +99,14 @@ start_service(Conf) -> stop_service({Address, Port}) -> stop_service({Address, Port, ?DEFAULT_PROFILE}); stop_service({Address, Port, Profile}) -> - httpd_sup:stop_child(Address, Port, Profile); + Name = httpd_util:make_name("httpd_instance_sup", Address, Port, Profile), + Pid = whereis(Name), + MonitorRef = erlang:monitor(process, Pid), + Result = httpd_sup:stop_child(Address, Port, Profile), + receive + {'DOWN', MonitorRef, _, _, _} -> + Result + end; stop_service(Pid) when is_pid(Pid) -> case service_info(Pid) of {ok, Info} -> diff --git a/lib/inets/src/http_server/httpd_esi.erl b/lib/inets/src/http_server/httpd_esi.erl index 9406b47802..fd50934d00 100644 --- a/lib/inets/src/http_server/httpd_esi.erl +++ b/lib/inets/src/http_server/httpd_esi.erl @@ -66,7 +66,7 @@ handle_headers("") -> {ok, [], 200}; handle_headers(Headers) -> NewHeaders = string:tokens(Headers, ?CRLF), - handle_headers(NewHeaders, [], 200). + handle_headers(NewHeaders, [], 200, true). %%%======================================================================== %%% Internal functions @@ -80,21 +80,17 @@ parse_headers([?CR, ?LF, ?CR, ?LF | Rest], Acc) -> parse_headers([Char | Rest], Acc) -> parse_headers(Rest, [Char | Acc]). -handle_headers([], NewHeaders, StatusCode) -> +handle_headers([], NewHeaders, StatusCode, _) -> {ok, NewHeaders, StatusCode}; -handle_headers([Header | Headers], NewHeaders, StatusCode) -> +handle_headers([Header | Headers], NewHeaders, StatusCode, NoESIStatus) -> {FieldName, FieldValue} = httpd_response:split_header(Header, []), case FieldName of "location" -> - case http_request:is_absolut_uri(FieldValue) of - true -> - handle_headers(Headers, - [{FieldName, FieldValue} | NewHeaders], - 302); - false -> - {proceed, FieldValue} - end; + handle_headers(Headers, + [{FieldName, FieldValue} | NewHeaders], + 302, NoESIStatus); + "status" -> NewStatusCode = case httpd_util:split(FieldValue," ",2) of @@ -103,8 +99,9 @@ handle_headers([Header | Headers], NewHeaders, StatusCode) -> _ -> 200 end, - handle_headers(Headers, NewHeaders, NewStatusCode); + handle_headers(Headers, NewHeaders, NewStatusCode, false); _ -> handle_headers(Headers, - [{FieldName, FieldValue}| NewHeaders], StatusCode) - end. + [{FieldName, FieldValue}| NewHeaders], StatusCode, + NoESIStatus) + end. diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 45b6deba97..adbbf64685 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -20,7 +20,7 @@ %% -module(httpd_example). -export([print/1]). --export([get/2, put/2, post/2, yahoo/2, test1/2, get_bin/2, peer/2]). +-export([get/2, put/2, post/2, yahoo/2, test1/2, get_bin/2, peer/2,new_status_and_location/2]). -export([newformat/3, post_chunked/3]). %% These are used by the inets test-suite @@ -90,6 +90,9 @@ post(Env,Input) -> yahoo(_Env,_Input) -> "Location: http://www.yahoo.com\r\n\r\n". +new_status_and_location(_Env,_Input) -> + "status:201\r\n Location: http://www.yahoo.com\r\n\r\n". + default(Env,Input) -> [header(), top("Default Example"), diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 0eaf073255..007d272323 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -306,10 +306,10 @@ add_chunk([<<>>, Body, Length, MaxChunk]) -> add_chunk([More, Body, Length, MaxChunk]) -> body_chunk(<<Body/binary, More/binary>>, Length, MaxChunk). -body_chunk(<<>> = Body, Length, MaxChunk) -> - {ok, {continue, ?MODULE, add_chunk, [Body, Length, MaxChunk]}}; body_chunk(Body, Length, nolimit) -> whole_body(Body, Length); +body_chunk(<<>> = Body, Length, MaxChunk) -> + {ok, {continue, ?MODULE, add_chunk, [Body, Length, MaxChunk]}}; body_chunk(Body, Length, MaxChunk) when Length > MaxChunk -> case size(Body) >= MaxChunk of diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index bd4fdd3832..d918f10424 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -516,6 +516,15 @@ handle_body(#state{headers = Headers, body = Body, case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of true -> case httpd_request:body_chunk_first(Body, Length, MaxChunk) of + %% This is the case that the we need more data to complete + %% the body but chunking to the mod_esi user is not enabled. + {Module, add_chunk = Function, Args} -> + http_transport:setopts(ModData#mod.socket_type, + ModData#mod.socket, + [{active, once}]), + {noreply, State#state{mfa = + {Module, Function, Args}}}; + %% Chunking to mod_esi user is enabled {ok, {continue, Module, Function, Args}} -> http_transport:setopts(ModData#mod.socket_type, ModData#mod.socket, @@ -525,6 +534,8 @@ handle_body(#state{headers = Headers, body = Body, {ok, {{continue, Chunk}, Module, Function, Args}} -> handle_internal_chunk(State#state{chunk = chunk_start(MaxChunk), body = Chunk}, Module, Function, Args); + %% Whole body delivered, if chunking mechanism is enabled the whole + %% body fits in one chunk. {ok, NewBody} -> handle_response(State#state{chunk = chunk_finish(ChunkState, CbState, MaxChunk), diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 3a589ca5f0..3206d957d9 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -339,26 +339,21 @@ erl_scheme_webpage_whole(Mod, Func, Env, Input, ModData) -> {Headers, Body} = httpd_esi:parse_headers(lists:flatten(Response)), Length = httpd_util:flatlength(Body), - case httpd_esi:handle_headers(Headers) of - {proceed, AbsPath} -> - {proceed, [{real_name, httpd_util:split_path(AbsPath)} - | ModData#mod.data]}; - {ok, NewHeaders, StatusCode} -> - send_headers(ModData, StatusCode, - [{"content-length", - integer_to_list(Length)}| NewHeaders]), - case ModData#mod.method of - "HEAD" -> - {proceed, [{response, {already_sent, 200, 0}} | - ModData#mod.data]}; - _ -> - httpd_response:send_body(ModData, - StatusCode, Body), - {proceed, [{response, {already_sent, 200, - Length}} | - ModData#mod.data]} - end - end + {ok, NewHeaders, StatusCode} = httpd_esi:handle_headers(Headers), + send_headers(ModData, StatusCode, + [{"content-length", + integer_to_list(Length)}| NewHeaders]), + case ModData#mod.method of + "HEAD" -> + {proceed, [{response, {already_sent, 200, 0}} | + ModData#mod.data]}; + _ -> + httpd_response:send_body(ModData, + StatusCode, Body), + {proceed, [{response, {already_sent, 200, + Length}} | + ModData#mod.data]} + end end. %% New API that allows the dynamic wepage to be sent back to the client @@ -398,29 +393,23 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> {continue, _} = Continue -> Continue; {Headers, Body} -> - case httpd_esi:handle_headers(Headers) of - {proceed, AbsPath} -> - {proceed, [{real_name, httpd_util:split_path(AbsPath)} - | ModData#mod.data]}; - {ok, NewHeaders, StatusCode} -> - IsDisableChunkedSend = - httpd_response:is_disable_chunked_send(Db), - case (ModData#mod.http_version =/= "HTTP/1.1") or - (IsDisableChunkedSend) of - true -> - send_headers(ModData, StatusCode, - [{"connection", "close"} | - NewHeaders]); - false -> - send_headers(ModData, StatusCode, - [{"transfer-encoding", - "chunked"} | NewHeaders]) - end, - handle_body(Pid, ModData, Body, Timeout, length(Body), - IsDisableChunkedSend) - end; - timeout -> - send_headers(ModData, 504, [{"connection", "close"}]), + {ok, NewHeaders, StatusCode} = httpd_esi:handle_headers(Headers), + IsDisableChunkedSend = httpd_response:is_disable_chunked_send(Db), + case (ModData#mod.http_version =/= "HTTP/1.1") or + (IsDisableChunkedSend) of + true -> + send_headers(ModData, StatusCode, + [{"connection", "close"} | + NewHeaders]); + false -> + send_headers(ModData, StatusCode, + [{"transfer-encoding", + "chunked"} | NewHeaders]) + end, + handle_body(Pid, ModData, Body, Timeout, length(Body), + IsDisableChunkedSend); + timeout -> + send_headers(ModData, 504, [{"connection", "close"}]), httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket), {proceed,[{response, {already_sent, 200, 0}} | ModData#mod.data]} end. @@ -560,15 +549,10 @@ eval(#mod{method = Method} = ModData, ESIBody, Modules) {ok, Response} -> {Headers, _} = httpd_esi:parse_headers(lists:flatten(Response)), - case httpd_esi:handle_headers(Headers) of - {ok, _, StatusCode} -> - {proceed,[{response, {StatusCode, Response}} | - ModData#mod.data]}; - {proceed, AbsPath} -> - {proceed, [{real_name, AbsPath} | - ModData#mod.data]} - end - end; + {ok, _, StatusCode} =httpd_esi:handle_headers(Headers), + {proceed,[{response, {StatusCode, Response}} | + ModData#mod.data]} + end; false -> {proceed,[{status, {403, ModData#mod.request_uri, diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index 4e10a97f58..9a13ed3d17 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -535,7 +535,7 @@ esi_parse_headers(Config) when is_list(Config) -> {"location","http://foo.bar.se"}], 302} = httpd_esi:handle_headers(Headers2), - {proceed,"/foo/bar.html"} = + {ok,[{"location","/foo/bar.html"}], 302} = httpd_esi:handle_headers("location:/foo/bar.html\r\n"). %%-------------------------------------------------------------------- diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 5dfb1474e5..cc166d522e 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -115,6 +115,7 @@ only_simulated() -> invalid_chunk_size, headers_dummy, headers_with_obs_fold, + headers_conflict_chunked_with_length, empty_response_header, remote_socket_close, remote_socket_close_async, @@ -130,7 +131,8 @@ only_simulated() -> port_in_host_header, redirect_port_in_host_header, relaxed, - multipart_chunks + multipart_chunks, + stream_fun_server_close ]. misc() -> @@ -745,7 +747,7 @@ empty_body() -> empty_body(Config) when is_list(Config) -> URL = url(group_name(Config), "/empty.html", Config), {ok, {{_,200,_}, [_ | _], []}} = - httpc:request(get, {URL, []}, [{timeout, 500}], []). + httpc:request(get, {URL, []}, [], []). %%------------------------------------------------------------------------- @@ -977,7 +979,6 @@ headers_dummy(Config) when is_list(Config) -> {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, {"If-Match", "*"}, {"Content-Type", "text/plain"}, - {"Content-Encoding", "chunked"}, {"Content-Length", "6"}, {"Content-Language", "en"}, {"Content-Location", "http://www.foobar.se"}, @@ -1003,6 +1004,18 @@ headers_with_obs_fold(Config) when is_list(Config) -> %%------------------------------------------------------------------------- +headers_conflict_chunked_with_length(doc) -> + ["Test the code for handling headers with both Transfer-Encoding" + "and Content-Length which must receive error in default (not relaxed) mode" + "and must receive successful response in relaxed mode"]; +headers_conflict_chunked_with_length(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/headers_conflict_chunked_with_length.html", Config), []}, + {error, {could_not_parse_as_http, _}} = httpc:request(get, Request, [{relaxed, false}], []), + {ok,{{_,200,_},_,_}} = httpc:request(get, Request, [{relaxed, true}], []), + ok. + +%%------------------------------------------------------------------------- + invalid_headers(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]}, {error, _} = httpc:request(get, Request, [], []). @@ -1178,6 +1191,22 @@ wait_for_whole_response(Config) when is_list(Config) -> ReqSeqNumServer ! shutdown. %%-------------------------------------------------------------------- +stream_fun_server_close() -> + [{doc, "Test that an error msg is received when using a receiver fun as stream target"}]. +stream_fun_server_close(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/delay_close.html", Config), []}, + Self = self(), + Fun = fun(X) -> Self ! X end, + {ok, RequestId} = httpc:request(get, Request, [], [{sync, false}, {receiver, Fun}]), + receive + {RequestId, {error, Reason}} -> + ct:pal("Close ~p", [Reason]), + ok + after 13000 -> + ct:fail(did_not_receive_close) + end. + +%%-------------------------------------------------------------------- %% Internal Functions ------------------------------------------------ %%-------------------------------------------------------------------- stream(ReceiverPid, Receiver, Config) -> @@ -1852,7 +1881,6 @@ handle_uri(_,"/dummy_headers.html",_,_,Socket,_) -> %% user to evaluate. This is not a valid response %% it only tests that the header handling code works. Head = "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:32\r\n" ++ "Pragma:1#no-cache\r\n" ++ "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ "Warning:1#pseudonym foobar\r\n" ++ @@ -1882,6 +1910,15 @@ handle_uri(_,"/obs_folded_headers.html",_,_,_,_) -> " b\r\n\r\n" "Hello"; +handle_uri(_,"/headers_conflict_chunked_with_length.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" + "Content-Length:32\r\n" + "Transfer-Encoding:Chunked\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + handle_uri(_,"/capital_transfer_encoding.html",_,_,Socket,_) -> Head = "HTTP/1.1 200 ok\r\n" ++ "Transfer-Encoding:Chunked\r\n\r\n", @@ -2029,6 +2066,9 @@ handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) -> send(Socket, Head), send_multipart_chunks(Socket), http_chunk:encode_last(); +handle_uri(_,"/delay_close.html",_,_,Socket,_) -> + ct:sleep(10000), + close(Socket); handle_uri("HEAD",_,_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "Content-Length:0\r\n\r\n"; diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 6c8728470b..0c649d9abf 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -129,7 +129,7 @@ groups() -> {http_1_1, [], [host, chunked, expect, cgi, cgi_chunked_encoding_test, trace, range, if_modified_since, mod_esi_chunk_timeout, - esi_put] ++ http_head() ++ http_get() ++ load()}, + esi_put, esi_post] ++ http_head() ++ http_get() ++ load()}, {http_1_0, [], [host, cgi, trace] ++ http_head() ++ http_get() ++ load()}, {http_0_9, [], http_head() ++ http_get() ++ load()} ]. @@ -932,7 +932,20 @@ esi_put() -> esi_put(Config) when is_list(Config) -> ok = http_status("PUT /cgi-bin/erl/httpd_example/put/123342234123 ", Config, [{statuscode, 200}]). - +%%------------------------------------------------------------------------- +esi_post() -> + [{doc, "Test mod_esi POST"}]. + +esi_post(Config) when is_list(Config) -> + Chunk = "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ", + Data = lists:duplicate(10000, Chunk), + Length = lists:flatlength(Data), + ok = http_status("POST /cgi-bin/erl/httpd_example/post ", + {"Content-Length:" ++ integer_to_list(Length) ++ "\r\n", + Data}, + [{http_version, "HTTP/1.1"} |Config], + [{statuscode, 200}]). + %%------------------------------------------------------------------------- mod_esi_chunk_timeout(Config) when is_list(Config) -> ok = httpd_1_1:mod_esi_chunk_timeout(proplists:get_value(type, Config), diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl index d9118aa1a4..2035b50248 100644 --- a/lib/inets/test/httpd_mod.erl +++ b/lib/inets/test/httpd_mod.erl @@ -779,9 +779,14 @@ esi(Type, Port, Host, Node) -> [{statuscode, 200}, {no_header, "cache-control"}, {version, "HTTP/1.0"}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example:new_status_and_location" + " HTTP/1.1\r\n\r\n", + [{statuscode, 201}, + {header, "Location"}, + {version, "HTTP/1.1"}]), ok. - %%-------------------------------------------------------------------- get(Type, Port, Host, Node) -> ok = httpd_test_lib:verify_request(Type, Host, Port, Node, diff --git a/lib/inets/test/inets_SUITE.erl b/lib/inets/test/inets_SUITE.erl index 38b8229389..1abd96a228 100644 --- a/lib/inets/test/inets_SUITE.erl +++ b/lib/inets/test/inets_SUITE.erl @@ -213,7 +213,6 @@ start_httpd(Config) when is_list(Config) -> true = lists:member(Pid0, Pids0), [_|_] = inets:services_info(), inets:stop(httpd, Pid0), - ct:sleep(500), Pids1 = [ServicePid || {_, ServicePid} <- inets:services()], false = lists:member(Pid0, Pids1), {ok, Pid0b} = @@ -222,7 +221,6 @@ start_httpd(Config) when is_list(Config) -> true = lists:member(Pid0b, Pids0b), [_|_] = inets:services_info(), inets:stop(httpd, Pid0b), - ct:sleep(500), Pids1 = [ServicePid || {_, ServicePid} <- inets:services()], false = lists:member(Pid0b, Pids1), {ok, Pid1} = diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 34b6902747..108d259823 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.4.2 +INETS_VSN = 6.4.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 331864b5de..e47023d201 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -1572,52 +1572,56 @@ fill_sendq(Config) when is_list(Config) -> Master = self(), Server = spawn_link(fun () -> - {ok,L} = gen_tcp:listen - (0, [{active,false},binary, - {reuseaddr,true},{packet,0}]), + {ok,L} = gen_tcp:listen(0, [{active,false},binary, + {reuseaddr,true},{packet,0}]), {ok,Port} = inet:port(L), Master ! {self(),client, fill_sendq_client(Port, Master)}, fill_sendq_srv(L, Master) end), io:format("~p Server~n", [Server]), - receive {Server,client,Client} -> - io:format("~p Client~n", [Client]), - receive {Server,reader,Reader} -> - io:format("~p Reader~n", [Reader]), - fill_sendq_loop(Server, Client, Reader) + receive + {Server,client,Client} -> + io:format("~p Client~n", [Client]), + receive + {Server,reader,Reader} -> + io:format("~p Reader~n", [Reader]), + fill_sendq_loop(Server, Client, Reader) end end. fill_sendq_loop(Server, Client, Reader) -> %% Master %% - receive {Server,send} -> + receive + {Server,send} -> fill_sendq_loop(Server, Client, Reader) after 2000 -> %% Send queue full, sender blocked -> close client. io:format("Send timeout, closing Client...~n", []), Client ! {self(),close}, - receive {Server,[{error,closed}]} -> - io:format("Got server closed.~n"), - receive {Reader,[{error,closed}]} -> - io:format - ("Got reader closed.~n"), - ok - after 3000 -> - ct:fail({timeout,{closed,reader}}) - end; - {Reader,[{error,closed}]} -> - io:format("Got reader closed.~n"), - receive {Server,[{error,closed}]} -> - io:format("Got server closed~n"), - ok - after 3000 -> - ct:fail({timeout,{closed,server}}) - end - after 3000 -> - ct:fail({timeout,{closed,[server,reader]}}) - end + receive + {Server,[{error,closed}]} -> + io:format("Got server closed.~n"), + receive + {Reader,[{error,closed}]} -> + io:format("Got reader closed.~n"), + ok + after 3000 -> + ct:fail({timeout,{closed,reader}}) + end; + {Reader,[{error,closed}]} -> + io:format("Got reader closed.~n"), + receive + {Server,[{error,closed}]} -> + io:format("Got server closed~n"), + ok + after 3000 -> + ct:fail({timeout,{closed,server}}) + end + after 3000 -> + ct:fail({timeout,{closed,[server,reader]}}) + end end. fill_sendq_srv(L, Master) -> diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 131a0685cd..7be7e503df 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -978,23 +978,37 @@ split_bin(Last,Acc) -> only_allow_owner(Config) when is_list(Config) -> Z = zlib:open(), + Owner = self(), ?m(ok, zlib:inflateInit(Z)), ?m(ok, zlib:inflateReset(Z)), {Pid, Ref} = spawn_monitor( fun() -> - ?m(?EXIT(not_on_controlling_process), zlib:inflateReset(Z)) + ?m(?EXIT(not_on_controlling_process), zlib:inflateReset(Z)), + Owner ! '$transfer_ownership', + receive + '$ownership_transferred' -> + ?m(ok, zlib:inflateReset(Z)) + after 200 -> + ct:fail("Never received transfer signal.") + end end), + ownership_transfer_check(Z, Pid, Ref). +ownership_transfer_check(Z, WorkerPid, Ref) -> receive - {'DOWN', Ref, process, Pid, _Reason} -> - ok + '$transfer_ownership' -> + zlib:set_controlling_process(Z, WorkerPid), + WorkerPid ! '$ownership_transferred', + ownership_transfer_check(Z, WorkerPid, Ref); + {'DOWN', Ref, process, WorkerPid, normal} -> + ok; + {'DOWN', Ref, process, WorkerPid, Reason} -> + ct:fail("Spawned worker crashed with reason ~p.", [Reason]) after 200 -> ct:fail("Spawned worker timed out.") - end, - - ?m(ok, zlib:inflateReset(Z)). + end. sub_heap_binaries(Config) when is_list(Config) -> Compressed = zlib:compress(<<"gurka">>), diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 5502869973..a4a542297c 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -71,6 +71,8 @@ hex_binary_fun(Bin) -> plain_html(io_lib:format("~s",[S])) end. +format_hex(<<>>,_) -> + []; format_hex(<<B1:4,B2:4>>,_) -> [integer_to_list(B1,16),integer_to_list(B2,16)]; format_hex(<<B1:4,B2:4,Bin/binary>>,0) -> diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index 68381bcc7b..8202f91030 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -355,11 +355,11 @@ href_proc_bin(From, T, Acc, LTB) -> PreviewStr end end; - [PreviewIntStr,SizeStr,Md5] when From =:= obs -> + [PreviewIntStr,PreviewBitSizeStr,SizeStr,Md5] when From =:= obs -> Size = list_to_integer(SizeStr), PreviewInt = list_to_integer(PreviewIntStr), - PrevSize = (trunc(math:log2(PreviewInt)/8)+1)*8, - PreviewStr = preview_string(Size,<<PreviewInt:PrevSize>>), + PreviewBitSize = list_to_integer(PreviewBitSizeStr), + PreviewStr = preview_string(Size,<<PreviewInt:PreviewBitSize>>), if LTB -> href("TARGET=\"expanded\"", ["#OBSBinary?key1="++PreviewIntStr++ diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index e5ffe61d25..52e6c3e52a 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -810,7 +810,7 @@ progress_dialog_destroy({Dialog,_,_}) -> make_obsbin(Bin,Tab) -> Size = byte_size(Bin), - Preview = + {Preview,PreviewBitSize} = try %% The binary might be a unicode string, in which case we %% don't want to split it in the middle of a grapheme @@ -819,14 +819,14 @@ make_obsbin(Bin,Tab) -> PB1 = string:slice(Bin,0,PL1), PS1 = byte_size(PB1) * 8, <<P1:PS1>> = PB1, - P1 + {P1,PS1} catch _:_ -> %% Probably not a string, so just split anywhere PS2 = min(Size, 10) * 8, <<P2:PS2, _/binary>> = Bin, - P2 + {P2,PS2} end, Hash = erlang:phash2(Bin), Key = {Preview, Size, Hash}, ets:insert(Tab, {Key,Bin}), - ['#OBSBin',Preview,Size,Hash]. + ['#OBSBin',Preview,PreviewBitSize,Size,Hash]. diff --git a/lib/parsetools/include/leexinc.hrl b/lib/parsetools/include/leexinc.hrl index b4449607cb..2a74c252ff 100644 --- a/lib/parsetools/include/leexinc.hrl +++ b/lib/parsetools/include/leexinc.hrl @@ -272,6 +272,8 @@ skip_cont(Rest, Line, {skip_token,Push}, Error) -> skip_cont(Rest, Line, {error,_S}, Error) -> skip_tokens(yystate(), Rest, Line, Rest, 0, Line, Error, reject, 0). +-compile({nowarn_unused_function, [yyrev/1, yyrev/2, yypre/2, yysuf/2]}). + yyrev(List) -> lists:reverse(List). yyrev(List, Tail) -> lists:reverse(List, Tail). yypre(List, N) -> lists:sublist(List, N). @@ -282,6 +284,8 @@ yysuf(List, N) -> lists:nthtail(N, List). %% Line has been updated with respect to newlines in the prefix of %% Chars consisting of (TokenLength - AcceptLength) characters. +-compile({nowarn_unused_function, adjust_line/4}). + adjust_line(N, N, _Cs, L) -> L; adjust_line(T, A, [$\n|Cs], L) -> adjust_line(T-1, A, Cs, L-1); diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 579df160bc..38e8f30a25 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -97,14 +97,27 @@ end_per_group(_GroupName, Config) -> Config. %%------------------------------------------------------------------- -init_per_testcase(Case, Config) when Case == pkix_test_data_all_default; - Case == gen_ec_param -> +init_per_testcase(pkix_test_data_all_default, Config) -> case crypto:ec_curves() of [] -> {skip, missing_ecc_support}; _ -> - init_common_per_testcase(Config) + init_common_per_testcase(Config) end; + +init_per_testcase(gen_ec_param, Config) -> + case crypto:ec_curves() of + [] -> + {skip, missing_ecc_support}; + Curves -> + case lists:member(secp521r1, Curves) of + true -> + init_common_per_testcase(Config); + false -> + {skip, missing_ecc_secp52r1_support} + end + end; + init_per_testcase(TestCase, Config) -> case TestCase of ssh_hostkey_fingerprint_md5_implicit -> init_fingerprint_testcase([md5], Config); diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 4705804759..6bdcae5dd7 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -34,7 +34,23 @@ </header> - <section><title>SNMP 5.2.7</title> + <section><title>SNMP 5.2.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The <c>recbuf</c> configuration option was not propagated + correctly to the socket for the SNMP Manager.</p> + <p> + Own Id: OTP-13372 Aux Id: ERIERL-73 </p> + </item> + </list> + </section> + +</section> + +<section><title>SNMP 5.2.7</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index bde637744c..ca61782639 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -8,19 +8,6 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ - {<<"5\\.2\\.6">>, - [{load_module, snmpc, soft_purge, soft_purge, []}, - {load_module, snmpc_lib, soft_purge, soft_purge, []}]}, - {<<"5\\.2\\.5">>, - [{load_module, snmpc, soft_purge, soft_purge, []}, - {load_module, snmpc_lib, soft_purge, soft_purge, []}, - {load_module, snmp_generic, soft_purge, soft_purge, []}]}, - {<<"5\\.2\\.4">>, - [{load_module, snmpc, soft_purge, soft_purge, []}, - {load_module, snmp_generic, soft_purge, soft_purge, []}, - {load_module, snmp, soft_purge, soft_purge, []}, - {load_module, snmpc_lib, soft_purge, soft_purge, []}, - {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ], @@ -30,19 +17,6 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ - {<<"5\\.2\\.6">>, - [{load_module, snmpc, soft_purge, soft_purge, []}, - {load_module, snmpc_lib, soft_purge, soft_purge, []}]}, - {<<"5\\.2\\.5">>, - [{load_module, snmpc, soft_purge, soft_purge, []}, - {load_module, snmpc_lib, soft_purge, soft_purge, []}, - {load_module, snmp_generic, soft_purge, soft_purge, []}]}, - {<<"5\\.2\\.4">>, - [{load_module, snmpc, soft_purge, soft_purge, []}, - {load_module, snmp_generic, soft_purge, soft_purge, []}, - {load_module, snmp, soft_purge, soft_purge, []}, - {load_module, snmpc_lib, soft_purge, soft_purge, []}, - {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ] diff --git a/lib/snmp/src/manager/snmpm_net_if.erl b/lib/snmp/src/manager/snmpm_net_if.erl index 93c987eb0f..29216f9d6a 100644 --- a/lib/snmp/src/manager/snmpm_net_if.erl +++ b/lib/snmp/src/manager/snmpm_net_if.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-2017. 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. @@ -367,7 +367,7 @@ common_socket_opts(Opts) -> default -> []; Sz -> - [{sndbuf, Sz}] + [{recbuf, Sz}] end ++ case get_opt(Opts, no_reuse, false) of false -> diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 3c1a6f2afd..2ed2c4580c 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -605,7 +605,12 @@ init_per_group(multiple_reqs_3 = GroupName, Config) -> init_per_group(test_multi_threaded = GroupName, Config) -> init_mt(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(test_v3 = GroupName, Config) -> - init_v3(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_v3(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(test_v1_v2 = GroupName, Config) -> init_v1_v2(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(test_v2 = GroupName, Config) -> @@ -631,11 +636,26 @@ init_per_group(mib_storage_varm_dets = GroupName, Config) -> init_varm_mib_storage_dets( snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(mib_storage_size_check_mnesia = GroupName, Config) -> - init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(mib_storage_size_check_dets = GroupName, Config) -> - init_size_check_msd(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(mib_storage_size_check_ets = GroupName, Config) -> - init_size_check_mse(snmp_test_lib:init_group_top_dir(GroupName, Config)); + case snmp_test_lib:crypto_start() of + ok -> + init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); + _ -> + {skip, "Crypto did not start"} + end; init_per_group(mib_storage_mnesia = GroupName, Config) -> init_mib_storage_mnesia(snmp_test_lib:init_group_top_dir(GroupName, Config)); diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 4bfeb0f8d1..6ced55f0cc 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -156,16 +156,25 @@ init_per_suite(Config0) when is_list(Config0) -> ?DBG("init_per_suite -> entry with" "~n Config0: ~p", [Config0]), - Config1 = snmp_test_lib:init_suite_top_dir(?MODULE, Config0), - Config2 = snmp_test_lib:fix_data_dir(Config1), - - %% Mib-dirs - %% data_dir is trashed by the test-server / common-test - %% so there is no point in fixing it... - MibDir = snmp_test_lib:lookup(data_dir, Config2), - StdMibDir = filename:join([code:priv_dir(snmp), "mibs"]), - - [{mib_dir, MibDir}, {std_mib_dir, StdMibDir} | Config2]. + %% Preferably this test SUITE should be divided into groups + %% so that if crypto does not work only v3 tests that + %% need crypto will be skipped, but as this is only a + %% problem with one legacy test machine, we will procrastinate + %% until we have a more important reason to fix this. + case snmp_test_lib:crypto_start() of + ok -> + Config1 = snmp_test_lib:init_suite_top_dir(?MODULE, Config0), + Config2 = snmp_test_lib:fix_data_dir(Config1), + %% Mib-dirs + %% data_dir is trashed by the test-server / common-test + %% so there is no point in fixing it... + MibDir = snmp_test_lib:lookup(data_dir, Config2), + StdMibDir = filename:join([code:priv_dir(snmp), "mibs"]), + + [{mib_dir, MibDir}, {std_mib_dir, StdMibDir} | Config2]; + _ -> + {skip, "Crypto did not start"} + end. end_per_suite(Config) when is_list(Config) -> diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 207f0084d8..ef48608bda 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.2.7 +SNMP_VSN = 5.2.8 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 1a5d48baca..032d87bdad 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -188,6 +188,7 @@ daemon(Port) -> daemon(Socket, UserOptions) when is_port(Socket) -> try #{} = Options = ssh_options:handle_options(server, UserOptions), + case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of ok -> {ok, {IP,Port}} = inet:sockname(Socket), @@ -461,6 +462,9 @@ open_listen_socket(_Host0, Port0, Options0) -> %%%---------------------------------------------------------------- finalize_start(Host, Port, Profile, Options0, F) -> try + %% throws error:Error if no usable hostkey is found + ssh_connection_handler:available_hkey_algorithms(server, Options0), + sshd_sup:start_child(Host, Port, Profile, Options0) of {error, {already_started, _}} -> @@ -470,6 +474,8 @@ finalize_start(Host, Port, Profile, Options0, F) -> Result = {ok,_} -> F(Options0, Result) catch + error:{shutdown,Err} -> + {error,Err}; exit:{noproc, _} -> {error, ssh_not_started} end. diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index ac64a7bf14..894877f8bf 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -145,14 +145,17 @@ get_public_key(SigAlg, #ssh{opts = Opts}) -> case KeyCb:user_key(KeyAlg, [{key_cb_private,KeyCbOpts}|UserOpts]) of {ok, PrivKey} -> try + %% Check the key - the KeyCb may be a buggy plugin + true = ssh_transport:valid_key_sha_alg(PrivKey, KeyAlg), Key = ssh_transport:extract_public_key(PrivKey), public_key:ssh_encode(Key, ssh2_pubkey) of PubKeyBlob -> {ok,{PrivKey,PubKeyBlob}} catch _:_ -> - not_ok + not_ok end; + _Error -> not_ok end. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 4158a52a27..802bf62570 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -46,6 +46,7 @@ %%% Internal application API -export([start_connection/4, + available_hkey_algorithms/2, open_channel/6, request/6, request/7, reply_request/3, @@ -432,13 +433,12 @@ init_ssh_record(Role, Socket, Opts) -> init_ssh_record(Role, Socket, PeerAddr, Opts). init_ssh_record(Role, _Socket, PeerAddr, Opts) -> - KeyCb = ?GET_OPT(key_cb, Opts), AuthMethods = ?GET_OPT(auth_methods, Opts), S0 = #ssh{role = Role, - key_cb = KeyCb, + key_cb = ?GET_OPT(key_cb, Opts), opts = Opts, userauth_supported_methods = AuthMethods, - available_host_keys = supported_host_keys(Role, KeyCb, Opts), + available_host_keys = available_hkey_algorithms(Role, Opts), random_length_padding = ?GET_OPT(max_random_length_padding, Opts) }, @@ -1544,44 +1544,42 @@ peer_role(client) -> server; peer_role(server) -> client. %%-------------------------------------------------------------------- -supported_host_keys(client, _, Options) -> - try - find_sup_hkeys(Options) - of - [] -> +available_hkey_algorithms(Role, Options) -> + KeyCb = ?GET_OPT(key_cb, Options), + case [A || A <- available_hkey_algos(Options), + (Role==client) orelse available_host_key(KeyCb, A, Options) + ] of + + [] when Role==client -> error({shutdown, "No public key algs"}); - Algs -> - [atom_to_list(A) || A<-Algs] - catch - exit:Reason -> - error({shutdown, Reason}) - end; -supported_host_keys(server, KeyCb, Options) -> - [atom_to_list(A) || A <- find_sup_hkeys(Options), - available_host_key(KeyCb, A, Options) - ]. + [] when Role==server -> + error({shutdown, "No host key available"}); -find_sup_hkeys(Options) -> - case proplists:get_value(public_key, - ?GET_OPT(preferred_algorithms,Options) - ) - of - undefined -> - ssh_transport:default_algorithms(public_key); - L -> - NonSupported = L--ssh_transport:supported_algorithms(public_key), - L -- NonSupported + Algs -> + [atom_to_list(A) || A<-Algs] end. +available_hkey_algos(Options) -> + SupAlgos = ssh_transport:supported_algorithms(public_key), + HKeys = proplists:get_value(public_key, + ?GET_OPT(preferred_algorithms,Options) + ), + NonSupported = HKeys -- SupAlgos, + AvailableAndSupported = HKeys -- NonSupported, + AvailableAndSupported. + %% Alg :: atom() available_host_key({KeyCb,KeyCbOpts}, Alg, Opts) -> UserOpts = ?GET_OPT(user_options, Opts), case KeyCb:host_key(Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of - {ok,_} -> true; - _ -> false + {ok,Key} -> + %% Check the key - the KeyCb may be a buggy plugin + ssh_transport:valid_key_sha_alg(Key, Alg); + _ -> + false end. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index e92c727559..d8f7a96c15 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -795,8 +795,14 @@ get_host_key(SSH, SignAlg) -> #ssh{key_cb = {KeyCb,KeyCbOpts}, opts = Opts} = SSH, UserOpts = ?GET_OPT(user_options, Opts), case KeyCb:host_key(SignAlg, [{key_cb_private,KeyCbOpts}|UserOpts]) of - {ok, PrivHostKey} -> PrivHostKey; - Result -> exit({error, {Result, unsupported_key_type}}) + {ok, PrivHostKey} -> + %% Check the key - the KeyCb may be a buggy plugin + case valid_key_sha_alg(PrivHostKey, SignAlg) of + true -> PrivHostKey; + false -> exit({error, bad_hostkey}) + end; + Result -> + exit({error, {Result, unsupported_key_type}}) end. extract_public_key(#'RSAPrivateKey'{modulus = N, publicExponent = E}) -> @@ -1830,11 +1836,14 @@ valid_key_sha_alg(#'RSAPrivateKey'{}, 'ssh-rsa' ) -> true; valid_key_sha_alg({_, #'Dss-Parms'{}}, 'ssh-dss') -> true; valid_key_sha_alg(#'DSAPrivateKey'{}, 'ssh-dss') -> true; -valid_key_sha_alg({#'ECPoint'{},{namedCurve,OID}}, Alg) -> sha(OID) == sha(Alg); -valid_key_sha_alg(#'ECPrivateKey'{parameters = {namedCurve,OID}}, Alg) -> sha(OID) == sha(Alg); +valid_key_sha_alg({#'ECPoint'{},{namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); +valid_key_sha_alg(#'ECPrivateKey'{parameters = {namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); valid_key_sha_alg(_, _) -> false. - +valid_key_sha_alg_ec(OID, Alg) -> + Curve = public_key:oid2ssh_curvename(OID), + Alg == list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)). + public_algo(#'RSAPublicKey'{}) -> 'ssh-rsa'; % FIXME: Not right with draft-curdle-rsa-sha2 public_algo({_, #'Dss-Parms'{}}) -> 'ssh-dss'; diff --git a/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl b/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl index c07140dc43..19e2754eba 100644 --- a/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl +++ b/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl @@ -57,9 +57,9 @@ %%% Properties: -prop_seq(_Config) -> +prop_seq(Config) -> {ok,Pid} = ssh_eqc_event_handler:add_report_handler(), - {_, _, Port} = init_daemon(), + {_, _, Port} = init_daemon(Config), numtests(1000, ?FORALL(Delay, choose(0,100),%% Micro seconds try @@ -86,7 +86,8 @@ any_relevant_error_report(Pid) -> end, Reports). %%%================================================================ -init_daemon() -> +init_daemon(Config) -> ok = begin ssh:stop(), ssh:start() end, - ssh_test_lib:daemon([]). + DataDir = proplists:get_value(data_dir, Config), + ssh_test_lib:daemon([{system_dir,DataDir}]). diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index db2ae241e5..202b0afe57 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -46,6 +46,7 @@ exec_key_differs2/1, exec_key_differs3/1, exec_key_differs_fail/1, + fail_daemon_start/1, idle_time_client/1, idle_time_server/1, inet6_option/1, @@ -105,6 +106,7 @@ all() -> {group, host_user_key_differs}, {group, key_cb}, {group, internal_error}, + {group, rsa_host_key_is_actualy_ecdsa}, daemon_already_started, double_close, daemon_opt_fd, @@ -121,6 +123,7 @@ groups() -> {ecdsa_sha2_nistp256_key, [], basic_tests()}, {ecdsa_sha2_nistp384_key, [], basic_tests()}, {ecdsa_sha2_nistp521_key, [], basic_tests()}, + {rsa_host_key_is_actualy_ecdsa, [], [fail_daemon_start]}, {host_user_key_differs, [], [exec_key_differs1, exec_key_differs2, exec_key_differs3, @@ -180,6 +183,31 @@ init_per_group(rsa_key, Config) -> false -> {skip, unsupported_pub_key} end; +init_per_group(rsa_host_key_is_actualy_ecdsa, Config) -> + case + lists:member('ssh-rsa', + ssh_transport:default_algorithms(public_key)) and + lists:member('ecdsa-sha2-nistp256', + ssh_transport:default_algorithms(public_key)) + of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_ecdsa("256", DataDir, PrivDir), + %% The following sets up bad rsa keys: + begin + UserDir = PrivDir, + System = filename:join(UserDir, "system"), + file:copy(filename:join(DataDir, "id_rsa"), filename:join(UserDir, "id_rsa")), + file:rename(filename:join(System, "ssh_host_ecdsa_key"), filename:join(System, "ssh_host_rsa_key")), + file:rename(filename:join(System, "ssh_host_ecdsa_key.pub"), filename:join(System, "ssh_host_rsa_key.pub")), + ssh_test_lib:setup_rsa_known_host(DataDir, UserDir), + ssh_test_lib:setup_rsa_auth_keys(DataDir, UserDir) + end, + Config; + false -> + {skip, unsupported_pub_key} + end; init_per_group(ecdsa_sha2_nistp256_key, Config) -> case lists:member('ecdsa-sha2-nistp256', ssh_transport:default_algorithms(public_key)) of @@ -304,7 +332,8 @@ init_per_group(internal_error, Config) -> DataDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), - file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), + %% In the test case the key will be deleted after the daemon start: + %% ... file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), Config; init_per_group(dir_options, Config) -> PrivDir = proplists:get_value(priv_dir, Config), @@ -868,12 +897,17 @@ key_callback_options(Config) when is_list(Config) -> %%% Test that client does not hang if disconnects due to internal error internal_error(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = proplists:get_value(priv_dir, Config), + SystemDir = filename:join(PrivDir, system), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), + + %% Now provoke an error in the following connect: + file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), + {error, Error} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_dir, UserDir}, @@ -902,6 +936,17 @@ send(Config) when is_list(Config) -> %%-------------------------------------------------------------------- +%%% +fail_daemon_start(Config) when is_list(Config) -> + process_flag(trap_exit, true), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), + + {error,_} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {failfun, fun ssh_test_lib:failfun/2}]). + +%%-------------------------------------------------------------------- %%% Test ssh:connection_info([peername, sockname]) peername_sockname(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -1300,14 +1345,11 @@ shell_exit_status(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %% Due to timing the error message may or may not be delivered to %% the "tcp-application" before the socket closed message is recived -check_error("Invalid state") -> - ok; -check_error("Connection closed") -> - ok; -check_error("Selection of key exchange algorithm failed"++_) -> - ok; -check_error(Error) -> - ct:fail(Error). +check_error("Invalid state") -> ok; +check_error("Connection closed") -> ok; +check_error("Selection of key exchange algorithm failed"++_) -> ok; +check_error("No host key available") -> ok; +check_error(Error) -> ct:fail(Error). basic_test(Config) -> ClientOpts = proplists:get_value(client_opts, Config), diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 74f802cf57..3e3e151781 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -630,11 +630,12 @@ client_handles_keyboard_interactive_0_pwds(Config) -> %%%-------------------------------------------------------------------- -client_info_line(_Config) -> +client_info_line(Config) -> %% A client must not send an info-line. If it does, the server should handle %% handle this gracefully {ok,Pid} = ssh_eqc_event_handler:add_report_handler(), - {_, _, Port} = ssh_test_lib:daemon([]), + DataDir = proplists:get_value(data_dir, Config), + {_, _, Port} = ssh_test_lib:daemon([{system_dir,DataDir}]), %% Fake client: {ok,S} = gen_tcp:connect("localhost",Port,[]), diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 5a5e282998..f329a07b7a 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -1682,7 +1682,7 @@ do_random_test() -> ets:delete(Set), verify_etsmem(EtsMem). -%% Ttest various variants of update_element. +%% Test various variants of update_element. update_element(Config) when is_list(Config) -> EtsMem = etsmem(), repeat_for_opts(fun update_element_opts/1), diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 5e9e03e410..949142ec77 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -7871,7 +7871,7 @@ run_test(Config, Extra, {cres, Body, Opts, ExpectedCompileReturn}) -> {module, _} = code:load_abs(AbsFile, Mod), Ms0 = erlang:process_info(self(),messages), - Before = {{get(), lists:sort(ets:all()), Ms0}, pps()}, + Before = {{lget(), lists:sort(ets:all()), Ms0}, pps()}, %% Prepare the check that the qlc module does not call qlc_pt. _ = [unload_pt() || {file, Name} <- [code:is_loaded(qlc_pt)], @@ -7903,7 +7903,7 @@ run_test(Config, Extra, Body) -> wait_for_expected(R, {Strict0,PPS0}=Before, SourceFile, Wait) -> Ms = erlang:process_info(self(),messages), - After = {_,PPS1} = {{get(), lists:sort(ets:all()), Ms}, pps()}, + After = {_,PPS1} = {{lget(), lists:sort(ets:all()), Ms}, pps()}, case {R, After} of {ok, Before} -> ok; @@ -7931,6 +7931,18 @@ wait_for_expected(R, {Strict0,PPS0}=Before, SourceFile, Wait) -> expected({ok,Before}, {R,After}, SourceFile) end. +%% The qlc modules uses the process dictionary for storing names of files. +lget() -> + lists:sort([T || {K, _} = T <- get(), is_qlc_key(K)]). + +%% Copied from the qlc module. +-define(LCACHE_FILE(Ref), {Ref, '$_qlc_cache_tmpfiles_'}). +-define(MERGE_JOIN_FILE, '$_qlc_merge_join_tmpfiles_'). + +is_qlc_key(?LCACHE_FILE(_)) -> true; +is_qlc_key(?MERGE_JOIN_FILE) -> true; +is_qlc_key(_) -> false. + unload_pt() -> erlang:garbage_collect(), % get rid of references to qlc_pt... _ = code:purge(qlc_pt), diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index d651cbcfee..018f632948 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1112,27 +1112,16 @@ read_expected(Version) -> {POS7+2,{FF,{erlang,spawn_opt,4}}}, {POS8+1,{FF,{hej,san,1}}}, {POS8+4,{FF,{a,b,1}}}, - {POS8+4,{FF,{erlang,apply,2}}}, - {POS8+5,{FF,{erlang,apply,2}}}, {POS8+6,{FF,{m,f,1}}}, {POS9+1,{FF,{read,bi,0}}}, {POS9+2,{FF,{a,b,1}}}, - {POS9+2,{FF,{erlang,apply,2}}}, - {POS9+3,{FF,{erlang,apply,2}}}, - {POS9+4,{FF,{erlang,apply,2}}}, {POS9+4,{FF,{erlang,not_a_function,1}}}, {POS9+5,{FF,{mod,func,2}}}, {POS9+6,{FF,{erlang,apply,1}}}, - {POS9+7,{FF,{erlang,apply,2}}}, {POS9+7,{FF,{math,add3,1}}}, {POS9+8,{FF,{q,f,1}}}, - {POS10+4,{FF,{erlang,apply,2}}}, {POS10+5,{FF,{mod1,fun1,1}}}, - {POS11+6,{FF,{erlang,apply,2}}}, - {POS12+1,{FF,{erlang,apply,2}}}, - {POS12+4,{FF,{erlang,apply,2}}}, {POS12+5,{FF,{m3,f3,2}}}, - {POS12+7,{FF,{erlang,apply,2}}}, {POS13+1,{FF,{dm,df,1}}}, {POS13+6,{{read,bi,0},{foo,module_info,0}}}, {POS13+7,{{read,bi,0},{read,module_info,0}}}, @@ -1162,15 +1151,26 @@ read_expected(Version) -> {POS3+3, {FF,{erlang,spawn_link,3}}}, {POS3+4, {FF,{erlang,spawn_link,3}}}, {POS6+4, {FF,{erlang,spawn,3}}}, + {POS8+4,{FF,{erlang,apply,2}}}, + {POS8+5,{FF,{erlang,apply,2}}}, {POS8+6,{FF,{erlang,apply,3}}}, {POS8+7,{FF,{erlang,apply,3}}}, {POS9+1,{FF,{erlang,apply,3}}}, + {POS9+2,{FF,{erlang,apply,2}}}, + {POS9+3,{FF,{erlang,apply,2}}}, + {POS9+4,{FF,{erlang,apply,2}}}, {POS9+5,{FF,{erlang,apply,3}}}, + {POS9+7,{FF,{erlang,apply,2}}}, + {POS10+4,{FF,{erlang,apply,2}}}, {POS11+1,{FF,{erlang,apply,3}}}, {POS11+2,{FF,{erlang,apply,3}}}, {POS11+3,{FF,{erlang,apply,3}}}, {POS11+4,{FF,{erlang,apply,3}}}, + {POS11+6,{FF,{erlang,apply,2}}}, + {POS12+1,{FF,{erlang,apply,2}}}, + {POS12+4,{FF,{erlang,apply,2}}}, {POS12+5,{FF,{erlang,apply,3}}}, + {POS12+7,{FF,{erlang,apply,2}}}, {POS12+8,{FF,{erlang,apply,3}}}, {POS13+5, {{read,bi,0},{erlang,length,1}}}, {POS14+3, {{read,bi,0},{erlang,length,1}}}], |