diff options
Diffstat (limited to 'lib')
61 files changed, 1380 insertions, 2937 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 2a2a9cb5bc..9adcf2f13b 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -166,4 +166,4 @@ release_tests_spec: opt release_docs_spec: docs # Include dependencies -- list below added by Kostis Sagonas -$(EBIN)/cth_log_redirect.beam: ../../kernel/include/logger.hrl +$(EBIN)/cth_log_redirect.beam: ../../kernel/include/logger.hrl ../../kernel/src/logger_internal.hrl diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index dbbaae05eb..762c7bdf9e 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -392,6 +392,26 @@ backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D, _ -> backward(Is, D, [I|Acc]) end; +backward([{bif,map_get,{f,FF},[Key,Map],_}=I0, + {test,has_map_fields,{f,FT}=F,[Map|Keys0]}=I1|Is], D, Acc) when FF =/= 0 -> + case shortcut_label(FF, D) of + FT -> + case lists:delete(Key, Keys0) of + [] -> + backward([I0|Is], D, Acc); + Keys -> + Test = {test,has_map_fields,F,[Map|Keys]}, + backward([Test|Is], D, [I0|Acc]) + end; + _ -> + backward([I1|Is], D, [I0|Acc]) + end; +backward([{bif,map_get,{f,FF},[_,Map],_}=I0, + {test,is_map,{f,FT},[Map]}=I1|Is], D, Acc) when FF =/= 0 -> + case shortcut_label(FF, D) of + FT -> backward([I0|Is], D, Acc); + _ -> backward([I1|Is], D, [I0|Acc]) + end; backward([I|Is], D, Acc) -> backward(Is, D, [I|Acc]); backward([], _D, Acc) -> Acc. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index eb3192fe8f..920fb00397 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -77,6 +77,12 @@ peep([{bif,tuple_size,_,[_]=Ops,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests1), peep(Is, SeenTests, [I|Acc]); +peep([{bif,map_get,_,[Key,Map],Dst}=I|Is], SeenTests0, Acc) -> + %% Pretend that we have seen {test,has_map_fields,_,[Map,Key]} + SeenTests1 = gb_sets:add({has_map_fields,[Map,Key]}, SeenTests0), + %% Kill all remembered tests that depend on the destination register. + SeenTests = kill_seen(Dst, SeenTests1), + peep(Is, SeenTests, [I|Acc]); peep([{bif,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests0), diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 28f36db399..12da8c9446 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -462,6 +462,9 @@ update({set,[D],[Index,Reg],{bif,element,_}}, Ts0) -> end, Ts = tdb_meet(Reg, {tuple,min_size,MinSize,[]}, Ts0), tdb_store(D, any, Ts); +update({set,[D],[_Key,Map],{bif,map_get,_}}, Ts0) -> + Ts = tdb_meet(Map, map, Ts0), + tdb_store(D, any, Ts); update({set,[D],Args,{bif,N,_}}, Ts) -> Ar = length(Args), BoolOp = erl_internal:new_type_test(N, Ar) orelse diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index c7a129b42c..533c984221 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -351,10 +351,9 @@ mapfold(F, S0, T) -> mapfold(fun(T0, A) -> {T0, A} end, F, S0, T). -%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> -%% {cerl(), term()} -%% -%% Pre = Post = (cerl(), term()) -> {cerl(), term()} +%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> {cerl(), term()} +%% Pre = (cerl(), term()) -> {cerl(), term()} +%% Post = (cerl(), term()) -> {cerl(), term()} %% %% @doc Does a combined map/fold operation on the nodes of the %% tree. It begins by calling <code>Pre</code> on the tree, using the diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 70b36f029e..a7452aebc8 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -94,6 +94,7 @@ is_pure(erlang, is_function, 1) -> true; is_pure(erlang, is_integer, 1) -> true; is_pure(erlang, is_list, 1) -> true; is_pure(erlang, is_map, 1) -> true; +is_pure(erlang, is_map_key, 2) -> true; is_pure(erlang, is_number, 1) -> true; is_pure(erlang, is_pid, 1) -> true; is_pure(erlang, is_port, 1) -> true; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 8e73b613a0..9652a8476d 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -589,6 +589,7 @@ is_gc_bif(element, 2) -> false; is_gc_bif(get, 1) -> false; is_gc_bif(tuple_size, 1) -> false; is_gc_bif(map_get, 2) -> false; +is_gc_bif(is_map_key, 2) -> false; is_gc_bif(Bif, Arity) -> not (erl_internal:bool_op(Bif, Arity) orelse erl_internal:new_type_test(Bif, Arity) orelse @@ -1620,6 +1621,11 @@ test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) -> false -> [{jump,{f,Fail}}] end, {Is,Aft,St}; +test_cg(is_map_key, As, Fail, I, Vdb, Bef, St) -> + [Key,Map] = cg_reg_args(As, Bef), + Aft = clear_dead(Bef, I, Vdb), + F = {f,Fail}, + {[{test,is_map,F,[Map]},{test,has_map_fields,F,Map,{list,[Key]}}],Aft,St}; test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Args = cg_reg_args(As, Bef), Aft = clear_dead(Bef, I, Vdb), diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index e98c295da6..6badc7a8b8 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -1203,12 +1203,18 @@ t_guard_bifs(Config) when is_list(Config) -> true = map_guard_empty_2(), true = map_guard_head(#{a=>1}), false = map_guard_head([]), + true = map_get_head(#{a=>1}), + false = map_get_head([]), + true = map_is_key_head(#{a=>1}), + false = map_is_key_head(#{}), true = map_guard_body(#{a=>1}), false = map_guard_body({}), true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), false = map_guard_pattern("list"), true = map_guard_tautology(), true = map_guard_ill_map_size(), + true = map_field_check_sequence(#{a=>1}), + false = map_field_check_sequence(#{}), ok. map_guard_empty() when is_map(#{}); false -> true. @@ -1218,6 +1224,12 @@ map_guard_empty_2() when true; #{} andalso false -> true. map_guard_head(M) when is_map(M) -> true; map_guard_head(_) -> false. +map_get_head(M) when map_get(a, M) =:= 1 -> true; +map_get_head(_) -> false. + +map_is_key_head(M) when is_map_key(a, M) -> true; +map_is_key_head(M) -> false. + map_guard_body(M) -> is_map(M). map_guard_pattern(#{}) -> true; @@ -1227,6 +1239,12 @@ map_guard_tautology() when #{} =:= #{}; true -> true. map_guard_ill_map_size() when true; map_size(0) -> true. +map_field_check_sequence(M) + when is_map(M) andalso is_map_key(a, M) andalso (map_get(a, M) == 1) -> + true; +map_field_check_sequence(_) -> + false. + t_guard_sequence(Config) when is_list(Config) -> {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index f55cffe158..6cb3095507 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -40,7 +40,7 @@ -import(edoc_report, [report/2, warning/2]). -%% @headerfile "edoc_doclet.hrl" +%% @headerfile "../include/edoc_doclet.hrl" -include("../include/edoc_doclet.hrl"). -define(EDOC_APP, edoc). diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index fe6ab0659c..48ce641ab9 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -665,6 +665,8 @@ type(erlang, is_map, 1, Xs, Opaques) -> check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end, t_map(), Opaques) end, strict(erlang, is_map, 1, Xs, Fun, Opaques); +type(erlang, is_map_key, 2, Xs, Opaques) -> + type(maps, is_key, 2, Xs, Opaques); type(erlang, is_number, 1, Xs, Opaques) -> Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end, @@ -2374,6 +2376,8 @@ arg_types(erlang, is_list, 1) -> [t_any()]; arg_types(erlang, is_map, 1) -> [t_any()]; +arg_types(erlang, is_map_key, 2) -> + [t_any(), t_map()]; arg_types(erlang, is_number, 1) -> [t_any()]; arg_types(erlang, is_pid, 1) -> @@ -2396,7 +2400,7 @@ arg_types(erlang, map_size, 1) -> [t_map()]; %% Guard bif, needs to be here. arg_types(erlang, map_get, 2) -> - [t_map(), t_any()]; + [t_any(), t_map()]; arg_types(erlang, make_fun, 3) -> [t_atom(), t_atom(), t_arity()]; arg_types(erlang, make_tuple, 2) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index a91da97f93..9abb4d31d9 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -108,13 +108,14 @@ t_is_bitstr/1, t_is_bitstr/2, t_is_bitwidth/1, t_is_boolean/1, t_is_boolean/2, - %% t_is_byte/1, - %% t_is_char/1, + t_is_byte/1, + t_is_char/1, t_is_cons/1, t_is_cons/2, t_is_equal/2, t_is_fixnum/1, t_is_float/1, t_is_float/2, t_is_fun/1, t_is_fun/2, + t_is_identifier/1, t_is_instance/2, t_is_integer/1, t_is_integer/2, t_is_list/1, @@ -216,19 +217,8 @@ cache__new/0 ]). -%%-define(DO_ERL_TYPES_TEST, true). -compile({no_auto_import,[min/2,max/2,map_get/2]}). --ifdef(DO_ERL_TYPES_TEST). --export([test/0]). --else. --define(NO_UNUSED, true). --endif. - --ifndef(NO_UNUSED). --export([t_is_identifier/1]). --endif. - -export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). @@ -1190,12 +1180,10 @@ is_fun(_) -> false. t_identifier() -> ?identifier(?any). --ifdef(DO_ERL_TYPES_TEST). --spec t_is_identifier(erl_type()) -> erl_type(). +-spec t_is_identifier(erl_type()) -> boolean(). t_is_identifier(?identifier(_)) -> true; t_is_identifier(_) -> false. --endif. %%------------------------------------ @@ -1366,7 +1354,6 @@ is_integer1(_) -> false. t_byte() -> ?byte. --ifdef(DO_ERL_TYPES_TEST). -spec t_is_byte(erl_type()) -> boolean(). t_is_byte(?int_range(neg_inf, _)) -> false; @@ -1376,7 +1363,6 @@ t_is_byte(?int_range(From, To)) t_is_byte(?int_set(Set)) -> (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_BYTE); t_is_byte(_) -> false. --endif. %%------------------------------------ @@ -5693,173 +5679,3 @@ family(L) -> var_table__new() -> maps:new(). - -%%============================================================================= -%% Consistency-testing function(s) below -%%============================================================================= - --ifdef(DO_ERL_TYPES_TEST). - -test() -> - Atom1 = t_atom(), - Atom2 = t_atom(foo), - Atom3 = t_atom(bar), - true = t_is_atom(Atom2), - - True = t_atom(true), - False = t_atom(false), - Bool = t_boolean(), - true = t_is_boolean(True), - true = t_is_boolean(Bool), - false = t_is_boolean(Atom1), - - Binary = t_binary(), - true = t_is_binary(Binary), - - Bitstr = t_bitstr(), - true = t_is_bitstr(Bitstr), - - Bitstr1 = t_bitstr(7, 3), - true = t_is_bitstr(Bitstr1), - false = t_is_binary(Bitstr1), - - Bitstr2 = t_bitstr(16, 8), - true = t_is_bitstr(Bitstr2), - true = t_is_binary(Bitstr2), - - ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)), - ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)), - - Int1 = t_integer(), - Int2 = t_integer(1), - Int3 = t_integer(16#ffffffff), - true = t_is_integer(Int2), - true = t_is_byte(Int2), - false = t_is_byte(Int3), - false = t_is_byte(t_from_range(-1, 1)), - true = t_is_byte(t_from_range(1, ?MAX_BYTE)), - - Tuple1 = t_tuple(), - Tuple2 = t_tuple(3), - Tuple3 = t_tuple([Atom1, Int1]), - Tuple4 = t_tuple([Tuple1, Tuple2]), - Tuple5 = t_tuple([Tuple3, Tuple4]), - Tuple6 = t_limit(Tuple5, 2), - Tuple7 = t_limit(Tuple5, 3), - true = t_is_tuple(Tuple1), - - Port = t_port(), - Pid = t_pid(), - Ref = t_reference(), - Identifier = t_identifier(), - false = t_is_reference(Port), - true = t_is_identifier(Port), - - Function1 = t_fun(), - Function2 = t_fun(Pid), - Function3 = t_fun([], Pid), - Function4 = t_fun([Port, Pid], Pid), - Function5 = t_fun([Pid, Atom1], Int2), - true = t_is_fun(Function3), - - List1 = t_list(), - List2 = t_list(t_boolean()), - List3 = t_cons(t_boolean(), List2), - List4 = t_cons(t_boolean(), t_atom()), - List5 = t_cons(t_boolean(), t_nil()), - List6 = t_cons_tl(List5), - List7 = t_sup(List4, List5), - List8 = t_inf(List7, t_list()), - List9 = t_cons(), - List10 = t_cons_tl(List9), - true = t_is_boolean(t_cons_hd(List5)), - true = t_is_list(List5), - false = t_is_list(List4), - - Product1 = t_product([Atom1, Atom2]), - Product2 = t_product([Atom3, Atom1]), - Product3 = t_product([Atom3, Atom2]), - - Union1 = t_sup(Atom2, Atom3), - Union2 = t_sup(Tuple2, Tuple3), - Union3 = t_sup(Int2, Atom3), - Union4 = t_sup(Port, Pid), - Union5 = t_sup(Union4, Int1), - Union6 = t_sup(Function1, Function2), - Union7 = t_sup(Function4, Function5), - Union8 = t_sup(True, False), - true = t_is_boolean(Union8), - Union9 = t_sup(Int2, t_integer(2)), - true = t_is_byte(Union9), - Union10 = t_sup(t_tuple([t_atom(true), ?any]), - t_tuple([t_atom(false), ?any])), - - ?any = t_sup(Product3, Function5), - - Atom3 = t_inf(Union3, Atom1), - Union2 = t_inf(Union2, Tuple1), - Int2 = t_inf(Int1, Union3), - Union4 = t_inf(Union4, Identifier), - Port = t_inf(Union5, Port), - Function4 = t_inf(Union7, Function4), - ?none = t_inf(Product2, Atom1), - Product3 = t_inf(Product1, Product2), - Function5 = t_inf(Union7, Function5), - true = t_is_byte(t_inf(Union9, t_number())), - true = t_is_char(t_inf(Union9, t_number())), - - io:format("3? ~p ~n", [?int_set([3])]), - - RecDict = dict:store({foo, 2}, [bar, baz], dict:new()), - Record1 = t_from_term({foo, [1,2], {1,2,3}}), - - Types = [ - Atom1, - Atom2, - Atom3, - Binary, - Int1, - Int2, - Tuple1, - Tuple2, - Tuple3, - Tuple4, - Tuple5, - Tuple6, - Tuple7, - Ref, - Port, - Pid, - Identifier, - List1, - List2, - List3, - List4, - List5, - List6, - List7, - List8, - List9, - List10, - Function1, - Function2, - Function3, - Function4, - Function5, - Product1, - Product2, - Record1, - Union1, - Union2, - Union3, - Union4, - Union5, - Union6, - Union7, - Union8, - Union10, - t_inf(Union10, t_tuple([t_atom(true), t_integer()])) - ], - io:format("~p\n", [[t_to_string(X, RecDict) || X <- Types]]). - --endif. diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl deleted file mode 100644 index 0f25940e3d..0000000000 --- a/lib/hipe/opt/hipe_schedule.erl +++ /dev/null @@ -1,1483 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% INSTRUCTION SCHEDULER -%% -%% This is a basic ILP cycle scheduler: -%% * set cycle = 0 -%% * while ready[cycle] nonempty do -%% - take x with greatest priority from ready[cycle] -%% - try to schedule x; -%% * if scheduling x was possible, -%% - reserve resources -%% - add x to schedule and delete x from dag -%% - update earliest-time for all successor nodes -%% as max[earliest[y],cycle+latency[x]] -%% - if some node y now has no predecessors, -%% add y to ready[earliest[y]] -%% * if it was impossible, put x in ready[cycle+1] -%% (= try again) -%% -%% We use the following data structures: -%% 1. all nodes are numbered and indices used as array keys -%% 2. priority per node can be computed statically or dynamically -%% * statically: before scheduling, each node gets a priority value -%% * dynamically: at each cycle, compute priorities for all ready nodes -%% 3. earliest: earliest cycle of issue, starts at 0 -%% and is updated as predecessors issue -%% 4. predecessors: number of predecessors (0 = ready to issue) -%% 5. successors: list of {Latency,NodeID} -%% 6. ready: an array indexed by cycle-time (integer), where -%% ready nodes are kept. -%% 7. resources: a resource representation (ADT) that answers -%% certain queries, e.g., "can x be scheduled this cycle" -%% and "reserve resources for x". -%% 8. schedule: list of scheduled instructions {Instr,Cycle} -%% in the order of issue -%% 9. instructions: maps IDs back to instructions -%% -%% Inputs: -%% - a list of {ID,Node} pairs (where ID is a unique key) -%% - a dependence list {ID0,Latency,ID1}, which is used to -%% build the DAG. -%% -%% Note that there is some leeway in how things are represented -%% from here. -%% -%% MODIFICATIONS: -%% - Some basic blocks are not worth scheduling (e.g., GC save/restore code) -%% yet are pretty voluminous. How do we skip them? -%% - Scheduling should be done at finalization time: when basic block is -%% linearized and is definitely at Sparc assembly level, THEN reorder -%% stuff. - --module(hipe_schedule). --export([cfg/1, est_cfg/1, delete_node/5]). - --include("../sparc/hipe_sparc.hrl"). - -%%-define(debug1,true). - --define(debug2(Str,Args),ok). -%%-define(debug2(Str,Args),io:format(Str,Args)). - --define(debug3(Str,Args),ok). -%%-define(debug3(Str,Args),io:format(Str,Args)). - --define(debug4(Str,Args),ok). -%%-define(debug4(Str,Args),io:format(Str,Args)). - --define(debug5(Str,Args),ok). -%%-define(debug5(Str,Args),io:format(Str,Args)). - --define(debug(Str,Args),ok). -%%-define(debug(Str,Args),io:format(Str,Args)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cfg -%% Argument : CFG - the control flow graph -%% Returns : CFG - A new cfg with scheduled blocks -%% Description : Takes each basic block and schedules them one by one. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cfg(CFG) -> - ?debug3("CFG: ~n~p", [CFG]), - update_all( [ {L, - hipe_bb:mk_bb( - block(L,hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))) )} - || L <- hipe_sparc_cfg:labels(CFG) ], CFG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : update_all -%% Argument : Blocks - [{Label, Block}] , a list with labels and new code -%% used for updating the old CFG. -%% CFG - The old controlflow graph -%% Returns : An updated controlflow graph. -%% Description : Just swappes the basic blocks in the CFG to the scheduled one. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -update_all([],CFG) -> CFG; -update_all([{L,NewB}|Ls],CFG) -> - update_all(Ls,hipe_sparc_cfg:bb_add(CFG,L,NewB)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -est_cfg(CFG) -> - update_all([ {L, hipe_bb:mk_bb(est_block(hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))))} - || L <- hipe_sparc_cfg:labels(CFG) ], CFG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Provides an estimation of how quickly a block will execute. -%% This is done by chaining all instructions in sequential order -%% by 0-cycle dependences (which means they will never be reordered), -%% then scheduling the mess. - -est_block([]) -> []; -est_block([I]) -> [I]; -est_block(Blk) -> - {IxBlk,DAG} = est_deps(Blk), - Sch = bb(IxBlk,DAG), - separate_block(Sch,IxBlk). - -est_deps(Blk) -> - IxBlk = indexed_bb(Blk), - DAG = deps(IxBlk), - {IxBlk, chain_instrs(IxBlk,DAG)}. - -chain_instrs([{N,_}|Xs],DAG) -> - chain_i(N,Xs,DAG). - -chain_i(_,[],DAG) -> DAG; -chain_i(N,[{M,_}|Xs],DAG) -> - NewDAG = dep_arc(N,zero_latency(),M,DAG), - chain_i(M,Xs,NewDAG). - -zero_latency() -> 0. - -lookup_instr([{N,I}|_], N) -> I; -lookup_instr([_|Xs], N) -> lookup_instr(Xs, N). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : block -%% Argument : Instrs - [Instr], list of all the instructions in a basic -%% block. -%% Returns : A new scheduled block -%% Description : Schedule a basic block -%% -%% Note: does not consider delay slots! -%% (another argument for using only annulled delay slots?) -%% * how do we add delay slots? somewhat tricky to -%% reconcile with the sort of scheduling we consider. -%% (as-early-as-possible) -%% => rewrite scheduler into as-late-as-possible? -%% (=> just reverse the dependence arcs??) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% Don't fire up the scheduler if there's no work to do. -block(_, []) -> - []; -block(_L, [I]) -> - case hipe_sparc:is_any_branch(I) of - true -> [hipe_sparc:nop_create(), I]; - false -> [I] - end; -block(_L, Blk) -> - IxBlk = indexed_bb(Blk), - case IxBlk of - [{_N, I}] -> % comments and nops may have been removed. - case hipe_sparc:is_any_branch(I) of - true -> [hipe_sparc:nop_create(), I]; - false -> [I] - end; - _ -> - Sch = bb(IxBlk, {DAG, _Preds} = deps(IxBlk)), - {NewSch, NewIxBlk} = fill_delays(Sch, IxBlk, DAG), - X = finalize_block(NewSch, NewIxBlk), - debug1_stuff(Blk, DAG, IxBlk, Sch, X), - X - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_delays -%% Argument : Sch - List of {{cycle, C}, {node, N}} : C = current cycle -%% N = node index -%% IxBlk - Indexed block [{N, Instr}] -%% DAG - Dependence graph -%% Returns : {NewSch, NewIxBlk} - vector with new schedule and vector -%% with {N, Instr} -%% Description : Goes through the schedule from back to front looking for -%% branches/jumps. If one is found fill_del tries to find -%% an instr to fill the delayslot. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_delays(Sch, IxBlk, DAG) -> - NewIxBlk = hipe_vectors:list_to_vector(IxBlk), - %% NewSch = hipe_vectors:list_to_vector(Sch), - NewSch = fill_del(length(Sch), hipe_vectors:list_to_vector(Sch), - NewIxBlk, DAG), - {NewSch, NewIxBlk}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_del -%% Argument : N - current index in the schedule -%% Sch - schedule -%% IxBlk - indexed block -%% DAG - dependence graph -%% Returns : Sch - New schedule with possibly a delay instr in the last -%% position. -%% Description : If a call/jump is found fill_branch_delay/fill_call_delay -%% is called to find a delay-filler. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_del(N, Sch, _IxBlk, _DAG) when N < 1 -> Sch; -fill_del(N, Sch, IxBlk, DAG) -> - Index = get_index(Sch, N), - ?debug2("Index for ~p: ~p~nInstr: ~p~n", - [N, Index, get_instr(IxBlk, Index)]), - NewSch = - case get_instr(IxBlk, Index) of - #call_link{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - #jmp_link{} -> - fill_call_delay(N - 1, N, Sch, IxBlk, DAG); - #jmp{} -> - fill_call_delay(N - 1, N, Sch, IxBlk, DAG); - #b{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - #br{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - #goto{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - _Other -> - Sch - end, - NewSch. - %% fill_del(N - 1, NewSch, IxBlk, DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_call_delay -%% Argument : Cand - index in schedule of delay-candidate -%% Call - index in schedule of call -%% Sch - schedule vector: < {{cycle,Ci},{node,Nj}}, ... > -%% IxBlk - block vector: < {N, Instr1}, {N+1, Instr2} ... > -%% DAG - dependence graph -%% Returns : Sch - new updated schedule. -%% Description : Searches backwards through the schedule trying to find an -%% instr without conflicts with the Call-instr. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_call_delay(Cand, _Call, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch; -fill_call_delay(Cand, Call, Sch, IxBlk, DAG) -> - CandIndex = get_index(Sch, Cand), - CallIndex = get_index(Sch, Call), - CandI = get_instr(IxBlk, CandIndex), - case move_or_alu(CandI) of - true -> - case single_depend(CandIndex, CallIndex, DAG) of - false -> % Other instrs depends on Cand ... - fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG); - - true -> - CallI = get_instr(IxBlk, CallIndex), - - CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)), - %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)), - %% CallDefs = ordsets:from_list(hipe_sparc:defines(CallI)), - CallUses = ordsets:from_list(hipe_sparc:uses(CallI)), - - Args = case CallI of - #jmp_link{} -> - ordsets:from_list( - hipe_sparc:jmp_link_args(CallI)); - #jmp{} -> - ordsets:from_list(hipe_sparc:jmp_args(CallI)); - #call_link{} -> - ordsets:from_list( - hipe_sparc:call_link_args(CallI)) - end, - CallUses2 = ordsets:subtract(CallUses, Args), - Conflict = ordsets:intersection(CandDefs, CallUses2), - %% io:format("single_depend -> true:~n ~p~n, ~p~n,~p~n",[CandI,CallI,DAG]), - %% io:format("Cand = ~p~nCall = ~p~n",[CandI,CallI]), - %% io:format("CandDefs = ~p~nCallDefs = ~p~n",[CandDefs,CallDefs]), - %% io:format("CandUses = ~p~nCallUses = ~p~n",[CandUses,CallUses]), - %% io:format("Args = ~p~nCallUses2 = ~p~n",[Args,CallUses2]), - %% io:format("Conflict = ~p~n",[Conflict]), - - case Conflict of - [] -> % No conflicts ==> Cand can fill delayslot after Call - update_schedule(Cand, Call, Sch); - _ -> % Conflict: try with preceeding instrs - fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG) - end - end; - false -> - fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_branch_delay -%% Argument : Cand - index in schedule of delay-candidate -%% Branch - index in schedule of branch -%% Sch - schedule -%% IxBlk - indexed block -%% DAG - dependence graph -%% Returns : Sch - new updated schedule. -%% Description : Searches backwards through the schedule trying to find an -%% instr without conflicts with the Branch-instr. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_branch_delay(Cand, _Br, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch; -fill_branch_delay(Cand, Br, Sch, IxBlk, DAG) -> - CandIndex = get_index(Sch, Cand), - BrIndex = get_index(Sch, Br), - CandI = get_instr(IxBlk, CandIndex), - case move_or_alu(CandI) of - true -> - case single_depend(CandIndex, BrIndex, DAG) of - false -> % Other instrs depends on Cand ... - fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG); - - true -> - BrI = get_instr(IxBlk, BrIndex), - CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)), - %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)), - %% BrDefs = ordsets:from_list(hipe_sparc:defines(BrI)), - BrUses = ordsets:from_list(hipe_sparc:uses(BrI)), - - Conflict = ordsets:intersection(CandDefs, BrUses), - %% io:format("single_depend -> true: ~p~n, ~p~n,~p~n", [CandI, BrI, DAG]), - %% io:format("Cand = ~p~nBr = ~p~n",[CandI,BrI]), - %% io:format("CandDefs = ~p~nBrDefs = ~p~n",[CandDefs,BrDefs]), - %% io:format("CandUses = ~p~nBrUses = ~p~n",[CandUses,BrUses]), - %% io:format("Conflict = ~p~n",[Conflict]); - - case Conflict of - [] -> % No conflicts ==> - % Cand can fill delayslot after Branch - update_schedule(Cand, Br, Sch); - _ -> % Conflict: try with preceeding instrs - fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG) - end - end; - false -> - fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : update_schedule -%% Argument : From - the position from where to switch indexes in Sch -%% To - the position to where to switch indexes in Sch -%% Sch - schedule -%% Returns : Sch - an updated schedule -%% Description : If From is the delay-filler and To is the Call/jump, the -%% schedule is updated so From gets index To, To gets index -%% To - 1, and the nodes between From and To gets old_index - 1. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -update_schedule(To, To, Sch) -> - {{cycle, C}, {node, _N} = Node} = hipe_vectors:get(Sch, To-1), - hipe_vectors:set(Sch, To-1, {{cycle, C+1}, Node}); -update_schedule(From, To, Sch) -> - Temp = hipe_vectors:get(Sch, From-1), - Sch1 = hipe_vectors:set(Sch, From-1, hipe_vectors:get(Sch, From)), - update_schedule(From + 1, To, hipe_vectors:set(Sch1, From, Temp)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : single_depend -%% Argument : N - Index of the delayslot candidate -%% M - Index of the node that N possibly has a single -%% depend to. -%% DAG - The dependence graph -%% Returns : true if no other nodes than N os depending on N -%% Description : Checks that no other nodes than M depends on N and that the -%% latency between them is zero or 1. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -single_depend(N, M, DAG) -> - Deps = hipe_vectors:get(DAG, N-1), - single_depend(M, Deps). - -single_depend(_N, []) -> true; -single_depend(N, [{0, N}]) -> true; -single_depend(N, [{1, N}]) -> true; -single_depend(_N, [{_Lat, _}|_]) -> false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_index -%% Argument : Sch - schedule -%% N - index in schedule -%% Returns : Index - index of the node -%% Description : Returns the index of the node on position N in the schedule. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_index(Sch, N) -> - {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch,N-1), - Index. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_instr -%% Argument : IxBlk - indexed block -%% N - index in block -%% Returns : Instr -%% Description : Returns the instr on position N in the indexed block. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_instr(IxBlk, N) -> - {_, Instr} = hipe_vectors:get(IxBlk, N-1), - Instr. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_instr -%% Argument : Sch - schedule -%% IxBlk - indexed block -%% N - index in schedule -%% Returns : Instr -%% Description : Returns the instr on position N in the schedule. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_instr(Sch, IxBlk, N) -> - {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch, N-1), - {_, Instr} = hipe_vectors:get(IxBlk, Index-1), - Instr. - -separate_block(Sch,IxBlk) -> - sep_comments([{C,lookup_instr(IxBlk,N)} || {{cycle,C},{node,N}} <- Sch]). - -sep_comments([]) -> []; -sep_comments([{C,I}|Xs]) -> - [hipe_sparc:comment_create({cycle,C}), I | sep_comments(Xs,C)]. - -sep_comments([], _) -> []; -sep_comments([{C1,I}|Xs], C0) -> - if - C1 > C0 -> - [hipe_sparc:comment_create({cycle,C1}),I|sep_comments(Xs,C1)]; - true -> - [I|sep_comments(Xs, C0)] - end. - -finalize_block(Sch, IxBlk) -> - ?debug5("Sch: ~p~nIxBlk: ~p~n",[Sch,IxBlk]), - finalize_block(1, hipe_vectors:size(Sch), 1, Sch, IxBlk, []). - -finalize_block(N, End, _C, Sch, IxBlk, _Instrs) when N =:= End - 1 -> - NextLast = get_instr(Sch, IxBlk, N), - Last = get_instr(Sch, IxBlk, End), - ?debug5("NextLast: ~p~nLast: ~p~n",[NextLast,Last]), - case hipe_sparc:is_any_branch(Last) of - true -> % Couldn't fill delayslot ==> add NOP - [NextLast , hipe_sparc:nop_create(), Last]; - false -> % Last is a delayslot-filler ==> change order... - [Last, NextLast] - end; -finalize_block(N, End, C0, Sch, IxBlk, Instrs) -> - {{cycle, _C1}, {node, _M}} = hipe_vectors:get(Sch, N-1), - Instr = get_instr(Sch, IxBlk, N), - ?debug5("Instr: ~p~n~n",[Instr]), - [Instr | finalize_block(N + 1, End, C0, Sch, IxBlk, Instrs)]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : bb -%% Argument : IxBlk - indexed block -%% DAG - {Dag, Preds} where Dag is dependence graph and -%% Preds is number of predecessors for each node. -%% Returns : Sch -%% Description : Initializes earliest-list, ready-list, priorities, resources -%% and so on, and calls the cycle_sched which does the scheduling -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -bb(IxBlk,DAG) -> - bb(length(IxBlk), IxBlk, DAG). - -bb(N,IxBlk,{DAG, Preds}) -> - Earliest = init_earliest(N), - BigArray = N*10, % "nothing" is this big :-) - Ready = hipe_schedule_prio:init_ready(BigArray,Preds), - I_res = init_instr_resources(N, IxBlk), - - Prio = hipe_schedule_prio:init_instr_prio(N,DAG), - Rsrc = init_resources(BigArray), - ?debug4("I_res: ~n~p~nPrio: ~n~p~nRsrc: ~n~p~n", [I_res,Prio,Rsrc]), - ?debug('cycle 1~n',[]), - Sch = empty_schedule(), - cycle_sched(1,Ready,DAG,Preds,Earliest,Rsrc,I_res,Prio,Sch,N,IxBlk). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cycle_sched -%% Argument : - C is current cycle, 1 or more. -%% - Ready is an array (Cycle -> [Node]) -%% yielding the collection of nodes ready to be -%% scheduled in a cycle. -%% - DAG is an array (Instr -> [{Latency,Instr}]) -%% represents the dependence DAG. -%% - Preds is an array (Instr -> NumPreds) -%% counts the number of predecessors -%% (0 preds = ready to be scheduled). -%% - Earl is an array (Instr -> EarliestCycle) -%% holds the earliest cycle an instruction can be scheduled. -%% - Rsrc is a 'resource ADT' that handles scheduler resource -%% management checks whether instruction can be scheduled -%% this cycle without a stall. -%% - I_res is an array (Instr -> Required_resources) -%% holds the resources required to schedule an instruction. -%% - Sch is the representation of the schedule current schedule. -%% - N is the number of nodes remaining to be scheduled -%% tells us when to stop the scheduler. -%% - IxBlk is the indexed block with instrs -%% Returns : present schedule -%% Description : Scheduler main loop. -%% Pick next ready node in priority order for cycle C until -%% none remain. -%% * check each node if it can be scheduled w/o stalling -%% * if so, schedule it -%% * otherwise, bump the node to the next cycle -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cycle_sched(C,Ready,DAG,Preds,Earl,Rsrc,I_res,Prio,Sch,N,IxBlk) -> - case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk,DAG,Preds,Earl) of -% case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk) of - {next,I,Ready1} -> - ?debug('try ~p~n==> ready = ~p~n',[I, Ready1]), - case resources_available(C,I,Rsrc,I_res) of - {yes,NewRsrc} -> - ?debug(' scheduled~n==> Rscrs = ~p~n',[NewRsrc]), - NewSch = add_to_schedule(I,C,Sch), - {ReadyNs,NewDAG,NewPreds,NewEarl} = - delete_node(C,I,DAG,Preds,Earl), - ?debug("NewPreds : ~p~n",[Preds]), - ?debug(' ReadyNs: ~p~n',[ReadyNs]), - NewReady = hipe_schedule_prio:add_ready_nodes(ReadyNs, - Ready1), - ?debug(' New ready: ~p~n',[NewReady]), - cycle_sched(C,NewReady,NewDAG,NewPreds,NewEarl, - NewRsrc,I_res,Prio,NewSch,N-1, IxBlk); - no -> - ?debug(' resource conflict~n',[]), - NewReady = hipe_schedule_prio:insert_node(C+1,I,Ready1), - cycle_sched(C,NewReady,DAG,Preds,Earl,Rsrc, - I_res,Prio,Sch,N,IxBlk) - end; - none -> % schedule next cycle if some node remains - if - N > 0 -> - ?debug('cycle ~p~n',[C+1]), - cycle_sched(C+1,Ready,DAG,Preds,Earl, - advance_cycle(Rsrc), - I_res,Prio,Sch,N, IxBlk); - true -> - present_schedule(Sch) - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : init_earliest -%% Argument : N - number of instrs -%% Returns : -%% Description : -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_earliest(N) -> - hipe_vectors:new(N,1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Schedule is kept reversed until the end. - --define(present_node(I,Cycle),{{cycle,Cycle},{node,I}}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_schedule -%% Description : Returns an empty schedule. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_schedule() -> []. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_to_schedule -%% Argument : I - instr -%% Cycle - cycle when I was placed -%% Sch - schedule -%% Description : Adds instr to schedule -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_to_schedule(I,Cycle,Sch) -> - [?present_node(I,Cycle)|Sch]. - -present_schedule(Sch) -> lists:reverse(Sch). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Interface to resource manager: -%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : init_resources -%% Description : Yields a 'big enough' array mapping (Cycle -> Resources); -%% this array is called Rsrc below. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_resources(S) -> - hipe_target_machine:init_resources(S). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : init_instr_resources -%% Argument : Nodes - a list of the instructions -%% N - is the number of nodes -%% Description : return a vector (NodeID -> Resource_requirements) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_instr_resources(N,Nodes) -> - hipe_target_machine:init_instr_resources(N,Nodes). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : resources_available -%% Argument : Cycle - the current cycle -%% I - the current instruction (index = NodeID) -%% Rsrc - a map (Cycle -> Resources) -%% I_res - maps (NodeID -> Resource_requirements) -%% Description : returns {yes,NewResTab} | no -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -resources_available(Cycle,I,Rsrc,I_res) -> - hipe_target_machine:resources_available(Cycle,I,Rsrc,I_res). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : advance_cycle -%% Argument : Rsrc - resources -%% Description : Returns an empty resources-state -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -advance_cycle(Rsrc) -> - hipe_target_machine:advance_cycle(Rsrc). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : delete_node -%% Argument : Cycle - current cycle -%% I - index of instr -%% DAG - dependence dag -%% Preds - array with number of predecessors for nodes -%% Earl - array with earliest-times for nodes -%% Returns : {ReadyNs,NewDAG,NewPreds,NewEarl} -%% Description : Deletes node I and updates earliest times for the rest. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -delete_node(Cycle,I,DAG,Preds,Earl) -> - Succ = hipe_vectors:get(DAG,I-1), - NewDAG = hipe_vectors:set(DAG,I-1,scheduled), % provides debug 'support' - {ReadyNs,NewPreds,NewEarl} = update_earliest(Succ,Cycle,Preds,Earl,[]), - ?debug('earliest after ~p: ~p~n',[I,[{Ix+1,V} || {Ix,V} <- hipe_vectors:list(NewEarl)]]), - {ReadyNs,NewDAG,NewPreds,NewEarl}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : update_earliest -%% Argument : Succ - successor list -%% Cycle - current cycle -%% Preds - predecessors -%% Earl - earliest times for nodes -%% Ready - array with readynodes for cycles -%% Returns : {Ready,Preds,Earl} -%% Description : Updates the earliest times for nodes and updates number of -%% predecessors for nodes -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -update_earliest([],_Cycle,Preds,Earl,Ready) -> - {Ready,Preds,Earl}; -update_earliest([{Lat,N}|Xs],Cycle,Preds,Earl,Ready) -> - Old_earl = hipe_vectors:get(Earl,N-1), - New_earl = erlang:max(Old_earl,Cycle+Lat), - NewEarl = hipe_vectors:set(Earl,N-1,New_earl), - Num_preds = hipe_vectors:get(Preds,N-1), - NewPreds = hipe_vectors:set(Preds,N-1,Num_preds-1), - if - Num_preds =:= 0 -> - ?debug('inconsistent DAG~n',[]), - exit({update_earliest,N}); - Num_preds =:= 1 -> - NewReady = [{New_earl,N}|Ready], - NewPreds2 = hipe_vectors:set(NewPreds,N-1,0), - update_earliest(Xs,Cycle,NewPreds2,NewEarl,NewReady); - is_integer(Num_preds), Num_preds > 1 -> - update_earliest(Xs,Cycle,NewPreds,NewEarl,Ready) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Collect instruction dependences. -%% -%% Three forms: -%% - data/register -%% * insert RAW, WAR, WAW dependences -%% - memory -%% * stores serialize memory references -%% * alias analysis may allow loads to bypass stores -%% - control -%% * unsafe operations are 'trapped' between branches -%% * branches are ordered -%% -%% returns { [{Index,Instr}], DepDAG } -%% DepDAG is defined below. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : deps -%% Argument : BB - Basic block -%% Returns : {IxBB,DAG} - indexed block and dependence graph. DAG consists -%% of both Dag and Preds, where Preds is number -%% of predecessors for nodes. -%% Description : Collect instruction dependences. -%% -%% Three forms: -%% - data/register -%% * insert RAW, WAR, WAW dependences -%% - memory -%% * stores serialize memory references -%% * alias analysis may allow loads to bypass stores -%% - control -%% * unsafe operations are 'trapped' between branches -%% * branches are ordered -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -deps(IxBB) -> - N = length(IxBB), - DAG = empty_dag(N), % The DAG contains both dependence-arcs and - % number of predeccessors... - {_DepTab,DAG1} = dd(IxBB, DAG), - DAG2 = md(IxBB, DAG1), - cd(IxBB, DAG2). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_dag -%% Argument : N - number of nodes -%% Returns : empty DAG -%% Description : DAG consists of dependence graph and predeccessors -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_dag(N) -> - {hipe_vectors:new(N, []), hipe_vectors:new(N, 0)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : indexed_bb -%% Argument : BB - basic block -%% Returns : [{N, Instr}] -%% Description : Puts indexes to all instrs of a block, removes comments. -%% NOP's are also removed because if both sparc_schedule and -%% sparc_post_schedule options are used, the first pass will -%% add nop's before the branch if necessary, and these are -%% removed before scheduling the second pass. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -indexed_bb(BB) -> - indexed_bb(BB,1). - -indexed_bb([],_N) -> []; -indexed_bb([X|Xs],N) -> - case X of - #comment{} -> - indexed_bb(Xs,N); - #nop{} -> - indexed_bb(Xs,N); - _Other -> - [{N,X}|indexed_bb(Xs,N+1)] - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : dep_arc -%% Argument : N - Current node -%% Lat - Latency from current node to M -%% M - The dependent node -%% DAG - The dependence graph. Consists of both DAG and -%% predeccessors -%% Returns : A new DAG with the arc added and number of predeccessors for -%% M increased. -%% Description : Adds a new arc to the graph, if an older arc goes from N to M -%% it will be replaced with a new arc {max(OldLat, NewLat), M}. -%% Number of predeccessors for node M is increased. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -dep_arc(N, Lat, M, {Dag,Preds}) -> - OldDeps = hipe_vectors:get(Dag, N-1), - %% io:format("{OldDeps} = {~p}~n",[OldDeps]), - {NewDeps, Status} = add_arc(Lat, M, OldDeps), - %% io:format("{NewDeps, Status} = {~p, ~p}~n",[NewDeps, Status]), - NewDag = hipe_vectors:set(Dag, N-1, NewDeps), - NewPreds = case Status of - added -> % just increase preds if new arc was added - OldPreds = hipe_vectors:get(Preds, M-1), - hipe_vectors:set(Preds, M-1, OldPreds + 1); - non_added -> - Preds - end, - {NewDag, NewPreds}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_arc -%% Argument : Lat - The latency from current node to To. -%% To - The instr-id of the node which the dependence goes to -%% Arcs - The dependecies that are already in the dep-graph -%% Returns : A dependence graph sorted by To. -%% Description : A new arc that is added is sorted in the right place, and if -%% there is already an arc between nodes A and B, the one with -%% the greatest latency is chosen. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_arc(Lat,To, []) -> {[{Lat, To}], added}; -add_arc(Lat1, To, [{Lat2, To} | Arcs]) -> - {[{erlang:max(Lat1, Lat2), To} | Arcs], non_added}; -add_arc(Lat1,To1, [{Lat2, To2} | Arcs]) when To1 < To2 -> - {[{Lat1, To1}, {Lat2, To2} | Arcs], added}; -add_arc(Lat1 ,To1, [{Lat2, To2} | Arcs]) -> - {Arcs1, Status} = add_arc(Lat1, To1, Arcs), - {[{Lat2, To2} | Arcs1], Status}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% The register/data dependence DAG of a block is represented -%% as a mapping (Variable -> {NextWriter,NextReaders}) -%% where NextWriter is a pair {Ix,Type} -%% and NextReaders is a list of pairs {Ix,Type}. -%% -%% Type is used to determine latencies of operations; on the UltraSparc, -%% latencies of arcs (n -> m) are determined by both n and m. (E.g., if -%% n is an integer op and m is a store, then latency is 0; if m is an -%% integer op, it's 1.) - -dd([],DAG) -> { empty_deptab(), DAG }; -dd([{N,I}|Is],DAG0) -> - {DepTab,DAG1} = dd(Is,DAG0), - add_deps(N,I,DepTab,DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_deps -%% Argument : N - current node -%% Instr - current instr -%% DepTab - hashtable with {next-writer, next-readers} for reg -%% DAG - dependence graph -%% Returns : {DepTab, BlockInfo, DAG} - with new values -%% Description : Adds dependencies for node N to the graph. The registers that -%% node N defines and uses are used for computing the -%% dependencies to the following nodes. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_deps(N,Instr,DepTab,DAG) -> - {Ds,Us} = def_use(Instr), - Type = dd_type(Instr), - {DepTab1,DAG1} = add_write_deps(Ds,N,Type,DepTab,DAG), - add_read_deps(Us,N,Type,DepTab1,DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Instructions are classified into symbolic categories, -%% which are subsequently used to determine operation latencies -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -dd_type(Instr) -> - case Instr of - #b{} -> branch; - %% #br{} -> branch; - #call_link{} -> branch; - #jmp_link{} -> branch; - #jmp{} -> branch; - #goto{} -> branch; - #load{} -> load; - #store{} -> store; - #alu{} -> alu; - #move{} -> alu; - #multimove{} -> - Src = hipe_sparc:multimove_src(Instr), - Lat = round(length(Src)/2), - {mmove,Lat}; - #sethi{} -> alu; - #alu_cc{} -> alu_cc; - %% #cmov_cc{} -> cmov_cc; - %% #cmov_r{} -> alu; - #load_atom{} -> alu; - #load_address{} -> alu; - #pseudo_enter{} -> pseudo; - #pseudo_pop{} -> pseudo; - #pseudo_return{} -> pseudo; - #pseudo_spill{} -> pseudo; - #pseudo_unspill{} -> pseudo - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_write_deps -%% Argument : Defs - registers that node N defines. -%% N - current node -%% Ty - the type of current instr -%% DepTab - Dependence-table -%% DAG - The dependence graph. -%% Returns : {DepTab,DAG} - with new values -%% Description : Adds dependencies to the graph for nodes that depends on the -%% registers that N defines. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_write_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG}; -add_write_deps([D|Ds],N,Ty,DepTab,DAG) -> - {NewDepTab,NewDAG} = add_write_dep(D,N,Ty,DepTab,DAG), - add_write_deps(Ds,N,Ty,NewDepTab,NewDAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_write_dep -%% Description : Updates the dependence table with N as next writer, and -%% updates the DAG with the dependencies from N to subsequent -%% nodes. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_write_dep(X,N,Ty,DepTab,DAG) -> - {NxtWriter,NxtReaders} = lookup(X,DepTab), - NewDepTab = writer(X,N,Ty,DepTab), - NewDAG = write_deps(N,Ty,NxtWriter,NxtReaders,DAG), - {NewDepTab, NewDAG}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : write_deps -%% Argument : Instr - Current instr -%% Ty - Type of current instr -%% NxtWriter - The node that is the next writer of the ragister -%% that Instr defines. -%% NxtReaders - The nodes that are subsequent readers of the -%% register that N defines. -%% DAG - The dependence graph -%% Returns : Calls raw_deps that finally returns a new DAG with the new -%% dependence arcs added. -%% Description : If a next writer exists a dependence arc for this node is -%% added, and after this raw_deps is called to compute the -%% arcs for read-after-write dependencies. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -write_deps(Instr,Ty,NxtWriter,NxtReaders,DAG) -> - DAG1 = case NxtWriter of - none -> - DAG; - {Instr,_} -> - DAG; - {Wr,WrTy} -> - dep_arc(Instr, - hipe_target_machine:waw_latency(Ty,WrTy), - Wr, DAG) - end, - raw_deps(Instr,Ty,NxtReaders,DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : raw_deps -%% Argument : Instr - current instr -%% Type - type of instr -%% Readers - subsequent readers -%% DAG - dependence graph -%% Returns : DAG - A new DAG with read-after-write dependencies added -%% Description : Updates the DAG with the dependence-arcs from Instr to the -%% subsequent readers, with the appropriate latencies. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -raw_deps(_Instr,_Type,[],DAG) -> DAG; -raw_deps(Instr,Ty,[{Rd,RdTy}|Xs],DAG) -> - raw_deps(Instr,Ty,Xs, - dep_arc(Instr,hipe_target_machine:raw_latency(Ty,RdTy), - Rd,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_read_deps -%% Argument : Uses - The registers that node N uses. -%% N - Index of the current node. -%% Ty - Type of current node. -%% DepTab - Dependence table -%% DAG - Dependence graph -%% Returns : {DepTab, DAG} - with updated values. -%% Description : Adds the read dependencies from node N to subsequent ones, -%% according to the registers that N uses. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_read_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG}; -add_read_deps([U|Us],N,Ty,DepTab,DAG) -> - {NewDepTab,NewDAG} = add_read_dep(U,N,Ty,DepTab,DAG), - add_read_deps(Us,N,Ty,NewDepTab,NewDAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_read_dep -%% Argument : X - Used register -%% N - Index of checked instr -%% Ty - Type of checked instr -%% DepTab - Hashtable with {next-writer, next-readers} -%% DAG - Dependence graph -%% Returns : {DepTab, DAG} - with updated values -%% Description : Looks up what the next-writer/next-readers are, and adjusts -%% the table with current node as new reader. Finally -%% read-dependencies are added to the DAG. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_read_dep(X,N,Ty,DepTab,DAG) -> - {NxtWriter,_NxtReaders} = lookup(X,DepTab), - NewDepTab = reader(X,N,Ty,DepTab), - NewDAG = read_deps(N,Ty,NxtWriter,DAG), - {NewDepTab, NewDAG}. - -% If NxtWriter is 'none', then this var is not written subsequently -% Add WAR from Instr to NxtWriter (if it exists) -% *** UNFINISHED *** -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : read_deps -%% Argument : N - Index of current node -%% Ty - Type of current node -%% Writer - tuple {NextWriter, WrType} where NextWriter is the -%% subsequent instr that writes this register next time, -%% and WrType is the type of that instr. -%% DAG - The dependence graph -%% Returns : DAG -%% Description : Returns a new DAG if a next-writer exists, otherwise the old -%% DAG is returned. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -read_deps(_Instr,_Ty,none,DAG) -> - DAG; -read_deps(_Instr,_Ty,{_Instr,_},DAG) -> - DAG; -read_deps(Instr,Ty,{NxtWr,NxtWrTy},DAG) -> - dep_arc(Instr,hipe_target_machine:war_latency(Ty,NxtWrTy),NxtWr, - DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_deptab -%% Description : Creates an empty dependence table (hash-table) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_deptab() -> - gb_trees:empty(). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : lookup -%% Argument : X - key (register) -%% DepTab - dependence table -%% Returns : {NextWriter, NextReaders} -%% Description : Returns next writer and a list of following readers on -%% register X. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -lookup(X, DepTab) -> - case gb_trees:lookup(X, DepTab) of - none -> - {none, []}; - {value, {W, Rs} = Val} -> - Val - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : writer -%% Argument : X - key (register) -%% N - index of writer -%% Ty - type of writer -%% DepTab - dependence table to be updated -%% Returns : DepTab - new dependence table -%% Description : Sets N tobe next writer on X -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -writer(X, N, Ty, DepTab) -> - gb_trees:enter(X, {{N, Ty}, []}, DepTab). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : reader -%% Argument : X - key (register) -%% N - index of reader -%% Ty - type of reader -%% DepTab - dependence table to be updated -%% Returns : DepTab - new dependence table -%% Description : Adds N to the dependence table as a reader. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -reader(X,N,Ty,DepTab) -> - {W,Rs} = lookup(X,DepTab), - gb_trees:enter(X,{W,[{N,Ty}|Rs]},DepTab). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% The following version of md/2 separates heap- and stack operations, -%% which allows for greater reordering. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md -%% Argument : IxBB - indexed block -%% DAG - dependence graph -%% Returns : DAG - new dependence graph -%% Description : Adds arcs for load/store dependencies to the DAG. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md(IxBB, DAG) -> - md(IxBB,empty_md_state(),DAG). - -md([],_,DAG) -> DAG; -md([{N,I}|Is],St,DAG) -> - case md_type(I) of - other -> - md(Is,St,DAG); - {st,T} -> - { WAW_nodes, WAR_nodes, NewSt } = st_overlap(N,T,St), - md(Is,NewSt, - md_war_deps(WAR_nodes,N,md_waw_deps(WAW_nodes,N,DAG))); - {ld,T} -> - { RAW_nodes, NewSt } = ld_overlap(N,T,St), - md(Is,NewSt, - md_raw_deps(RAW_nodes,N,DAG)) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_war_deps -%% Argument : WAR_nodes - write-after-read nodes depending on N -%% N - index of current instr -%% DAG - dependence graph -%% Returns : DAG - updated DAG -%% Description : Adds arcs for write-after-read dependencies for N -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_war_deps([],_,DAG) -> DAG; -md_war_deps([M|Ms],N,DAG) -> - md_war_deps(Ms,N,dep_arc(M,hipe_target_machine:m_war_latency(),N,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_waw_deps -%% Argument : WAW_nodes - write-after-write nodes depending on N -%% N - index of current instr -%% DAG - dependence graph -%% Returns : DAG - updated DAG -%% Description : Adds arcs for write-after-write dependencies for N -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_waw_deps([],_,DAG) -> DAG; -md_waw_deps([M|Ms],N,DAG) -> - md_waw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_waw_latency(),N,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_raw_deps -%% Argument : RAW_nodes - read-after-write nodes depending on N -%% N - index of current instr -%% DAG - dependence graph -%% Returns : DAG - updated DAG -%% Description : Adds arcs for read-after-write dependencies for N -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_raw_deps([],_,DAG) -> DAG; -md_raw_deps([M|Ms],N,DAG) -> - md_raw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_raw_latency(),N,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_md_state -%% Description : Returns an empty memorydependence state, eg. 4 lists -%% representing {StackStores, HeapStores, StackLoads, HeapLoads} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_md_state() -> {[], [], [], []}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_type -%% Argument : I - instr -%% Description : Maps the instr-type to a simplified type, telling if it's -%% store/load resp. heap or stack. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_type(I) -> - case I of - #load{} -> - Sp = hipe_sparc_registers:stack_pointer(), - Src = hipe_sparc:load_src(I), - N = hipe_sparc:reg_nr(Src), - Off = hipe_sparc:load_off(I), - if - N =:= Sp -> % operation on stack - {ld,{sp,Off}}; - true -> - {ld,{hp,Src,Off}} - end; - #store{} -> - Sp = hipe_sparc_registers:stack_pointer(), - Dst = hipe_sparc:store_dest(I), - N = hipe_sparc:reg_nr(Dst), - Off = hipe_sparc:store_off(I), - if - N =:= Sp -> - {st,{sp,Off}}; - true -> - {st,{hp,Dst,Off}} - end; - _ -> - other - end. - -%% Given a memory operation and a 'memory op state', -%% overlap(N,MemOp,State) returns { Preceding_Dependent_Ops, NewState }. -%% which are either a tuple { WAW_deps, WAR_deps } or a list RAW_deps. -%% -%% NOTES: -%% Note that Erlang's semantics ("heap stores never overwrite existing data") -%% means we can be quite free in reordering stores to the heap. -%% Ld/St to the stack are simply handled by their offsets; since we do not -%% rename the stack pointer, this is sufficient. -%% *** We assume all memory ops have uniform size = 4 *** -%% -%% NOTES: -%% The method mentioned above has now been changed because the assumption that -%% "heap stores never overwrite existing data" caused a bug when the -%% process-pointer was treated the same way as the heap. We were also told -%% that the semantics can possibly change in the future, so it would be more -%% safe to treat the heap store/loads as the stack. -%% A future improvement can be to do an alias analysis to give more freedom -%% in reordering stuff... -%% -%% Alias state: -%% { [StackOp], [HeapOp], [StackOp], [HeapOp] } -%% where StackOp = {InstrID, Offset} -%% HeapOp = {InstrID, Reg, Offset} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : st_overlap -%% Argument : N - Index of current node -%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap -%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] } -%% where StackStrs/StackLds = {InstrID, Offset} -%% and HeapStrs/HeapLds = {InstrID, Reg, Offset} -%% Returns : { DepStrs, DepLds, State } - -%% where DepStrs/DepLds = [NodeId] -%% and State is the new state -%% Description : Adds dependencies for overlapping stores. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -st_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - {DepSt, IndepSt_Sp} = st_sp_dep(St_Sp, Off), - {DepLd, IndepLd_Sp} = ld_sp_dep(Ld_Sp, Off), - {DepSt, DepLd, {[{N, Off}|IndepSt_Sp], St_Hp, IndepLd_Sp, Ld_Hp}}; -st_overlap(N, {hp, Dst, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - DstOff = {Dst, Off}, - {DepSt,_IndepSt_Hp} = st_hp_dep(St_Hp, DstOff), - {DepLd, IndepLd_Hp} = ld_hp_dep(Ld_Hp, DstOff), - {DepSt, DepLd, {St_Sp, [{N, Dst, Off}|St_Hp], Ld_Sp, IndepLd_Hp}}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : ld_overlap -%% Argument : N - Index of current node -%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap -%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] } -%% where StackStrs/StackLds = {InstrID, Offset} -%% and HeapStrs/HeapLds = {InstrID, Reg, Offset} -%% Returns : { DepStrs, State } -%% Description : Adds dependencies for overlapping laods -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -ld_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - DepSt = sp_dep_only(St_Sp, Off), - {DepSt, {St_Sp, St_Hp, [{N, Off}|Ld_Sp], Ld_Hp}}; -ld_overlap(N, {hp, Src, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - DepSt = hp_dep_only(St_Hp, Src, Off), - {DepSt, {St_Sp, St_Hp, Ld_Sp, [{N, Src, Off}|Ld_Hp]}}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : st_sp_dep -%% Description : Adds dependencies that are depending on a stack store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -st_sp_dep(Stores, Off) -> - sp_dep(Stores, Off, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : ld_sp_dep -%% Description : Adds dependencies that are depending on a stack load -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -ld_sp_dep(Loads, Off) -> - sp_dep(Loads, Off, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : st_hp_dep -%% Description : Adds dependencies that are depending on a heap store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -st_hp_dep(Stores, {_Reg, _Off} = RegOff) -> - hp_dep(Stores, RegOff, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : ld_hp_dep -%% Description : Adds dependencies that are depending on a heap load -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -ld_hp_dep(Loads, {_Reg, _Off} = RegOff) -> - hp_dep(Loads, RegOff, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : sp_dep -%% Description : Returns {Dependent, Independent} which are lists of nodes -%% that depends or not on a stack load/store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -sp_dep([], _Off, Dep, Indep) -> {Dep, Indep}; -sp_dep([{N,Off}|Xs], Off, Dep, Indep) -> - sp_dep(Xs, Off, [N|Dep], Indep); -sp_dep([X|Xs], Off, Dep, Indep) -> - sp_dep(Xs, Off, Dep, [X|Indep]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : hp_dep -%% Description : Returns {Dependent, Independent} which are lists of nodes -%% that depends or not on a heap load/store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -hp_dep([], {_Reg,_Off}, Dep, Indep) -> {Dep,Indep}; -hp_dep([{N,Reg,Off1}|Xs], {Reg,Off}, Dep, Indep) when Off1 =/= Off -> - hp_dep(Xs, {Reg,Off}, Dep, [{N,Reg,Off1}|Indep]); -hp_dep([{N,_,_}|Xs], {Reg,Off}, Dep, Indep) -> - hp_dep(Xs, {Reg,Off}, [N|Dep], Indep). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : sp_dep_only -%% Description : Returns a list of nodes that are depending on a stack store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -sp_dep_only(Stores, Off) -> - [N || {N,Off0} <- Stores, Off =:= Off0]. - -%% Dependences from heap stores to heap loads. -%% *** UNFINISHED *** -%% - but works -%% This is somewhat subtle: -%% - a heap load can only bypass a heap store if we KNOW it won't -%% load the stored value -%% - unfortunately, we do not know the relationships between registers -%% at this point, so we can't say that store(p+4) is independent of -%% load(q+0). -%% (OR CAN WE? A bit closer reasoning might show that it's possible?) -%% - We can ONLY say that st(p+c) and ld(p+c') are independent when c /= c' -%% -%% (As said before, it might be possible to lighten this restriction?) - -hp_dep_only([], _Reg, _Off) -> []; -hp_dep_only([{_N,Reg,Off_1}|Xs], Reg, Off) when Off_1 =/= Off -> - hp_dep_only(Xs, Reg, Off); -hp_dep_only([{N,_,_}|Xs], Reg, Off) -> - [N|hp_dep_only(Xs, Reg, Off)]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Control dependences: -%% - add dependences so that -%% * branches are performed in order -%% * unsafe operations are 'fenced in' by surrounding branches -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd -%% Argument : IxBB - indexed block -%% DAG - dependence graph -%% Returns : DAG - new dependence graph -%% Description : Adds conditional dependencies to the DAG -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd(IxBB,DAG) -> - cd(IxBB, DAG, none, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd -%% Argument : IxBB - indexed block -%% DAG - dependence graph -%% PrevBr - previous branch -%% PrevUnsafe - previous unsafe instr (mem-op) -%% PrevOthers - previous other instrs, used to "fix" preceeding -%% instrs so they don't bypass a branch. -%% Returns : DAG - new dependence graph -%% Description : Adds conditional dependencies to the graph. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd([], DAG, _PrevBr, _PrevUnsafe, _PrevOthers) -> - DAG; -cd([{N,I}|Xs], DAG, PrevBr, PrevUnsafe, PrevOthers) -> - case cd_type(I) of - {branch,Ty} -> - DAG1 = cd_branch_to_other_deps(N, PrevOthers, DAG), - NewDAG = cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG1), - cd(Xs,NewDAG,{N,Ty},[],[]); - {unsafe,Ty} -> - NewDAG = cd_unsafe_deps(PrevBr,N,Ty,DAG), - cd(Xs, NewDAG, PrevBr, [{N,Ty}|PrevUnsafe], PrevOthers); - {other,_Ty} -> - cd(Xs, DAG, PrevBr, PrevUnsafe, [N|PrevOthers]) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_branch_to_other_deps -%% Argument : N - index of branch -%% Ms - list of indexes of "others" preceding instrs -%% DAG - dependence graph -%% Returns : DAG - new graph -%% Description : Makes preceding instrs fixed so they don't bypass a branch -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_branch_to_other_deps(_, [], DAG) -> - DAG; -cd_branch_to_other_deps(N, [M | Ms], DAG) -> - cd_branch_to_other_deps(N, Ms, dep_arc(M, zero_latency(), N, DAG)). - -%% Is the operation a branch, an unspeculable op or something else? - -%% Returns -%% {branch,BranchType} -%% {unsafe,OpType} -%% {other,OpType} - -%% *** UNFINISHED *** -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_type -%% Argument : I - instr -%% Description : Maps instrs to a simpler type. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_type(I) -> - case I of - #goto{} -> - {branch,uncond}; - #br{} -> - {branch,'cond'}; - #b{} -> - {branch,'cond'}; - #call_link{} -> - {branch,call}; - #jmp_link{} -> - {branch,call}; - #jmp{} -> - {branch,call}; - #load{} -> - {unsafe,load}; - #store{} -> - {unsafe,load}; - T -> - {other,T} - end. - -%% add dependences to keep order of branches + unspeculable ops: -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_branch_deps -%% Argument : PrevBr - preceeding branch -%% PrevUnsafe - preceeding unsafe ops, eg, mem-ops -%% N - current id. -%% Ty - type of current instr -%% DAG - dependence graph -%% Returns : DAG - new DAG -%% Description : Adds arcs between branches and calls deps_to_unsafe that adds -%% arcs between branches and unsafe ops. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG) -> - DAG1 = case PrevBr of - none -> - DAG; - {Br,BrTy} -> - dep_arc(Br, - hipe_target_machine:br_br_latency(BrTy,Ty), - N, DAG) - end, - deps_to_unsafe(PrevUnsafe, N, Ty, DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : deps_to_unsafe -%% Description : Adds dependencies between unsafe's and branches -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -deps_to_unsafe([], _, _, DAG) -> DAG; -deps_to_unsafe([{M,UTy}|Us], N, Ty, DAG) -> - deps_to_unsafe(Us,N,Ty, - dep_arc(M, hipe_target_machine:unsafe_to_br_latency(UTy,Ty), - N, DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_unsafe_deps -%% Description : Adds dependencies between branches and unsafe's -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_unsafe_deps(none, _, _, DAG) -> - DAG; -cd_unsafe_deps({Br,BrTy}, N, Ty, DAG) -> - dep_arc(Br, hipe_target_machine:br_to_unsafe_latency(BrTy, Ty), N, DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : def_use -%% Argument : Instr -%% Description : Returns the registers that Instr defines resp. uses as 2 lists -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -def_use(Instr) -> - {hipe_sparc:defines(Instr), hipe_sparc:uses(Instr)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : move_or_alu -%% Description : True if the instruction is a move or an alu; false otherwise -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -move_or_alu(#move{}) -> true; -move_or_alu(#alu{}) -> true; -move_or_alu(_) -> false. - -%% Debugging stuff below %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --ifdef(debug1). -debug1_stuff(Blk, DAG, IxBlk, Sch, X) -> - io:format("Blk: ~p~n",[Blk]), - io:format("DAG: ~n~p~n~p",[DAG,IxBlk]), - io:format("~n"), - print_instrs(IxBlk), - print_sch(Sch, IxBlk), - print_instrs2(X). - -print_instrs([]) -> - io:format("~n"); -print_instrs([{N,Instr} | Instrs]) -> - io:format("(~p): ",[N]), - hipe_sparc_pp:pp_instr(Instr), - io:format("~p~n",[element(1,Instr)]), - print_instrs(Instrs). - -print_instrs2([]) -> - io:format("~n"); -print_instrs2([Instr | Instrs]) -> - hipe_sparc_pp:pp_instr(Instr), - print_instrs2(Instrs). - -print_sch([],_) -> io:format("~n"); -print_sch([{{cycle,Cycle},{node,I}} | Rest], IxBlk) -> - io:format("{C~p, N~p} ",[Cycle,I]), - print_node(I, IxBlk), - print_sch(Rest, IxBlk). - -print_node(_, []) -> - io:format("~n"); -print_node(I, [{I, Instr} | _]) -> - hipe_sparc_pp:pp_instr(Instr); -print_node(I, [_ | IxBlk]) -> - print_node(I, IxBlk). --else. -debug1_stuff(_Blk, _DAG, _IxBlk, _Sch, _X) -> - ok. --endif. diff --git a/lib/hipe/opt/hipe_schedule_prio.erl b/lib/hipe/opt/hipe_schedule_prio.erl deleted file mode 100644 index 339bb82aab..0000000000 --- a/lib/hipe/opt/hipe_schedule_prio.erl +++ /dev/null @@ -1,53 +0,0 @@ -%% -*- erlang-indent-level: 2 -*- -%% -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% PRIORITY HANDLING AND PRIORITY CALCULATION -%% -%% Handling of ready nodes and priorities. -%% - at present, all nodes have the same priority and so on. -%% -%% *** UNFINISHED *** -%% - should compute a static priority estimate -%% - should dynamically modify priorities + possibly insert NOPs -%% (e.g., to separate branches, etc.) -%% - thus, ought to be passed the current schedule and/or resources as well - --module(hipe_schedule_prio). --export([init_ready/2, - init_instr_prio/2, - %% initial_ready_set/4, - next_ready/7, - add_ready_nodes/2, - insert_node/3 - ]). - -init_ready(Size,Preds) -> - hipe_ultra_prio:init_ready(Size,Preds). - -init_instr_prio(N,DAG) -> - hipe_ultra_prio:init_instr_prio(N,DAG). - -%% initial_ready_set(M,N,Preds,Ready) -> -%% hipe_ultra_prio:initial_ready_set(M,N,Preds,Ready). - -next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl) -> - hipe_ultra_prio:next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl). - -add_ready_nodes(NodeLst,Ready) -> - hipe_ultra_prio:add_ready_nodes(NodeLst,Ready). - -insert_node(C,I,Ready) -> - hipe_ultra_prio:insert_node(C,I,Ready). diff --git a/lib/hipe/opt/hipe_target_machine.erl b/lib/hipe/opt/hipe_target_machine.erl deleted file mode 100644 index 75993cb95e..0000000000 --- a/lib/hipe/opt/hipe_target_machine.erl +++ /dev/null @@ -1,87 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% INTERFACE TO TARGET MACHINE MODEL -%% -%% Interfaces the instruction scheduler to the (resource) machine model. - --module(hipe_target_machine). --export([init_resources/1, - init_instr_resources/2, - resources_available/4, - advance_cycle/1 - ]). --export([raw_latency/2, - war_latency/2, - waw_latency/2, - %% m_raw_latency/2, - %% m_war_latency/2, - %% m_waw_latency/2, - m_raw_latency/0, - m_war_latency/0, - m_waw_latency/0, - br_to_unsafe_latency/2, - unsafe_to_br_latency/2, - br_br_latency/2 - ]). - --define(target,hipe_ultra_mod2). - -init_resources(X) -> - ?target:init_resources(X). - -init_instr_resources(X,Y) -> - ?target:init_instr_resources(X,Y). - -resources_available(X,Y,Z,W) -> - ?target:resources_available(X,Y,Z,W). - -advance_cycle(X) -> - ?target:advance_cycle(X). - -raw_latency(From,To) -> - ?target:raw_latency(From,To). - -war_latency(From,To) -> - ?target:war_latency(From,To). - -waw_latency(From,To) -> - ?target:waw_latency(From,To). - -%% m_raw_latency(From,To) -> -%% ?target:m_raw_latency(From,To). - -%% m_war_latency(From,To) -> -%% ?target:m_war_latency(From,To). - -%% m_waw_latency(From,To) -> -%% ?target:m_waw_latency(From,To). - -m_raw_latency() -> - ?target:m_raw_latency(). - -m_war_latency() -> - ?target:m_war_latency(). - -m_waw_latency() -> - ?target:m_waw_latency(). - -br_to_unsafe_latency(Br,U) -> - ?target:br_to_unsafe_latency(Br,U). - -unsafe_to_br_latency(U,Br) -> - ?target:unsafe_to_br_latency(U,Br). - -br_br_latency(Br1,Br2) -> - ?target:br_br_latency(Br1,Br2). diff --git a/lib/hipe/opt/hipe_ultra_mod2.erl b/lib/hipe/opt/hipe_ultra_mod2.erl deleted file mode 100644 index cec9c56a1e..0000000000 --- a/lib/hipe/opt/hipe_ultra_mod2.erl +++ /dev/null @@ -1,233 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% ULTRASPARC MACHINE MODEL -%% -%% This module is used by the scheduler. -%% The following interface is used: -%% ... -%% -%% NOTES: -%% - the machine model is simple (on the verge of simplistic) -%% * all FUs are pipelined => model only one cycle at a time -%% * instruction latencies are mostly 1 -%% * floating point is left for later (I _think_ it works, but ...) -%% - conservative: instructions that require multiple resources are -%% modelled as 'single'; instead, they could reserve IEU+BR or whatever -%% - possibly inefficient: I think machine state model could be turned into -%% a bitvector. - --module(hipe_ultra_mod2). --export([init_resources/1, - init_instr_resources/2, - resources_available/4, - advance_cycle/1 - ]). --export([raw_latency/2, - war_latency/2, - waw_latency/2, - %% m_raw_latency/2, - %% m_war_latency/2, - %% m_waw_latency/2, - m_raw_latency/0, - m_war_latency/0, - m_waw_latency/0, - br_to_unsafe_latency/2, - unsafe_to_br_latency/2, - br_br_latency/2 - ]). - --include("../sparc/hipe_sparc.hrl"). - --define(debug(Str,Args),ok). -%-define(debug(Str,Args),io:format(Str,Args)). - --define(debug_ultra(Str,Args),ok). -%-define(debug_ultra(Str,Args),io:format(Str,Args)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Straightforward and somewhat simplistic model for UltraSparc: -%% - only one cycle at a time is modelled -%% - resources are simplified: -%% * ieu0, ieu1, ieu, mem, br, single -%% * per-cycle state = done | { I0, I1, NumI, X, Mem, Br } -%% * unoptimized representation (could be bit vector) - -init_resources(_Size) -> - ?debug_ultra('init res ~p~n',[_Size]), - empty_state(). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -init_instr_resources(N,Nodes) -> - ultra_instr_rsrcs(Nodes,hipe_vectors:new(N, '')). - -ultra_instr_rsrcs([],I_res) -> I_res; -ultra_instr_rsrcs([N|Ns],I_res) -> - ultra_instr_rsrcs(Ns,ultra_instr_type(N,I_res)). - -ultra_instr_type({N,I},I_res) -> - hipe_vectors:set(I_res,N-1,instr_type(I)). - -instr_type(I) -> - case I of - #move{} -> - ieu; - #multimove{} -> %% TODO: expand multimoves before scheduling - ieu; - #alu{} -> - case hipe_sparc:alu_operator(I) of - '>>' -> ieu0; - '<<' -> ieu0; - _ -> ieu - end; - #alu_cc{} -> - ieu1; - #sethi{} -> - ieu; - #load{} -> - mem; - #store{} -> - mem; - #b{} -> - br; - #br{} -> - br; - #goto{} -> - br; - #jmp_link{} -> % imprecise; should be mem+br? - single; - #jmp{} -> % imprecise - br; - #call_link{} -> % imprecise; should be mem+br? - single; - #cmov_cc{} -> % imprecise - single; - #cmov_r{} -> % imprecise - single; - #load_atom{} -> % should be resolved to sethi/or - single; - #load_address{} -> % should be resolved to sethi/or - single; - #load_word_index{} -> % should be resolved to sethi/or - single; - %% uncommon types: - #label{} -> - none; - #nop{} -> - none; - #comment{} -> - none; - _ -> - exit({ultrasparc_instr_type,{cant_schedule,I}}) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -resources_available(_Cycle, I, Rsrc, I_res) -> - res_avail(instruction_resource(I_res, I), Rsrc). - -instruction_resource(I_res, I) -> - hipe_vectors:get(I_res, I-1). - -%% The following function checks resource availability. -%% * all function units are assumed to be fully pipelined, so only -%% one cycle at a time is modelled. -%% * for IEU0 and IEU1, these must precede all generic IEU instructions -%% (handled by X bit) -%% * at most 2 integer instructions can issue in a cycle -%% * mem is straightforward -%% * br closes the cycle (= returns done). -%% * single requires an entirely empty state and closes the cycle - -res_avail(ieu0, { free, I1, NumI, free, Mem, Br }) - when is_integer(NumI), NumI < 2 -> - { yes, { occ, I1, NumI+1, free, Mem, Br }}; -res_avail(ieu1, { _I0, free, NumI, free, Mem, Br }) - when is_integer(NumI), NumI < 2 -> - { yes, { free, occ, NumI+1, free, Mem, Br }}; -res_avail(ieu, { I0, I1, NumI, _X, Mem, Br }) - when is_integer(NumI), NumI < 2 -> - { yes, { I0, I1, NumI+1, occ, Mem, Br }}; -res_avail(mem, { I0, I1, NumI, X, free, Br }) -> - { yes, { I0, I1, NumI, X, occ, Br }}; -res_avail(br, { _I0, _I1, _NumI, _X, _Mem, free }) -> - { yes, done }; -res_avail(single, { free, free, 0, free, free, free }) -> - { yes, done }; -res_avail(_, _) -> - no. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -advance_cycle(_Rsrc) -> - empty_state(). - -empty_state() -> { free, free, 0, free, free, free }. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Latencies are taken from UltraSparc hardware manual -%% -%% *** UNFINISHED *** -%% more precisely, they are taken from my memory of the US-manual -%% at the moment. -%% -%% Note: all ld/st are assumed to hit in the L1 cache (D-cache), -%% which is sort of imprecise. - -raw_latency(alu, store) -> 0; -raw_latency(load, _) -> 2; % only if load is L1 hit -raw_latency(alu_cc, b) -> 0; -raw_latency(_I0, _I1) -> - 1. - -war_latency(_I0, _I1) -> - 0. - -waw_latency(_I0, _I1) -> - 1. - -%% *** UNFINISHED *** -%% At present, all load/stores are assumed to hit in the L1 cache, -%% which isn't really satisfying. - -%% m_raw_latency(_St, _Ld) -> -%% 1. -%% -%% m_war_latency(_Ld, _St) -> -%% 1. -%% -%% m_waw_latency(_St1, _St2) -> -%% 1. - -%% Use these for 'default latencies' = do not permit reordering. - -m_raw_latency() -> - 1. - -m_war_latency() -> - 1. - -m_waw_latency() -> - 1. - -br_to_unsafe_latency(_BrTy, _UTy) -> - 0. - -unsafe_to_br_latency(_UTy, _BrTy) -> - 0. - -br_br_latency(_BrTy1, _BrTy2) -> - 0. diff --git a/lib/hipe/opt/hipe_ultra_prio.erl b/lib/hipe/opt/hipe_ultra_prio.erl deleted file mode 100644 index 6dd240a33a..0000000000 --- a/lib/hipe/opt/hipe_ultra_prio.erl +++ /dev/null @@ -1,298 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% PRIORITY HANDLING AND PRIORITY CALCULATION -%% -%% Handling of ready nodes and priorities. -%% Priorities are mainly from the critical path. More priorities are added. -%% * One version is adding priorities just depending on the instr, so -%% for example loads get higher priority than stores, and ordered -%% after reg's and offset for better cache performance. -%% * The other version gives higher priority to a node that adds more new -%% nodes to the ready list. This one is maybe not so effectively -%% implemented, but was added too late for smarter solutions. -%% One version is commented away - --module(hipe_ultra_prio). --export([init_ready/2, - init_instr_prio/2, - %% initial_ready_set/4, - next_ready/7, - add_ready_nodes/2, - insert_node/3 - ]). - --include("../sparc/hipe_sparc.hrl"). - -% At first, only nodes with no predecessors are selected. -% - if R is empty, there is an error (unless BB itself is empty) - -%% Arguments : Size - size of ready-array -%% Preds - array with number of predecessors for each node -%% Returns : An array with list of ready-nodes for each cycle. - -init_ready(Size, Preds) -> - P = hipe_vectors:size(Preds), - Ready = hipe_vectors:new(Size, []), - R = initial_ready_set(1, P, Preds, []), - hipe_vectors:set(Ready, 0, R). - -init_instr_prio(N, DAG) -> - critical_path(N, DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : initial_ready_set -%% Argument : M - current node-index -%% N - where to stop -%% Preds - array with number of predecessors for each node -%% Ready - list with ready-nodes -%% Returns : Ready - list with ready-nodes -%% Description : Finds all nodes with no predecessors and adds them to ready. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -initial_ready_set(M, N, Preds, Ready) -> - if - M > N -> - Ready; - true -> - case hipe_vectors:get(Preds, M-1) of - 0 -> - initial_ready_set(M+1, N, Preds, [M|Ready]); - V when is_integer(V), V > 0 -> - initial_ready_set(M+1, N, Preds, Ready) - end - end. - -%% The following handles the nodes ready to schedule: -%% 1. select the ready queue of given cycle -%% 2. if queue empty, return none -%% 3. otherwise, remove entry with highest priority -%% and return {next,Highest_Prio,NewReady} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : next_ready -%% Argument : C - current cycle -%% Ready - array with ready nodes -%% Prio - array with cpath-priorities for all nodes -%% Nodes - indexed list [{N, Instr}] -%% Returns : none / {next,Highest_Prio,NewReady} -%% Description : 1. select the ready queue of given cycle -%% 2. if queue empty, return none -%% 3. otherwise, remove entry with highest priority -%% and return {next,Highest_Prio,NewReady} where Highest_Prio -%% = Id of instr and NewReady = updated ready-array. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -next_ready(C, Ready, Prio, Nodes, DAG, Preds, Earl) -> - Curr = hipe_vectors:get(Ready, C-1), - case Curr of - [] -> - none; - Instrs -> - {BestI,RestIs} = - get_best_instr(Instrs, Prio, Nodes, DAG, Preds, Earl, C), - {next,BestI,hipe_vectors:set(Ready,C-1,RestIs)} - end. - -% next_ready(C,Ready,Prio,Nodes) -> -% Curr = hipe_vectors:get(Ready,C-1), -% case Curr of -% [] -> -% none; -% Instrs -> -% {BestInstr,RestInstrs} = get_best_instr(Instrs, Prio, Nodes), -% {next,BestInstr,hipe_vectors:set(Ready,C-1,RestInstrs)} -% end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_best_instr -%% Argument : Instrs - list of node-id's -%% Prio - array with cpath-priorities for the nodes -%% Nodes - indexed list [{Id, Instr}] -%% Returns : {BestSoFar, Rest} - Id of best instr and the rest of id's -%% Description : Returns the id of the instr that is the best choice. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -get_best_instr([Instr|Instrs], Prio, Nodes, DAG, Preds, Earl, C) -> - get_best_instr(Instrs, [], Instr, Prio, Nodes, DAG, Preds, Earl, C). - -get_best_instr([], Rest, BestSoFar, _Prio, _Nodes, _DAG, _Preds, _Earl, _C) -> - {BestSoFar, Rest}; -get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes, - DAG, Preds, Earl, C) -> - case better(Instr, BestSoFar, Prio, Nodes, DAG, Preds, Earl, C) of - true -> - get_best_instr(Instrs, [BestSoFar|PassedInstrs], - Instr, Prio, Nodes, DAG, Preds, Earl, C); - false -> - get_best_instr(Instrs, [Instr|PassedInstrs], BestSoFar, Prio, - Nodes, DAG, Preds, Earl, C) - end. - -% get_best_instr([Instr|Instrs], Prio, Nodes) -> -% get_best_instr(Instrs, [], Instr, Prio, Nodes). - -% get_best_instr([], Rest, BestSoFar, Prio, Nodes) -> {BestSoFar, Rest}; -% get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes) -> -% case better(Instr, BestSoFar, Prio, Nodes) of -% true -> -% get_best_instr(Instrs, [BestSoFar|PassedInstrs], -% Instr, Prio, Nodes); -% false -> -% get_best_instr(Instrs, [Instr|PassedInstrs],BestSoFar, Prio, Nodes) -% end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : better -%% Argument : Instr1 - Id of instr 1 -%% Instr2 - Id of instr 2 -%% Prio - array with cpath-priorities for the nodes -%% Nodes - indexed list [{Id, Instr}] -%% Returns : true if Instr1 has higher priority than Instr2 -%% Description : Checks if Instr1 is a better choice than Instr2 for scheduling -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -better(Instr1, Instr2, Prio, Nodes, DAG, Preds, Earl, C) -> - better_hlp(priority(Instr1, Prio, Nodes, DAG, Preds, Earl, C), - priority(Instr2, Prio, Nodes, DAG, Preds, Earl, C)). - -better_hlp([], []) -> false; -better_hlp([], [_|_]) -> false; -better_hlp([_|_], []) -> true; -better_hlp([X|Xs], [Y|Ys]) -> (X > Y) or ((X =:= Y) and better_hlp(Xs,Ys)). - -%% -%% Returns the instr corresponding to id -%% -get_instr(InstrId, [{InstrId,Instr}|_]) -> Instr; -get_instr(InstrId, [_|Xs]) -> get_instr(InstrId, Xs). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : priority -%% Argument : InstrId - Id -%% Prio - array with cpath-priorities for the nodes -%% Nodes - indexed list [{Id, Instr}] -%% Returns : PrioList - list of priorities [MostSignificant, LessSign, ...] -%% Description : Returns a list of priorities where the first element is the -%% cpath-priority and the rest are added depending on what kind -%% of instr it is. Used to order loads/stores sequentially and -%% there is possibility to add whatever stuff... -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -priority(InstrId, Prio, Nodes, DAG, Preds, Earl, C) -> - {ReadyNodes,_,_,_} = hipe_schedule:delete_node(C,InstrId,DAG,Preds,Earl), - Instr = get_instr(InstrId, Nodes), - Prio1 = hipe_vectors:get(Prio, InstrId-1), - Prio2 = length(ReadyNodes), - PrioRest = - case Instr of - #load_atom{} -> - [3]; - #move{} -> - [3]; - #load{} -> - Src = hipe_sparc:load_src(Instr), - Off = hipe_sparc:load_off(Instr), - case hipe_sparc:is_reg(Off) of - false -> [3, - -(hipe_sparc:reg_nr(Src)), - -(hipe_sparc:imm_value(Off))]; - true -> [1] - end; - #store{} -> - Src = hipe_sparc:store_dest(Instr), - Off = hipe_sparc:store_off(Instr), - case hipe_sparc:is_reg(Off) of - false -> [2, - -(hipe_sparc:reg_nr(Src)), - -(hipe_sparc:imm_value(Off))]; - true -> [1] - end; - _ -> [0] - end, - [Prio1,Prio2|PrioRest]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_ready_nodes -%% Argument : Nodes - list of [{Cycle,Id}] -%% Ready - array of ready nodes for all cycles -%% Returns : NewReady - updated ready-array -%% Description : Gets a list of instrs and adds them to the ready-array -%% to the corresponding cycle. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -add_ready_nodes([], Ready) -> Ready; -add_ready_nodes([{C,I}|Xs], Ready) -> - add_ready_nodes(Xs, insert_node(C, I, Ready)). - -insert_node(C, I, Ready) -> - Old = hipe_vectors:get(Ready, C-1), - hipe_vectors:set(Ready, C-1, [I|Old]). - -%% -%% Computes the latency for the "most expensive" way through the graph -%% for all nodes. Returns an array of priorities for all nodes. -%% -critical_path(N, DAG) -> - critical_path(1, N, DAG, hipe_vectors:new(N, -1)). - -critical_path(M, N, DAG, Prio) -> - if - M > N -> - Prio; - true -> - critical_path(M+1, N, DAG, cpath(M, DAG, Prio)) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cpath -%% Argument : M - current node id -%% DAG - the dependence graph -%% Prio - array of priorities for all nodes -%% Returns : Prio - updated prio array -%% Description : If node has prio -1, it has not been visited -%% - otherwise, compute priority as max of priorities of -%% successors (+ latency) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -cpath(M, DAG, Prio) -> - InitPrio = hipe_vectors:get(Prio, M-1), - if - InitPrio =:= -1 -> - cpath_node(M, DAG, Prio); - true -> - Prio - end. - -cpath_node(N, DAG, Prio) -> - SuccL = dag_succ(DAG, N), - {Max, NewPrio} = cpath_succ(SuccL, DAG, Prio), - hipe_vectors:set(NewPrio, N-1, Max). - -cpath_succ(SuccL, DAG, Prio) -> - cpath_succ(SuccL, DAG, Prio, 0). - -%% performs an unnecessary lookup of priority of Succ, but that might -%% not be such a big deal - -cpath_succ([], _DAG, Prio, NodePrio) -> {NodePrio,Prio}; -cpath_succ([{Lat,Succ}|Xs], DAG, Prio, NodePrio) -> - NewPrio = cpath(Succ, DAG, Prio), - NewNodePrio = erlang:max(hipe_vectors:get(NewPrio, Succ - 1) + Lat, NodePrio), - cpath_succ(Xs, DAG, NewPrio, NewNodePrio). - -dag_succ(DAG, N) when is_integer(N) -> - hipe_vectors:get(DAG, N-1). - diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 544888719f..efeb0887ab 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -7,7 +7,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ hipe_SUITE \ - opt_verify_SUITE + opt_verify_SUITE \ + erl_types_SUITE # .erl files for these modules are automatically generated GEN_MODULES= \ diff --git a/lib/hipe/test/erl_types_SUITE.erl b/lib/hipe/test/erl_types_SUITE.erl new file mode 100644 index 0000000000..7d7c144b69 --- /dev/null +++ b/lib/hipe/test/erl_types_SUITE.erl @@ -0,0 +1,197 @@ +%% -*- erlang-indent-level: 4 -*- +%% +%% 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. +%% +-module(erl_types_SUITE). + +-export([all/0, + consistency_and_to_string/1]). + +%% Simplify calls into erl_types and avoid importing the entire module. +-define(M, erl_types). + +-include_lib("common_test/include/ct.hrl"). + +all() -> + [consistency_and_to_string]. + +consistency_and_to_string(_Config) -> + %% Check consistency of types + Atom1 = ?M:t_atom(), + Atom2 = ?M:t_atom(foo), + Atom3 = ?M:t_atom(bar), + true = ?M:t_is_atom(Atom2), + + True = ?M:t_atom(true), + False = ?M:t_atom(false), + Bool = ?M:t_boolean(), + true = ?M:t_is_boolean(True), + true = ?M:t_is_boolean(Bool), + false = ?M:t_is_boolean(Atom1), + + Binary = ?M:t_binary(), + true = ?M:t_is_binary(Binary), + + Bitstr = ?M:t_bitstr(), + true = ?M:t_is_bitstr(Bitstr), + + Bitstr1 = ?M:t_bitstr(7, 3), + true = ?M:t_is_bitstr(Bitstr1), + false = ?M:t_is_binary(Bitstr1), + + Bitstr2 = ?M:t_bitstr(16, 8), + true = ?M:t_is_bitstr(Bitstr2), + true = ?M:t_is_binary(Bitstr2), + + BitStr816 = ?M:t_bitstr(8,16), + BitStr816 = ?M:t_subtract(?M:t_bitstr(4, 12), ?M:t_bitstr(8, 12)), + + Int1 = ?M:t_integer(), + Int2 = ?M:t_integer(1), + Int3 = ?M:t_integer(16#ffffffff), + true = ?M:t_is_integer(Int2), + true = ?M:t_is_byte(Int2), + false = ?M:t_is_byte(Int3), + false = ?M:t_is_byte(?M:t_from_range(-1, 1)), + true = ?M:t_is_byte(?M:t_from_range(1, 255)), + + Tuple1 = ?M:t_tuple(), + Tuple2 = ?M:t_tuple(3), + Tuple3 = ?M:t_tuple([Atom1, Int1]), + Tuple4 = ?M:t_tuple([Tuple1, Tuple2]), + Tuple5 = ?M:t_tuple([Tuple3, Tuple4]), + Tuple6 = ?M:t_limit(Tuple5, 2), + Tuple7 = ?M:t_limit(Tuple5, 3), + true = ?M:t_is_tuple(Tuple1), + + Port = ?M:t_port(), + Pid = ?M:t_pid(), + Ref = ?M:t_reference(), + Identifier = ?M:t_identifier(), + false = ?M:t_is_reference(Port), + true = ?M:t_is_identifier(Port), + + Function1 = ?M:t_fun(), + Function2 = ?M:t_fun(Pid), + Function3 = ?M:t_fun([], Pid), + Function4 = ?M:t_fun([Port, Pid], Pid), + Function5 = ?M:t_fun([Pid, Atom1], Int2), + true = ?M:t_is_fun(Function3), + + List1 = ?M:t_list(), + List2 = ?M:t_list(?M:t_boolean()), + List3 = ?M:t_cons(?M:t_boolean(), List2), + List4 = ?M:t_cons(?M:t_boolean(), ?M:t_atom()), + List5 = ?M:t_cons(?M:t_boolean(), ?M:t_nil()), + List6 = ?M:t_cons_tl(List5), + List7 = ?M:t_sup(List4, List5), + List8 = ?M:t_inf(List7, ?M:t_list()), + List9 = ?M:t_cons(), + List10 = ?M:t_cons_tl(List9), + true = ?M:t_is_boolean(?M:t_cons_hd(List5)), + true = ?M:t_is_list(List5), + false = ?M:t_is_list(List4), + + Product1 = ?M:t_product([Atom1, Atom2]), + Product2 = ?M:t_product([Atom3, Atom1]), + Product3 = ?M:t_product([Atom3, Atom2]), + + Union1 = ?M:t_sup(Atom2, Atom3), + Union2 = ?M:t_sup(Tuple2, Tuple3), + Union3 = ?M:t_sup(Int2, Atom3), + Union4 = ?M:t_sup(Port, Pid), + Union5 = ?M:t_sup(Union4, Int1), + Union6 = ?M:t_sup(Function1, Function2), + Union7 = ?M:t_sup(Function4, Function5), + Union8 = ?M:t_sup(True, False), + true = ?M:t_is_boolean(Union8), + Union9 = ?M:t_sup(Int2, ?M:t_integer(2)), + true = ?M:t_is_byte(Union9), + Union10 = ?M:t_sup(?M:t_tuple([?M:t_atom(true), ?M:t_any()]), + ?M:t_tuple([?M:t_atom(false), ?M:t_any()])), + + Any = ?M:t_any(), + Any = ?M:t_sup(Product3, Function5), + + Atom3 = ?M:t_inf(Union3, Atom1), + Union2 = ?M:t_inf(Union2, Tuple1), + Int2 = ?M:t_inf(Int1, Union3), + Union4 = ?M:t_inf(Union4, Identifier), + Port = ?M:t_inf(Union5, Port), + Function4 = ?M:t_inf(Union7, Function4), + None = ?M:t_none(), + None = ?M:t_inf(Product2, Atom1), + Product3 = ?M:t_inf(Product1, Product2), + Function5 = ?M:t_inf(Union7, Function5), + true = ?M:t_is_byte(?M:t_inf(Union9, ?M:t_number())), + true = ?M:t_is_char(?M:t_inf(Union9, ?M:t_number())), + + RecDict = #{{record, foo} => {{?FILE, ?LINE}, [{2, [{bar, [], ?M:t_any()}, + {baz, [], ?M:t_any()}]}]}}, + Record1 = ?M:t_from_term({foo, [1,2], {1,2,3}}), + + %% Check string representations + "atom()" = ?M:t_to_string(Atom1), + "'foo'" = ?M:t_to_string(Atom2), + "'bar'" = ?M:t_to_string(Atom3), + + "binary()" = ?M:t_to_string(Binary), + + "integer()" = ?M:t_to_string(Int1), + "1" = ?M:t_to_string(Int2), + + "tuple()" = ?M:t_to_string(Tuple1), + "{_,_,_}" = ?M:t_to_string(Tuple2), + "{atom(),integer()}" = ?M:t_to_string(Tuple3), + "{tuple(),{_,_,_}}" = ?M:t_to_string(Tuple4), + "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple5), + "{{_,_},{_,_}}" = ?M:t_to_string(Tuple6), + "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple7), + + "reference()" = ?M:t_to_string(Ref), + "port()" = ?M:t_to_string(Port), + "pid()" = ?M:t_to_string(Pid), + "identifier()" = ?M:t_to_string(Identifier), + + "[any()]" = ?M:t_to_string(List1), + "[boolean()]" = ?M:t_to_string(List2), + "[boolean(),...]" = ?M:t_to_string(List3), + "nonempty_improper_list(boolean(),atom())" = ?M:t_to_string(List4), + "[boolean(),...]" = ?M:t_to_string(List5), + "[boolean()]" = ?M:t_to_string(List6), + "nonempty_maybe_improper_list(boolean(),atom() | [])" = ?M:t_to_string(List7), + "[boolean(),...]" = ?M:t_to_string(List8), + "nonempty_maybe_improper_list()" = ?M:t_to_string(List9), + "any()" = ?M:t_to_string(List10), + + "fun()" = ?M:t_to_string(Function1), + "fun((...) -> pid())" = ?M:t_to_string(Function2), + "fun(() -> pid())" = ?M:t_to_string(Function3), + "fun((port(),pid()) -> pid())" = ?M:t_to_string(Function4), + "fun((pid(),atom()) -> 1)" = ?M:t_to_string(Function5), + + "<atom(),'foo'>" = ?M:t_to_string(Product1), + "<'bar',atom()>" = ?M:t_to_string(Product2), + + "#foo{bar::[1 | 2,...],baz::{1,2,3}}" = ?M:t_to_string(Record1, RecDict), + + "'bar' | 'foo'" = ?M:t_to_string(Union1), + "{atom(),integer()} | {_,_,_}" = ?M:t_to_string(Union2), + "'bar' | 1" = ?M:t_to_string(Union3), + "pid() | port()" = ?M:t_to_string(Union4), + "pid() | port() | integer()" = ?M:t_to_string(Union5), + "fun()" = ?M:t_to_string(Union6), + "fun((pid() | port(),atom() | pid()) -> pid() | 1)" = ?M:t_to_string(Union7), + "boolean()" = ?M:t_to_string(Union8), + "{'false',_} | {'true',_}" = ?M:t_to_string(Union10), + "{'true',integer()}" = ?M:t_to_string(?M:t_inf(Union10, ?M:t_tuple([?M:t_atom(true), ?M:t_integer()]))). diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index dfe773e7fe..5b34018def 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -104,5 +104,5 @@ %% If the "new" ssl is used then 'crypto' must be started before inets. {applications,[kernel,stdlib]}, {mod,{inets_app,[]}}, - {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","runtime_tools-1.8.14", + {runtime_dependencies, ["stdlib-3.5","ssl-5.3.4","runtime_tools-1.8.14", "mnesia-4.12","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 554d675383..f96d946a5d 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -226,7 +226,7 @@ <p>This configuration parameter is used both for the global logger level, and for the standard handler started by the Kernel application (see <c>logger_dest</c> variable above).</p> - <p>The default value is <c>info</c></p> + <p>The default value is <c>info</c>.</p> </item> <tag><marker id="disk_log_vars"/> <c>logger_disk_log_type = halt | wrap</c></tag> @@ -251,14 +251,14 @@ logger_disk_log_maxbytes = 1048576</code> <item> <p>If this parameter is set to true, then the logger handler started by kernel will not log any progress-, crash-, or - supervisor reports. If the SASL application is starated, + supervisor reports. If the SASL application is started, these log events will be sent to a second handler instance - named sasl_h, according to values of the SASL environment - variables <c>sasl_error_logger</c> + named <c>sasl_h</c>, according to values of the SASL + environment variables <c>sasl_error_logger</c> and <c>sasl_errlog_type</c>, see <seealso marker="sasl:sasl_app#configuration">SASL(6) </seealso></p> - <p>The default value is <c>false</c></p> + <p>The default value is <c>false</c>.</p> <p>See chapter <seealso marker="logger_chapter#compatibility">Backwards compatibility with error_logger</seealso> for more information about handling of the so called SASL reports.</p> @@ -271,7 +271,7 @@ logger_disk_log_maxbytes = 1048576</code> reports from <c>supervisor</c> and <c>application_controller</c> shall be logged or not.</p> - <p>If <c>logger_sasl_compatible = false</c>, + <p>If <c>logger_sasl_compatible = true</c>, then <c>logger_log_progress</c> is ignored.</p> </item> <tag><marker id="logger_format_depth"/> @@ -280,14 +280,6 @@ logger_disk_log_maxbytes = 1048576</code> <p>Can be used to limit the size of the formatted output from the logger handlers.</p> - <note><p>This configuration parameter was introduced in OTP 18.1 - and is experimental. Based on user feedback, it - can be changed or improved in future releases, for example, - to gain better control over how to limit the size of the - formatted output. We have no plans to remove this - new feature entirely, unless it turns out to be - useless.</p></note> - <p><c>Depth</c> is a positive integer representing the maximum depth to which terms are printed by the logger handlers included in OTP. This @@ -312,11 +304,11 @@ logger_disk_log_maxbytes = 1048576</code> </item> <tag><c>logger_max_size = integer() | unlimited</c></tag> <item> - <p>This parameter specifies the maximum size (bytes) each - log event can have when printed by the standard logger - handler. If the resulting string after formatting an event - is bigger than this, it will be truncated before printed - to the handler's destination.</p> + <p>This parameter specifies a hard maximum size limit (number + of characters) each log event can have when printed by the + default logger formatter. If the resulting string after + formatting an event is bigger than this, it will be + truncated before printed to the handler's destination.</p> </item> <tag><c>logger_utc = boolean()</c></tag> <item> diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml index 66e6e5c689..2f7feb5eef 100644 --- a/lib/kernel/doc/src/logger.xml +++ b/lib/kernel/doc/src/logger.xml @@ -131,8 +131,8 @@ <code> #{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY}, - file=>?FILE, - line=>?LINE} + file=>?FILE, + line=>?LINE} </code> <p>The call is wrapped in a case statement and will be evaluated @@ -297,7 +297,7 @@ <tag>print</tag> <item>Pretty print all the current logger configuration to standard out. Example: - <code><![CDATA[1> logger:i(). + <code><![CDATA[1> logger:i(print). Current logger configuration: Level: info FilterDefault: log @@ -404,21 +404,55 @@ Current logger configuration: <func> <name name="set_logger_config" arity="1"/> + <fsummary>Set configuration data for the logger.</fsummary> + <desc> + <p>Set configuration data for the logger. This overwrites the + current logger configuration.</p> + <p>To modify the existing configuration, + use <seealso marker="#set_logger_config-2"><c>set_logger_config/2</c> + </seealso>, or read the current configuration + with <seealso marker="#get_logger_config-0"><c>get_logger_config/0</c> + </seealso>, then merge in your added or updated + associations before writing it back.</p> + </desc> + </func> + + <func> <name name="set_logger_config" arity="2"/> <fsummary>Add or update configuration data for the logger.</fsummary> <desc> - <p>Add or update configuration data for the logger.</p> + <p>Add or update configuration data for the logger. If the + given <c><anno>Key</anno></c> already exists, its associated + value will be set to <c><anno>Value</anno></c>. If it + doesn't exist, it will be added.</p> </desc> </func> <func> <name name="set_handler_config" arity="2"/> + <fsummary>Set configuration data for the specified handler.</fsummary> + <desc> + <p>Set configuration data for the specified handler. This + overwrites the current handler configuration.</p> + <p>To modify the existing configuration, + use <seealso marker="#set_handler_config-3"><c>set_handler_config/3</c> + </seealso>, or read the current configuration + with <seealso marker="#get_handler_config-1"><c>get_handler_config/1</c> + </seealso>, then merge in your added or updated + associations before writing it back.</p> + </desc> + </func> + + <func> <name name="set_handler_config" arity="3"/> <fsummary>Add or update configuration data for the specified handler.</fsummary> <desc> <p>Add or update configuration data for the specified - handler.</p> + handler. If the + given <c><anno>Key</anno></c> already exists, its associated + value will be set to <c><anno>Value</anno></c>. If it + doesn't exist, it will be added.</p> </desc> </func> @@ -437,10 +471,9 @@ Current logger configuration: <name name="set_process_metadata" arity="1"/> <fsummary>Set metadata to use when logging from current process.</fsummary> <desc> - <p>Set metadata which <c>logger</c> automatically inserts it - in all log events produced on the current - process. Subsequent calls will overwrite previous data set - by this function.</p> + <p>Set metadata which <c>logger</c> automatically inserts in + all log events produced on the current process. Subsequent + calls will overwrite previous data set by this function.</p> <p>When logging, location data produced by the log macros, and/or metadata given as argument to the log call (API function or macro), will be merged with the process @@ -452,6 +485,21 @@ Current logger configuration: </func> <func> + <name name="update_process_metadata" arity="1"/> + <fsummary>Update metadata to use when logging from current process.</fsummary> + <desc> + <p>Update metadata to use when logging from current process</p> + <p>This function behaves as if it was implemented as follows:</p> + <code type="erl"> +logger:set_process_metadata(maps:merge(logger:get_process_metadata(),Meta)) + </code> + <p>If no process metadata exists, the function behaves as + <seealso marker="#set_process_metadata-1"><c>set_process_metadata/1</c> + </seealso>.</p> + </desc> + </func> + + <func> <name name="get_process_metadata" arity="0"/> <fsummary>Retrieve data set with set_process_metadata/1.</fsummary> <desc> diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml index 0bc3b37476..519df2ba48 100644 --- a/lib/kernel/doc/src/logger_chapter.xml +++ b/lib/kernel/doc/src/logger_chapter.xml @@ -157,7 +157,7 @@ <p>A formatter is defined as a module exporting the following function:</p> - <code>format(Log,Extra) -> string()</code> + <code>format(Log,Extra) -> unicode:chardata()</code> <p>The formatter plugin is called by each handler, and the returned string can be printed to the handler's destination @@ -322,19 +322,6 @@ return <c>ignore</c>.</p> <p>Default is <c>log</c>.</p> </item> - <tag><c>depth = pos_integer() | unlimited</c></tag> - <item> - <p>Specifies if the depth of terms in the log events shall - be limited by using control characters <c>~P</c> - and <c>~W</c> instead of <c>~p</c> and <c>~w</c>, - respectively. See - <seealso marker="stdlib:io#format-1"><c>io:format</c></seealso>.</p> - </item> - <tag><c>max_size = pos_integer() | unlimited</c></tag> - <item> - <p>Specifies if the size of a log event shall be limited by - truncating the formatted string.</p> - </item> <tag><c>formatter = {Module::module(),Extra::term()}</c></tag> <item> <p>See <seealso marker="#Formatter">Formatter</seealso> for more @@ -347,10 +334,9 @@ <p>Note that <c>level</c> and <c>filters</c> are obeyed by Logger itself before forwarding the log events to each - handler, while <c>depth</c>, <c>max_size</c> - and <c>formatter</c> are left to the handler - implementation. All Logger's built-in handlers do apply these - configuration parameters before printing.</p> + handler, while <c>formatter</c> is left to the handler + implementation. All Logger's built-in handlers will call the + given formatter before printing.</p> </section> </section> @@ -488,8 +474,9 @@ error_logger:add_report_handler/1,2. level => debug} 2> <input>logger:add_handler(debug_handler,logger_std_h,Config).</input> ok</pre> - <p>By default, the handler receives all events, so we need to add a filter - to stop all non-debug events:</p> + <p>By default, the handler receives all events + (<c>filter_defalt=log</c>), so we need to add a filter to stop + all non-debug events:</p> <pre> 3> <input>Fun = fun(#{level:=debug}=Log,_) -> Log; (_,_) -> stop end.</input> #Fun<erl_eval.12.98642416> @@ -516,7 +503,7 @@ ok</pre> <p>It may also implement the following callbacks:</p> <code> adding_handler(logger:handler_id(),logger:config()) -> {ok,logger:config()} | {error,term()} -removing_handler(logger:handler_id()) -> ok +removing_handler(logger:handler_id(),logger:config()) -> ok changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logger:config()} | {error,term()} </code> <p>When logger:add_handler(Id,Module,Config) is called, logger @@ -526,7 +513,7 @@ changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logg events as calls to Module:log/2.</p> <p>A handler can be removed by calling logger:remove_handler(Id). logger will call - Module:removing_handler(Id), and then remove the handler's + Module:removing_handler(Id,Config), and then remove the handler's configuration from the configuration database.</p> <p>When logger:set_handler_config is called, logger calls Module:changing_config(Id,OldConfig,NewConfig). If this function @@ -539,19 +526,15 @@ changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logg -module(myhandler). -export([log/2]). -log(#{msg:={report,R}},_) -> - io:format("~p~n",[R]); -log(#{msg:={string,S}},_) -> - io:put_chars(S); -log(#{msg:={F,A}},_) -> - io:format(F,A). +log(Log,#{formatter:={FModule,FConfig}) -> + io:put_chars(FModule:format(Log,FConfig)). </code> <p>A simple handler which prints to file could be implemented like this:</p> <code> -module(myhandler). --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([init/1, handle_call/3, handle_cast/2, terminate/2]). adding_handler(Id,Config) -> @@ -562,18 +545,13 @@ removing_handler(Id,#{myhandler_fd:=Fd}) -> _ = file:close(Fd), ok. -log(#{msg:={report,R}},#{myhandler_fd:=Fd}) -> - io:format(Fd,"~p~n",[R]); -log(#{msg:={string,S}},#{myhandler_fd:=Fd}) -> - io:put_chars(Fd,S); -log(#{msg:={F,A}},#{myhandler_fd:=Fd}) -> - io:format(Fd,F,A). +log(Log,#{myhandler_fd:=Fd,formatter:={FModule,FConfig}}) -> + io:put_chars(Fd,FModule:format(Log,FConfig)). </code> - <p>Note that none of the above handlers have any overload + <note><p>The above handlers do not have any overload protection, and all log events are printed directly from the - client process. Neither do the handlers use the formatter or - in any way add time or other metadata to the printed events.</p> + client process.</p></note> <p>For examples of overload protection, please refer to the implementation @@ -582,17 +560,10 @@ log(#{msg:={F,A}},#{myhandler_fd:=Fd}) -> </seealso>.</p> <p>Below is a simpler example of a handler which logs through one - single process, and uses the default formatter to gain a common - look of the log events.</p> - <p>It also uses the metadata field <c>report_cb</c>, if it exists, - to print reports in the way the event issuer suggests. The - formatter will normally do this, but if the handler either has - an own default (as in this example) or if the - given <c>report_cb</c> should not be used at all, then the - handler must take care of this itself.</p> + single process.</p> <code> -module(myhandler). --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([init/1, handle_call/3, handle_cast/2, terminate/2]). adding_handler(Id,Config) -> @@ -620,16 +591,9 @@ terminate(Reason,#{fd:=Fd}) -> _ = file:close(Fd), ok. -do_log(Fd,#{msg:={report,R}} = Log, Config) -> - Fun = maps:get(report_cb,Config,fun my_report_cb/1, - {F,A} = Fun(R), - do_log(Fd,Log#{msg=>{F,A},Config); do_log(Fd,Log,#{formatter:={FModule,FConfig}}) -> String = FModule:format(Log,FConfig), io:put_chars(Fd,String). - -my_report_cb(R) -> - {"~p",[R]}. </code> </section> diff --git a/lib/kernel/doc/src/logger_formatter.xml b/lib/kernel/doc/src/logger_formatter.xml index 6a17e3641f..a0940100ee 100644 --- a/lib/kernel/doc/src/logger_formatter.xml +++ b/lib/kernel/doc/src/logger_formatter.xml @@ -37,116 +37,157 @@ <description> <p>Default formatter for the Logger application.</p> - </description> - - <datatypes> - <datatype> - <name name="template"/> - <desc> - </desc> - </datatype> - </datatypes> - - <funcs> - <func> - <name name="format" arity="2"/> - <fsummary>Formats the given message.</fsummary> - <desc> - <p>Formats the given message.</p> - <p>The template is a list of atoms, tuples and strings. Atoms - can be <c>level</c> or <c>msg</c>, which are placeholders - for the severity level and the log message, - repectively. Tuples are interpreted as placeholders for - metadata. Each element in the tuple must be an atom which - matches a key in the nested metadata map, e.g. the - tuple <c>{key1,key2}</c> will be replaced by the value of - the key2 field in this nested map (the value vill be - converted to a string):</p> - -<code> -#{key1=>#{key2=>my_value, - ...}, - ...}</code> - - - <p> Strings are printed literally.</p> - - <p><c>depth</c> is a positive integer representing the maximum - depth to which terms shall be printed by this - formatter. Format strings passed to this formatter are - rewritten. The format controls ~p and ~w are replaced with - ~P and ~W, respectively, and the value is used as the depth - parameter. For details, see - <seealso marker="stdlib:io#format-2">io:format/2,3</seealso> - in STDLIB.</p> - - <p><c>chars_limit</c> is a positive integer representing the - value of the option with the same name to be used when calling - <seealso marker="stdlib:io#format-3">io:format/3</seealso>. This - value limits the total number of characters printed bu the - formatter. Notes that this is a soft limit. For a hard - truncation limit, see option <c>max_size</c>.</p> - - <p><c>max_size</c> is a positive integer representing the - maximum size a string returned from this formatter can - have. If the formatted string is longer, after possibly - being limited by <c>depth</c> and/or <c>chars_limit</c>, it - will be truncated.</p> - - <p><c>utc</c> is a boolean. If set to true, all dates are - displayed in Universal Coordinated Time. Default - is <c>false</c>.</p> - <p><c>report_cb</c> must be a function with arity 1, - returning <c>{Format,Args}</c>. This function will replace - any <c>report_cb</c> found in metadata.</p> - - <p>If <c>single_line=true</c>, all newlines in the message are - replaced with <c>", "</c>, and whitespaces following directly - after newlines are removed. Note that newlines added by the - formatter template are not replaced.</p> + </description> - <p>If <c>legacy_header=true</c> a header field is added to + <section> + <title>Configuration</title> + <p>The following configuration parameters can be set + for <c>logger_formatter</c>:</p> + <taglist> + <tag><c>single_line = boolean()</c></tag> + <item> + <p>If set to <c>true</c>, all newlines in the message are + replaced with <c>", "</c>, and whitespaces following + directly after newlines are removed. Note that newlines + added by the formatter template are not replaced.</p> + <p>Default is <c>true</c>.</p> + </item> + <tag><c>legacy_header = boolen()</c></tag> + <item> + <p>If set to <c>true</c> a header field is added to logger_formatter's part of <c>Metadata</c>. The value of this field is a string similar to the header created by the old <c>error_logger</c> event handlers. It can be included in the log event by adding the - tuple <c>{logger_formatter,header}</c> to the template.</p> - - <p>The default template when <c>legacy_header=true</c> is</p> - - <code>[{logger_formatter,header},"\n",msg,"\n"]</code> + tuple <c>{logger_formatter,header}</c> to the + template. See <seealso marker="#default_templates">Default + Templates</seealso> for more information</p> + <p>Default is <c>false</c>.</p> + </item> + <tag><c>report_cb = fun((logger:report()) -> {io:format(),[term()]})</c></tag> + <item> + <p>A function with arity 1, + returning <c>{Format,Args}</c>. This function will replace + any <c>report_cb</c> found in metadata.</p> + </item> + <tag><c>depth = pos_integer() | unlimited</c></tag> + <item> + <p>A positive integer representing the maximum depth to + which terms shall be printed by this formatter. Format + strings passed to this formatter are rewritten. The format + controls ~p and ~w are replaced with ~P and ~W, + respectively, and the value is used as the depth + parameter. For details, see + <seealso marker="stdlib:io#format-2">io:format/2,3</seealso> + in STDLIB.</p> + <p>Default is <c>unlimited</c>.</p> + </item> + <tag><c>chars_limit = pos_integer() | unlimited</c></tag> + <item> + <p>A positive integer representing the value of the option + with the same name to be used when calling + <seealso marker="stdlib:io_lib#format-3">io_lib:format/3</seealso>. + This value limits the total number of characters printed + for each log event. Note that this is a soft limit. For a + hard truncation limit, see option <c>max_size</c>.</p> + <p>Default is <c>unlimited</c>.</p> + </item> + <tag><c>max_size = pos_integer() | unlimited</c></tag> + <item> + <p>A positive integer representing the absolute maximum size + a string returned from this formatter can have. If the + formatted string is longer, after possibly being limited + by <c>depth</c> and/or <c>chars_limit</c>, it will be + truncated.</p> + <p>Default is <c>unlimited</c>.</p> + </item> + <tag><c>template = </c><seealso marker="#type-template"><c>template()</c></seealso></tag> + <item> + <p>The template is a list of atoms, tuples and strings. The + atoms <c>level</c> or <c>msg</c>, are treated as + placeholders for the severity level and the log message, + repectively. Other atoms or tuples are interpreted as + placeholders for metadata, where atoms are expected to + match top level keys, and tuples represent paths to sub + keys in a nested map. For example the + tuple <c>{key1,key2}</c> will be replaced by the value of + the <c>key2</c> field in the nested map below. The + atom <c>key1</c> on its own would be replaced by the + complete value of the <c>key1</c> field. The values are + converted to strings.</p> - <p>which will cause log entries like this:</p> +<code> +#{key1=>#{key2=>my_value, + ...} + ...}</code> - <code>=ERROR REPORT==== 29-Dec-2017::13:30:51.245123 === + <p>Strings are printed literally.</p> + <p>The default template differs depending on the values + of <c>legacy_header</c> + and <c>single_line</c>. See <seealso marker="#default_templates">Default + Templates</seealso> for more information</p> + </item> + <tag><c>utc = boolean()</c></tag> + <item> + <p>If set to <c>true</c>, all dates are displayed in Universal + Coordinated Time. Default is <c>false</c>.</p> + </item> + </taglist> + </section> + + <section> + <marker id="default_templates"/> + <title>Default templates</title> + <p>The default template when <c>legacy_header=true</c> is</p> + + <code>[{logger_formatter,header},"\n",msg,"\n"]</code> + + <p>which will cause log entries like this:</p> + + <code>=ERROR REPORT==== 29-Dec-2017::13:30:51.245123 === process: <0.74.0> exit_reason: "Something went wrong"</code> - <p>Note that all eight levels might occur here, not - only <c>ERROR</c>, <c>WARNING</c> or <c>INFO</c>. And also - that micro seconds are added at the end of the - timestamp.</p> + <p>Note that all eight levels might occur here, not + only <c>ERROR</c>, <c>WARNING</c> or <c>INFO</c>. And also that + micro seconds are added at the end of the timestamp.</p> - <p>The default template when <c>single_line=true</c> is</p> + <p>The default template when <c>single_line=true</c> is</p> - <code>[time," ",level,": ",msg,"\n"]</code> + <code>[time," ",level,": ",msg,"\n"]</code> - <p>which will cause log entries like this:</p> + <p>which will cause log entries like this:</p> - <code>2017-12-29 13:31:49.640317 error: process: <0.74.0>, exit_reason: "Something went wrong"</code> + <code>2017-12-29 13:31:49.640317 error: process: <0.74.0>, exit_reason: "Something went wrong"</code> - <p>The default template when both <c>legacy_header</c> and - <c>single_line</c> are set to false is:</p> + <p>The default template when both <c>legacy_header</c> and + <c>single_line</c> are set to false is:</p> - <code>[time," ",level,":\n",msg,"\n"]</code> + <code>[time," ",level,":\n",msg,"\n"]</code> - <p>which will cause log entries like this:</p> + <p>which will cause log entries like this:</p> - <code>2017-12-29 13:32:25.191925 error: + <code>2017-12-29 13:32:25.191925 error: process: <0.74.0> exit_reason: "Something went wrong"</code> + </section> + + <datatypes> + <datatype> + <name name="template"/> + <desc> + </desc> + </datatype> + </datatypes> + <funcs> + <func> + <name name="format" arity="2"/> + <fsummary>Formats the given message.</fsummary> + <desc> + <p>This the callback function to be called from handlers. It + formats the given messages.</p> </desc> </func> diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 702845512c..eeb8c6ab2f 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -146,7 +146,7 @@ HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ ../include/net_address.hrl ../include/logger.hrl INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ - erl_epmd.hrl hipe_ext_format.hrl \ + erl_epmd.hrl file_int.hrl hipe_ext_format.hrl \ inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ inet_dns_record_adts.hrl \ diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index 0706220a94..47d0ca5ea3 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -32,7 +32,7 @@ which_report_handlers/0]). %% logger callbacks --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([get_format_depth/0, limit_term/1]). @@ -111,8 +111,8 @@ adding_handler(?MODULE,Config) -> Error end. --spec removing_handler(logger:handler_id()) -> ok. -removing_handler(?MODULE) -> +-spec removing_handler(logger:handler_id(),logger:config()) -> ok. +removing_handler(?MODULE,_Config) -> stop(), ok. diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index fd06f0f7d8..5704cc79c2 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -453,7 +453,7 @@ make_beam_stub(Mod, LoaderState, MD5, Beam, FunDefs, ClosuresToPatch) -> %%======================================================================== %% Patching %% @spec patch(refs(), BaseAddress::integer(), ConstAndZone::term(), -%% FunDefs::term(), TrampolineMap::term()) -> 'ok'. +%% FunDefs::term(), TrampolineMap::term()) -> 'ok' %% @type refs()=[{RefType::integer(), Reflist::reflist()} | refs()] %% %% @type reflist()= [{Data::term(), Offsets::offests()}|reflist()] diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl index 943ef8c2d1..5562764204 100644 --- a/lib/kernel/src/logger.erl +++ b/lib/kernel/src/logger.erl @@ -44,8 +44,8 @@ %% Misc -export([compare_levels/2]). --export([set_process_metadata/1, unset_process_metadata/0, - get_process_metadata/0]). +-export([set_process_metadata/1, update_process_metadata/1, + unset_process_metadata/0, get_process_metadata/0]). -export([i/0, i/1]). -export([setup_standard_handler/0, replace_simple_handler/3]). -export([limit_term/1, get_format_depth/0, get_max_size/0, get_utc_config/0]). @@ -390,6 +390,19 @@ set_process_metadata(Meta) when is_map(Meta) -> set_process_metadata(Meta) -> erlang:error(badarg,[Meta]). +-spec update_process_metadata(Meta) -> ok when + Meta :: metadata(). +update_process_metadata(Meta) when is_map(Meta) -> + case get_process_metadata() of + undefined -> + set_process_metadata(Meta); + Meta0 when is_map(Meta0) -> + set_process_metadata(maps:merge(Meta0,Meta)), + ok + end; +update_process_metadata(Meta) -> + erlang:error(badarg,[Meta]). + -spec get_process_metadata() -> Meta | undefined when Meta :: metadata(). get_process_metadata() -> diff --git a/lib/kernel/src/logger_disk_log_h.erl b/lib/kernel/src/logger_disk_log_h.erl index 3b71f936d8..0150fa781a 100644 --- a/lib/kernel/src/logger_disk_log_h.erl +++ b/lib/kernel/src/logger_disk_log_h.erl @@ -34,7 +34,7 @@ %% logger callbacks -export([log/2, - adding_handler/2, removing_handler/1, + adding_handler/2, removing_handler/2, changing_config/3, swap_buffer/2]). %%%=================================================================== @@ -223,7 +223,7 @@ check_my_config([]) -> %%%----------------------------------------------------------------- %%% Handler being removed -removing_handler(Name) -> +removing_handler(Name, _Config) -> stop(Name). %%%----------------------------------------------------------------- diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl index 386e7832e2..8e954f8d98 100644 --- a/lib/kernel/src/logger_formatter.erl +++ b/lib/kernel/src/logger_formatter.erl @@ -29,7 +29,7 @@ %%%----------------------------------------------------------------- %%% API --spec format(Log,Config) -> String when +-spec format(Log,Config) -> unicode:chardata() when Log :: logger:log(), Config :: #{single_line=>boolean(), legacy_header=>boolean(), @@ -38,8 +38,7 @@ max_size=>pos_integer() | unlimited, depth=>pos_integer() | unlimited, template=>template(), - utc=>boolean()}, - String :: string(). + utc=>boolean()}. format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0) when is_map(Config0) -> Config = add_default_config(Config0), @@ -263,7 +262,7 @@ utcstr(_) -> "". add_default_config(#{utc:=_}=Config0) -> Default = #{legacy_header=>false, - single_line=>false, + single_line=>true, chars_limit=>unlimited}, MaxSize = get_max_size(maps:get(max_size,Config0,false)), Depth = get_depth(maps:get(depth,Config0,false)), diff --git a/lib/kernel/src/logger_internal.hrl b/lib/kernel/src/logger_internal.hrl index 82df499c2b..8c0fc2725d 100644 --- a/lib/kernel/src/logger_internal.hrl +++ b/lib/kernel/src/logger_internal.hrl @@ -31,6 +31,7 @@ {no_domain,{fun logger_filters:domain/2,{log,no_domain,[]}}}]). -define(DEFAULT_FORMATTER,logger_formatter). -define(DEFAULT_FORMAT_CONFIG,#{legacy_header=>true, + single_line=>false, template=>?DEFAULT_FORMAT_TEMPLATE_HEADER}). -define(DEFAULT_FORMAT_TEMPLATE_HEADER, [{logger_formatter,header},"\n",msg,"\n"]). diff --git a/lib/kernel/src/logger_server.erl b/lib/kernel/src/logger_server.erl index 6ef3b8582a..a7f302ac8f 100644 --- a/lib/kernel/src/logger_server.erl +++ b/lib/kernel/src/logger_server.erl @@ -158,7 +158,7 @@ handle_call({remove_handler,HandlerId}, _From, #state{tid=Tid}=State) -> Handlers0 = maps:get(handlers,Config,[]), Handlers = lists:delete(HandlerId,Handlers0), %% inform the handler - _ = call_h(Module,removing_handler,[HandlerId],ok), + _ = call_h(Module,removing_handler,[HandlerId,Config],ok), do_set_config(Tid,logger,Config#{handlers=>Handlers}), logger_config:delete(Tid,HandlerId), ok; @@ -234,7 +234,13 @@ handle_info({log,Level,Report,Meta}, State) -> {noreply, State}; handle_info({Ref,_Reply},State) when is_reference(Ref) -> %% Assuming this is a timed-out gen_server reply - ignoring - {noreply, State}. + {noreply, State}; +handle_info(Unexpected,State) -> + ?LOG_INTERNAL(debug, + [{logger,got_unexpected_message}, + {process,?SERVER}, + {message,Unexpected}]), + {noreply,State}. terminate(_Reason, _State) -> ok. diff --git a/lib/kernel/src/logger_simple.erl b/lib/kernel/src/logger_simple.erl index 23ff6ccd2e..a1b427b96c 100644 --- a/lib/kernel/src/logger_simple.erl +++ b/lib/kernel/src/logger_simple.erl @@ -19,7 +19,7 @@ %% -module(logger_simple). --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([get_buffer/0]). %% This module implements a simple handler for logger. It is the @@ -63,7 +63,7 @@ adding_handler(?MODULE,Config) -> {error,{handler_process_name_already_exists,?MODULE}} end. -removing_handler(?MODULE) -> +removing_handler(?MODULE,_Config) -> case whereis(?MODULE) of undefined -> ok; diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl index cbc9db372c..31edcfea8b 100644 --- a/lib/kernel/src/logger_std_h.erl +++ b/lib/kernel/src/logger_std_h.erl @@ -35,7 +35,7 @@ terminate/2, code_change/3]). %% logger callbacks --export([log/2, adding_handler/2, removing_handler/1, +-export([log/2, adding_handler/2, removing_handler/2, changing_config/3, swap_buffer/2]). %%%=================================================================== @@ -207,7 +207,7 @@ check_my_config([]) -> %%%----------------------------------------------------------------- %%% Handler being removed -removing_handler(Name) -> +removing_handler(Name,_Config) -> stop(Name). %%%----------------------------------------------------------------- diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 45032faf6d..22db24de5f 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -346,9 +346,16 @@ clear_cmd(Config) when is_list(Config) -> get_cmd(Config) when is_list(Config) -> {ok, Node} = start_check(slave, ?UNIQ_NODE_NAME), - Cmd = "test", - ok = rpc:call(Node, heart, set_cmd, [Cmd]), - {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), + + ShortCmd = "test", + ok = rpc:call(Node, heart, set_cmd, [ShortCmd]), + {ok, ShortCmd} = rpc:call(Node, heart, get_cmd, []), + + %% This would hang prior to OTP-15024 being fixed. + LongCmd = [$a || _ <- lists:seq(1, 160)], + ok = rpc:call(Node, heart, set_cmd, [LongCmd]), + {ok, LongCmd} = rpc:call(Node, heart, get_cmd, []), + stop_node(Node), ok. diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl index 0edce3e34c..f311a9c7ed 100644 --- a/lib/kernel/test/logger_SUITE.erl +++ b/lib/kernel/test/logger_SUITE.erl @@ -666,6 +666,9 @@ process_metadata(_Config) -> check_logged(info,S3,#{time=>Time,line=>0,custom=>func}), ProcMeta = logger:get_process_metadata(), + ok = logger:update_process_metadata(#{custom=>changed,custom2=>added}), + Expected = ProcMeta#{custom:=changed,custom2=>added}, + Expected = logger:get_process_metadata(), ok = logger:unset_process_metadata(), undefined = logger:get_process_metadata(), @@ -720,7 +723,7 @@ check_maps(Expected,Got,What) -> adding_handler(_Id,Config) -> maybe_send(add), {ok,Config}. -removing_handler(_Id) -> +removing_handler(_Id,_Config) -> maybe_send(remove), ok. changing_config(_Id,_Old,#{call:=Fun}) -> diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl index c7c6137380..63e5b56021 100644 --- a/lib/kernel/test/logger_disk_log_h_SUITE.erl +++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl @@ -497,24 +497,19 @@ disk_log_sync(Config) -> filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]), formatter=>{?MODULE,nl}}), - start_tracer([{?MODULE,format,2}, - {disk_log,blog,2}, + start_tracer([{disk_log,blog,2}, {disk_log,sync,1}], - [{formatter,"first"}, - {disk_log,blog}, + [{disk_log,blog,<<"first\n">>}, {disk_log,sync}]), logger:info("first", ?domain), %% wait for automatic disk_log_sync check_tracer(?FILESYNC_REPEAT_INTERVAL*2), - start_tracer([{?MODULE,format,2}, - {disk_log,blog,2}, + start_tracer([{disk_log,blog,2}, {disk_log,sync,1}], - [{formatter,"second"}, - {formatter,"third"}, - {disk_log,blog}, - {disk_log,blog}, + [{disk_log,blog,<<"second\n">>}, + {disk_log,blog,<<"third\n">>}, {disk_log,sync}]), %% two log requests in fast succession will make the handler skip %% an automatic disk log sync @@ -531,13 +526,10 @@ disk_log_sync(Config) -> no_repeat = maps:get(filesync_repeat_interval, logger_disk_log_h:info(?MODULE)), - start_tracer([{?MODULE,format,2}, - {disk_log,blog,2}, + start_tracer([{disk_log,blog,2}, {disk_log,sync,1}], - [{formatter,"fourth"}, - {disk_log,blog}, - {formatter,"fifth"}, - {disk_log,blog}, + [{disk_log,blog,<<"fourth\n">>}, + {disk_log,blog,<<"fifth\n">>}, {disk_log,sync}]), logger:info("fourth", ?domain), @@ -566,6 +558,7 @@ disk_log_sync(Config) -> check_tracer(100), ok. disk_log_sync(cleanup,_Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). disk_log_wrap(Config) -> @@ -623,6 +616,7 @@ disk_log_wrap(Config) -> ok. disk_log_wrap(cleanup,_Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). disk_log_full(Config) -> @@ -668,6 +662,7 @@ disk_log_full(Config) -> {trace,{error_status,{error,{full,_}}}}] = Received, ok. disk_log_full(cleanup, _Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). disk_log_events(Config) -> @@ -713,6 +708,7 @@ disk_log_events(Config) -> end, Received), ok. disk_log_events(cleanup, _Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). write_failure(Config) -> @@ -763,7 +759,7 @@ sync_failure(Config) -> Dir = ?config(priv_dir, Config), FileName = lists:concat([?MODULE,"_",?FUNCTION_NAME]), File = filename:join(Dir, FileName), - Log = lists:concat([File,".1"]), + Node = start_h_on_new_node(Config, ?FUNCTION_NAME, File), false = (undefined == rpc:call(Node, ets, whereis, [?TEST_HOOKS_TAB])), @@ -832,10 +828,10 @@ log_on_remote_node(Node,Msg) -> ok. %% functions for test hook macros to be called by rpc -set_internal_log(Mod, Func) -> - ?set_internal_log({Mod,Func}). -set_result(Op, Result) -> - ?set_result(Op, Result). +set_internal_log(_Mod, _Func) -> + ?set_internal_log({_Mod,_Func}). +set_result(_Op, _Result) -> + ?set_result(_Op, _Result). set_defaults() -> ?set_defaults(). @@ -885,7 +881,7 @@ op_switch_to_drop(cleanup, _Config) -> ok = stop_handler(?MODULE). op_switch_to_flush() -> - [{timetrap,{seconds,60}}]. + [{timetrap,{minutes,3}}]. op_switch_to_flush(Config) -> {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), @@ -988,7 +984,7 @@ kill_disabled(cleanup, _Config) -> ok = stop_handler(?MODULE). qlen_kill_new(Config) -> - {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), + {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), Pid0 = whereis(?MODULE), {_,Mem0} = process_info(Pid0, memory), RestartAfter = 2000, @@ -1025,7 +1021,7 @@ qlen_kill_new(cleanup, _Config) -> ok = stop_handler(?MODULE). mem_kill_new(Config) -> - {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), + {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), Pid0 = whereis(?MODULE), {_,Mem0} = process_info(Pid0, memory), RestartAfter = 2000, @@ -1111,7 +1107,7 @@ restart_after(cleanup, _Config) -> %% during high load to verify that sync, dropping and flushing is %% handled correctly. handler_requests_under_load() -> - [{timetrap,{seconds,60}}]. + [{timetrap,{minutes,3}}]. handler_requests_under_load(Config) -> {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), NewHConfig = @@ -1140,7 +1136,7 @@ handler_requests_under_load(Config) -> NoOfReqs = lists:foldl(fun({_,Res}, N) -> N + length(Res) end, 0, ReqResult), ct:pal("~w requests made. Errors: ~n~p", [NoOfReqs,Errors]), ok = file:delete(Log). -handler_requests_under_load(cleanup, Config) -> +handler_requests_under_load(cleanup, _Config) -> ok = stop_handler(?MODULE). send_requests(HName, TO, Reqs = [{Req,Res}|Rs]) -> @@ -1369,7 +1365,6 @@ start_tracer(Trace,Expected) -> Pid = self(), dbg:tracer(process,{fun tracer/2,{Pid,Expected}}), dbg:p(whereis(?MODULE),[c]), - dbg:p(Pid,[c]), tpl(Trace), ok. @@ -1387,13 +1382,14 @@ tpl([{M,F,A}|Trace]) -> tpl([]) -> ok. -tracer({trace,_,call,{?MODULE,format,[#{msg:={string,Msg}}|_]}}, {Pid,[{formatter,Msg}|Expected]}) -> - maybe_tracer_done(Pid,Expected,{formatter,Msg}); tracer({trace,_,call,{logger_disk_log_h,handle_cast,[{Op,_}|_]}}, {Pid,[{Mod,Func,Op}|Expected]}) -> maybe_tracer_done(Pid,Expected,{Mod,Func,Op}); +tracer({trace,_,call,{Mod=disk_log,Func=blog,[_,Data]}}, {Pid,[{Mod,Func,Data}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func,Data}); tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) -> maybe_tracer_done(Pid,Expected,{Mod,Func}); tracer({trace,_,call,Call}, {Pid,Expected}) -> + ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]), Pid ! {tracer_got_unexpected,Call,Expected}, {Pid,Expected}. @@ -1413,5 +1409,6 @@ check_tracer(T) -> dbg:stop_clear(), ct:fail({tracer_got_unexpected,Got,Expected}) after T -> + dbg:stop_clear(), ct:fail({timeout,tracer}) end. diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl index ac1abba629..7d1f33746d 100644 --- a/lib/kernel/test/logger_formatter_SUITE.erl +++ b/lib/kernel/test/logger_formatter_SUITE.erl @@ -73,18 +73,19 @@ all() -> default(_Config) -> String1 = format(info,{"~p",[term]},#{},#{}), ct:log(String1), - [_Date,_Time,"info:\nterm\n"] = string:lexemes(String1," "), + [_Date,_Time,"info:","term\n"] = string:lexemes(String1," "), Time = timestamp(), ExpectedTimestamp = default_time_format(Time), String2 = format(info,{"~p",[term]},#{time=>Time},#{}), ct:log(String2), - " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp), + " info: term\n" = string:prefix(String2,ExpectedTimestamp), ok. legacy_header(_Config) -> Time = timestamp(), - String1 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>true}), + String1 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>true, + single_line=>false}), ct:log(String1), "=INFO REPORT==== "++Rest = String1, [Timestamp,"\nterm\n"] = string:lexemes(Rest," ="), @@ -98,12 +99,14 @@ legacy_header(_Config) -> true = lists:member(M,["Jan","Feb","Mar","Apr","May","Jun", "Jul","Aug","Sep","Oct","Nov","Dec"]), - String2 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>false}), + String2 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>false, + single_line=>false}), ct:log(String2), ExpectedTimestamp = default_time_format(Time), " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp), - String3 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>bad}), + String3 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>bad, + single_line=>false}), ct:log(String3), String3 = String2, @@ -114,7 +117,8 @@ legacy_header(_Config) -> String4 = String1, String5 = format(info,{"~p",[term]},#{}, % <--- no time - #{legacy_header=>true}), + #{legacy_header=>true, + single_line=>false}), ct:log(String5), "=INFO REPORT==== "++_ = String5, ok. @@ -289,38 +293,36 @@ report_cb(_Config) -> ok. max_size(_Config) -> - Template = [msg], + Cfg = #{template=>[msg], + single_line=>false}, "12345678901234567890" = - format(info,{"12345678901234567890",[]},#{},#{template=>Template}), + format(info,{"12345678901234567890",[]},#{},Cfg), application:set_env(kernel,logger_max_size,11), "12345678901234567890" = % min value is 50, so this is not limited - format(info,{"12345678901234567890",[]},#{},#{template=>Template}), + format(info,{"12345678901234567890",[]},#{},Cfg), "12345678901234567890123456789012345678901234567..." = % 50 format(info, {"123456789012345678901234567890123456789012345678901234567890", []}, #{}, - #{template=>Template}), + Cfg), application:set_env(kernel,logger_max_size,53), "12345678901234567890123456789012345678901234567890..." = %53 format(info, {"123456789012345678901234567890123456789012345678901234567890", []}, #{}, - #{template=>Template}), + Cfg), "123456789012..." = - format(info,{"12345678901234567890",[]},#{},#{template=>Template, - max_size=>15}), + format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>15}), "12345678901234567890" = - format(info,{"12345678901234567890",[]},#{},#{template=>Template, - max_size=>unlimited}), + format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>unlimited}), %% Check that one newline at the end of the line is kept (if it exists) "12345678901...\n" = - format(info,{"12345678901234567890\n",[]},#{},#{template=>Template, - max_size=>15}), + format(info,{"12345678901234567890\n",[]},#{},Cfg#{max_size=>15}), "12345678901...\n" = - format(info,{"12345678901234567890",[]},#{},#{template=>[msg,"\n"], - max_size=>15}), + format(info,{"12345678901234567890",[]},#{},Cfg#{template=>[msg,"\n"], + max_size=>15}), ok. max_size(cleanup,_Config) -> application:unset_env(kernel,logger_max_size), @@ -441,20 +443,20 @@ format_time(_Config) -> ExpectedTimestamp1 = default_time_format(Time1), String1 = format(info,{"~p",[term]},#{time=>Time1},#{}), ct:log(String1), - " info:\nterm\n" = string:prefix(String1,ExpectedTimestamp1), + " info: term\n" = string:prefix(String1,ExpectedTimestamp1), Time2 = timestamp(), ExpectedTimestamp2 = default_time_format(Time2,true), String2 = format(info,{"~p",[term]},#{time=>Time2},#{utc=>true}), ct:log(String2), - " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp2), + " info: term\n" = string:prefix(String2,ExpectedTimestamp2), application:set_env(kernel,logger_utc,true), Time3 = timestamp(), ExpectedTimestamp3 = default_time_format(Time3,true), String3 = format(info,{"~p",[term]},#{time=>Time3},#{}), ct:log(String3), - " info:\nterm\n" = string:prefix(String3,ExpectedTimestamp3), + " info: term\n" = string:prefix(String3,ExpectedTimestamp3), ok. diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index e940e0a026..7c8d63cbbd 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -499,86 +499,79 @@ filesync(Config) -> #{logger_std_h => #{type => Type}, filter_default=>log, filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]), - formatter=>{?MODULE,self()}}), - Tester = self(), - TraceFun = fun({trace,_,call,{Mod,Func,Details}}, Pid) -> - Pid ! {trace,Mod,Func,Details}, - Pid; - ({trace,TPid,'receive',Received}, Pid) -> - Pid ! {trace,TPid,Received}, - Pid - end, - {ok,_} = dbg:tracer(process, {TraceFun, Tester}), - FileCtrlPid = maps:get(file_ctrl_pid , logger_std_h:info(?MODULE)), - {ok,_} = dbg:p(FileCtrlPid, [c]), - {ok,_} = dbg:tpl(logger_std_h, write_to_dev, 5, []), - {ok,_} = dbg:tpl(logger_std_h, sync_dev, 4, []), - {ok,_} = dbg:tp(file, datasync, 1, []), + formatter=>{?MODULE,nl}}), + + %% check repeated filesync happens + start_tracer([{logger_std_h, write_to_dev, 5}, + {logger_std_h, sync_dev, 4}, + {file, datasync, 1}], + [{logger_std_h, write_to_dev, <<"first\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}]), logger:info("first", ?domain), %% wait for automatic filesync - timer:sleep(?FILESYNC_REP_INT), - Expected1 = [{log,"first"}, {trace,logger_std_h,write_to_dev}, - {trace,logger_std_h,sync_dev}, {trace,file,datasync}], - + check_tracer(?FILESYNC_REP_INT*2), + + %% check that explicit filesync is only done once + start_tracer([{logger_std_h, write_to_dev, 5}, + {logger_std_h, sync_dev, 4}, + {file, datasync, 1}], + [{logger_std_h, write_to_dev, <<"second\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}, + {no_more,500} + ]), logger:info("second", ?domain), %% do explicit filesync logger_std_h:filesync(?MODULE), %% a second filesync should be ignored logger_std_h:filesync(?MODULE), - Expected2 = [{log,"second"}, {trace,logger_std_h,write_to_dev}, - {trace,logger_std_h,sync_dev}, {trace,file,datasync}], + check_tracer(100), %% check that if there's no repeated filesync active, %% a filesync is still performed when handler goes idle logger:set_handler_config(?MODULE, logger_std_h, #{filesync_repeat_interval => no_repeat}), no_repeat = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)), + %% The following timer is to make sure the time from last log + %% ("second") to next ("third") is long enough, so the a flush is + %% triggered by the idle timeout between "thrid" and "fourth". + timer:sleep(?IDLE_DETECT_TIME_MSEC*2), + start_tracer([{logger_std_h, write_to_dev, 5}, + {logger_std_h, sync_dev, 4}, + {file, datasync, 1}], + [{logger_std_h, write_to_dev, <<"third\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}, + {logger_std_h, write_to_dev, <<"fourth\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}]), logger:info("third", ?domain), + %% wait for automatic filesync timer:sleep(?IDLE_DETECT_TIME_MSEC*2), logger:info("fourth", ?domain), %% wait for automatic filesync - timer:sleep(?IDLE_DETECT_TIME_MSEC*2), - Expected3 = [{log,"third"}, {trace,logger_std_h,write_to_dev}, - {log,"fourth"}, {trace,logger_std_h,write_to_dev}, - {trace,logger_std_h,sync_dev}, {trace,file,datasync}], - - dbg:stop_clear(), - - %% verify that filesync has been performed as expected - Received1 = lists:map(fun({trace,M,F,_}) -> {trace,M,F}; - (Other) -> Other - end, test_server:messages_get()), - ct:pal("Trace #1 =~n~p", [Received1]), - Received1 = Expected1 ++ Expected2 ++ Expected3, - - try_read_file(Log, {ok,<<"first\nsecond\nthird\nfourth\n">>}, 1000), - - {ok,_} = dbg:tracer(process, {TraceFun, Tester}), - {ok,_} = dbg:p(whereis(?MODULE), [c]), - {ok,_} = dbg:tpl(logger_std_h, handle_cast, 2, []), + check_tracer(?IDLE_DETECT_TIME_MSEC*2), %% switch repeated filesync on and verify that the looping works SyncInt = 1000, WaitT = 4500, + OneSync = {logger_std_h,handle_cast,repeated_filesync}, + %% receive 1 initial repeated_filesync, then 1 per sec + start_tracer([{logger_std_h,handle_cast,2}], + [OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]), + logger:set_handler_config(?MODULE, logger_std_h, #{filesync_repeat_interval => SyncInt}), SyncInt = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)), timer:sleep(WaitT), logger:set_handler_config(?MODULE, logger_std_h, - #{filesync_repeat_interval => no_repeat}), - dbg:stop_clear(), - - Received2 = lists:map(fun({trace,_M,handle_cast,[{Op,_},_]}) -> {trace,Op}; - (Other) -> Other - end, test_server:messages_get()), - ct:pal("Trace #2 =~n~p", [Received2]), - OneSync = [{trace,repeated_filesync}], - %% receive 1 initial repeated_filesync, then 1 per sec - Received2 = - lists:flatten([OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]), + #{filesync_repeat_interval => no_repeat}), + check_tracer(100), ok. filesync(cleanup, _Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). write_failure(Config) -> @@ -785,7 +778,7 @@ op_switch_to_drop_tty(cleanup, _Config) -> ok = stop_handler(?MODULE). op_switch_to_flush_file() -> - [{timetrap,{seconds,60}}]. + [{timetrap,{minutes,3}}]. op_switch_to_flush_file(Config) -> {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), @@ -1052,7 +1045,7 @@ restart_after(cleanup, _Config) -> %% during high load to verify that sync, dropping and flushing is %% handled correctly. handler_requests_under_load() -> - [{timetrap,{seconds,60}}]. + [{timetrap,{minutes,3}}]. handler_requests_under_load(Config) -> {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), @@ -1394,3 +1387,67 @@ analyse(Msgs) -> From ! {result,self(),TestFun(Msgs)}, analyse(Msgs) end. + +start_tracer(Trace,Expected) -> + Pid = self(), + FileCtrlPid = maps:get(file_ctrl_pid, logger_std_h:info(?MODULE)), + dbg:tracer(process,{fun tracer/2,{Pid,Expected}}), + dbg:p(whereis(?MODULE),[c]), + dbg:p(FileCtrlPid,[c]), + tpl(Trace), + ok. + +tpl([{M,F,A}|Trace]) -> + {ok,Match} = dbg:tpl(M,F,A,[]), + case lists:keyfind(matched,1,Match) of + {_,_,1} -> + ok; + _ -> + dbg:stop_clear(), + throw({skip,"Can't trace "++atom_to_list(M)++":"++ + atom_to_list(F)++"/"++integer_to_list(A)}) + end, + tpl(Trace); +tpl([]) -> + ok. + +tracer({trace,_,call,{logger_std_h,handle_cast,[{Op,_}|_]}}, + {Pid,[{Mod,Func,Op}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func,Op}); +tracer({trace,_,call,{Mod=logger_std_h,Func=write_to_dev,[_,Data,_,_,_]}}, + {Pid,[{Mod,Func,Data}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func,Data}); +tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func}); +tracer({trace,_,call,Call}, {Pid,Expected}) -> + ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]), + Pid ! {tracer_got_unexpected,Call,Expected}, + {Pid,Expected}. + +maybe_tracer_done(Pid,[]=Expected,Got) -> + ct:log("Tracer got: ~p~n",[Got]), + Pid ! {tracer_done,0}, + {Pid,Expected}; +maybe_tracer_done(Pid,[{no_more,T}]=Expected,Got) -> + ct:log("Tracer got: ~p~n",[Got]), + Pid ! {tracer_done,T}, + {Pid,Expected}; +maybe_tracer_done(Pid,Expected,Got) -> + ct:log("Tracer got: ~p~n",[Got]), + {Pid,Expected}. + +check_tracer(T) -> + check_tracer(T,fun() -> ct:fail({timeout,tracer}) end). +check_tracer(T,TimeoutFun) -> + receive + {tracer_done,Delay} -> + %% Possibly wait Delay ms to check that no unexpected + %% traces are received + check_tracer(Delay,fun() -> ok end); + {tracer_got_unexpected,Got,Expected} -> + dbg:stop_clear(), + ct:fail({tracer_got_unexpected,Got,Expected}) + after T -> + dbg:stop_clear(), + TimeoutFun() + end. diff --git a/lib/sasl/src/sasl.erl b/lib/sasl/src/sasl.erl index 657eb6688a..2bf11bdcdf 100644 --- a/lib/sasl/src/sasl.erl +++ b/lib/sasl/src/sasl.erl @@ -130,6 +130,7 @@ add_sasl_logger(undefined, _Level) -> ok; add_sasl_logger(std, undefined) -> ok; add_sasl_logger(Dest, Level) -> FC0 = #{legacy_header=>true, + single_line=>false, template=>[{logger_formatter,header},"\n",msg,"\n"]}, FC = case application:get_env(sasl,utc_log) of {ok,Bool} when is_boolean(Bool) -> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 0223831cb1..6aed525e8b 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -763,8 +763,16 @@ <datatype> <name name="rekey_limit_common_option"/> <desc> - <p>Sets a limit, in bytes, when rekeying is to be initiated. - Defaults to once per each GB and once per hour.</p> + <p>Sets the limit when rekeying is to be initiated. Both the max time and max amount of data + could be configured: + </p> + <list> + <item><c>{Minutes, Bytes}</c> initiate rekeying when any of the limits are reached.</item> + <item><c>Bytes</c> initiate rekeying when <c>Bytes</c> number of bytes are transferred, + or at latest after one hour.</item> + </list> + <p>When a rekeying is done, both the timer and the byte counter are restarted. + Defaults to one hour and one GByte.</p> </desc> </datatype> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index a3d9a1b1cb..fc0a3786ac 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -29,7 +29,6 @@ -define(SSH_DEFAULT_PORT, 22). -define(SSH_MAX_PACKET_SIZE, (256*1024)). --define(REKEY_TIMOUT, 3600000). -define(REKEY_DATA_TIMOUT, 60000). -define(DEFAULT_PROFILE, default). @@ -192,7 +191,9 @@ -type user_dir_common_option() :: {user_dir, false | string()}. -type profile_common_option() :: {profile, atom() }. -type max_idle_time_common_option() :: {idle_time, timeout()}. --type rekey_limit_common_option() :: {rekey_limit, non_neg_integer() }. +-type rekey_limit_common_option() :: {rekey_limit, Bytes::non_neg_integer() | + {Minutes::non_neg_integer(), Bytes::non_neg_integer()} + }. -type key_cb_common_option() :: {key_cb, Module::atom() | {Module::atom(),Opts::[term()]} } . -type disconnectfun_common_option() :: diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 57641cf74c..b21c0337ad 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -429,9 +429,6 @@ init([Role,Socket,Opts]) -> }, D = case Role of client -> - %% Start the renegotiation timers - timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), cache_init_idle_timer(D0); server -> Sups = ?GET_INTERNAL_OPT(supervisors, Opts), @@ -444,6 +441,10 @@ init([Role,Socket,Opts]) -> connection_supervisor = proplists:get_value(connection_sup, Sups) }}) end, + %% Start the renegotiation timers + {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), + timer:apply_after(RekeyTimeout, gen_statem, cast, [self(), renegotiate]), + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), {ok, {hello,Role}, D}; {error,Error} -> @@ -1066,7 +1067,8 @@ handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) - handle_event(cast, renegotiate, {connected,Role}, D) -> {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D#data.ssh_params), send_bytes(SshPacket, D), - timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), + {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, Ssh#ssh.opts), + timer:apply_after(RekeyTimeout, gen_statem, cast, [self(), renegotiate]), {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, key_exchange_init_msg = KeyInitMsg}}; @@ -1074,9 +1076,10 @@ handle_event({call,From}, get_alg, _, D) -> #ssh{algorithms=Algs} = D#data.ssh_params, {keep_state_and_data, [{reply,From,Algs}]}; -handle_event(cast, renegotiate, _, _) -> +handle_event(cast, renegotiate, _, D) -> %% Already in key-exchange so safe to ignore - timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), % FIXME: not here in original + {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), + timer:apply_after(RekeyTimeout, gen_statem, cast, [self(), renegotiate]), keep_state_and_data; @@ -1084,7 +1087,7 @@ handle_event(cast, renegotiate, _, _) -> handle_event(cast, data_size, {connected,Role}, D) -> {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]), Sent = Sent0 - D#data.last_size_rekey, - MaxSent = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), + {_RekeyTimeout,MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), case Sent >= MaxSent of true -> diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index 4dd9082250..73287e464a 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -599,9 +599,19 @@ default(common) -> class => user_options }, - {rekey_limit, def} => % FIXME: Why not common? - #{default => 1024000000, - chk => fun check_non_neg_integer/1, + {rekey_limit, def} => + #{default => {3600000, 1024000000}, % {1 hour, 1 GB} + chk => fun({TimeMins, SizBytes}) when is_integer(TimeMins) andalso TimeMins>=0, + is_integer(SizBytes) andalso SizBytes>=0 -> + %% New (>= 21) format + {true, {TimeMins * 60*1000, % To ms + SizBytes}}; + (SizBytes) when is_integer(SizBytes) andalso SizBytes>=0 -> + %% Old (< 21) format + {true, {3600000, SizBytes}}; + (_) -> + false + end, class => user_options }, diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 1fa94bef11..603ac71d4b 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -77,7 +77,12 @@ groups() -> ]}, {ssh_renegotiate_SUITE, [parallel], [rekey, - rekey_limit, + rekey_limit_client, + rekey_limit_daemon, + rekey_time_limit_client, + rekey_time_limit_daemon, + norekey_limit_client, + norekey_limit_daemon, renegotiate1, renegotiate2]}, @@ -1349,9 +1354,9 @@ rekey(Config) -> %%% Test rekeying by data volume -rekey_limit() -> [{timetrap,{seconds,400}}]. - -rekey_limit(Config) -> +rekey_limit_client() -> [{timetrap,{seconds,400}}]. +rekey_limit_client(Config) -> + Limit = 6000, UserDir = proplists:get_value(priv_dir, Config), DataFile = filename:join(UserDir, "rekey.data"), @@ -1359,7 +1364,7 @@ rekey_limit(Config) -> {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, {preferred_algorithms,Algs}]), - ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, 6000}, + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, Limit}, {max_random_length_padding,0}]), {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), @@ -1368,7 +1373,7 @@ rekey_limit(Config) -> timer:sleep(?REKEY_DATA_TMO), Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), - Data = lists:duplicate(159000,1), + Data = lists:duplicate(Limit+10,1), ok = ssh_sftp:write_file(SftpPid, DataFile, Data), timer:sleep(?REKEY_DATA_TMO), @@ -1393,6 +1398,150 @@ rekey_limit(Config) -> ssh:close(ConnectionRef), ssh:stop_daemon(Pid). + + +rekey_limit_daemon() -> [{timetrap,{seconds,400}}]. +rekey_limit_daemon(Config) -> + Limit = 6000, + UserDir = proplists:get_value(priv_dir, Config), + DataFile1 = filename:join(UserDir, "rekey1.data"), + DataFile2 = filename:join(UserDir, "rekey2.data"), + file:write_file(DataFile1, lists:duplicate(Limit+10,1)), + file:write_file(DataFile2, "hi\n"), + + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, Limit}, + {max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + timer:sleep(?REKEY_DATA_TMO), + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + + {ok,_} = ssh_sftp:read_file(SftpPid, DataFile1), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + false = (Kex2 == Kex1), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + + {ok,_} = ssh_sftp:read_file(SftpPid, DataFile2), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + + +%% Check that datatransfer in the other direction does not trigger re-keying +norekey_limit_client() -> [{timetrap,{seconds,400}}]. +norekey_limit_client(Config) -> + Limit = 6000, + UserDir = proplists:get_value(priv_dir, Config), + DataFile = filename:join(UserDir, "rekey3.data"), + file:write_file(DataFile, lists:duplicate(Limit+10,1)), + + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, Limit}, + {max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + timer:sleep(?REKEY_DATA_TMO), + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + + {ok,_} = ssh_sftp:read_file(SftpPid, DataFile), + timer:sleep(?REKEY_DATA_TMO), + Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + + Kex1 = Kex2, + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%% Check that datatransfer in the other direction does not trigger re-keying +norekey_limit_daemon() -> [{timetrap,{seconds,400}}]. +norekey_limit_daemon(Config) -> + Limit = 6000, + UserDir = proplists:get_value(priv_dir, Config), + DataFile = filename:join(UserDir, "rekey4.data"), + + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, Limit}, + {max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + timer:sleep(?REKEY_DATA_TMO), + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + + ok = ssh_sftp:write_file(SftpPid, DataFile, lists:duplicate(Limit+10,1)), + timer:sleep(?REKEY_DATA_TMO), + Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + + Kex1 = Kex2, + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +%%% Test rekeying by time + +rekey_time_limit_client() -> [{timetrap,{seconds,400}}]. +rekey_time_limit_client(Config) -> + Minutes = 1, + GB = 1024*1000*1000, + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, {Minutes, GB}}, + {max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + rekey_time_limit(Pid, Minutes, ConnectionRef, SftpPid). + +rekey_time_limit_daemon() -> [{timetrap,{seconds,400}}]. +rekey_time_limit_daemon(Config) -> + Minutes = 1, + GB = 1024*1000*1000, + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, {Minutes, GB}}, + {max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + rekey_time_limit(Pid, Minutes, ConnectionRef, SftpPid). + + +rekey_time_limit(Pid, Minutes, ConnectionRef, SftpPid) -> + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + + timer:sleep(5000), + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + + timer:sleep((Minutes*60 + 30) * 1000), + Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + + false = (Kex2 == Kex1), + + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + %%-------------------------------------------------------------------- %%% Test rekeying with simulataneous send request diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 4ad7da9486..34fe352d08 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,22 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 8.2.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Proper handling of clients that choose to send an empty + answer to a certificate request</p> + <p> + Own Id: OTP-15050</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 8.2.5</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 220da71123..0fe568759d 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -580,6 +580,12 @@ hello(internal, {handshake, {#client_hello{cookie = <<>>} = Handshake, _}}, Stat hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) -> %% hello_verify should not be in handshake history {next_state, ?FUNCTION_NAME, State, [{next_event, internal, Handshake}]}; +hello(internal, #change_cipher_spec{type = <<1>>}, State0) -> + {State1, Actions0} = send_handshake_flight(State0, retransmit_epoch(?FUNCTION_NAME, State0)), + {Record, State2} = next_record(State1), + {next_state, ?FUNCTION_NAME, State, Actions} = next_event(?FUNCTION_NAME, Record, State2, Actions0), + %% This will reset the retransmission timer by repeating the enter state event + {repeat_state, State, Actions}; hello(info, Event, State) -> gen_info(Event, ?FUNCTION_NAME, State); hello(state_timeout, Event, State) -> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 4ad2a2f1fd..bfdd0c205b 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,7 +1,6 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"8.2.4">>, [{load_module, ssl_cipher, soft_purge, soft_purge, []}]}, {<<"8\\..*">>, [{restart_application, ssl}]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, @@ -10,7 +9,6 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"8.2.4">>, [{load_module, ssl_cipher, soft_purge, soft_purge, []}]}, {<<"8\\..*">>, [{restart_application, ssl}]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 28b26fd358..0956d3501d 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -37,10 +37,10 @@ erl_suite_definition/1, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, crypto_support_filters/0, - ec_keyed_suites/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, + chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, srp_suites/0, srp_suites_anon/0, rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1, - filter/2, filter_suites/1, filter_suites/2, + filter/3, filter_suites/1, filter_suites/2, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1]). @@ -2212,39 +2212,25 @@ openssl_suite_name(Cipher) -> suite_definition(Cipher). %%-------------------------------------------------------------------- --spec filter(undefined | binary(), [cipher_suite()]) -> [cipher_suite()]. +-spec filter(undefined | binary(), [cipher_suite()], ssl_record:ssl_version()) -> [cipher_suite()]. %% %% Description: Select the cipher suites that can be used together with the %% supplied certificate. (Server side functionality) %%------------------------------------------------------------------- -filter(undefined, Ciphers) -> +filter(undefined, Ciphers, _) -> Ciphers; -filter(DerCert, Ciphers) -> +filter(DerCert, Ciphers0, Version) -> OtpCert = public_key:pkix_decode_cert(DerCert, otp), SigAlg = OtpCert#'OTPCertificate'.signatureAlgorithm, PubKeyInfo = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.subjectPublicKeyInfo, PubKeyAlg = PubKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, - Ciphers1 = - case ssl_certificate:public_key_type(PubKeyAlg#'PublicKeyAlgorithm'.algorithm) of - rsa -> - filter_keyuse(OtpCert, ((Ciphers -- dsa_signed_suites()) -- ec_keyed_suites()) -- ecdh_suites(), - rsa_suites(), dhe_rsa_suites() ++ ecdhe_rsa_suites()); - dsa -> - (Ciphers -- rsa_keyed_suites()) -- ec_keyed_suites(); - ec -> - filter_keyuse(OtpCert, (Ciphers -- rsa_keyed_suites()) -- dsa_signed_suites(), - [], ecdhe_ecdsa_suites()) - end, - - case public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm) of - {_, rsa} -> - Ciphers1 -- ecdsa_signed_suites(); - {_, dsa} -> - Ciphers1; - {_, ecdsa} -> - Ciphers1 -- rsa_signed_suites() - end. + Ciphers = filter_suites_pubkey( + ssl_certificate:public_key_type(PubKeyAlg#'PublicKeyAlgorithm'.algorithm), + Ciphers0, Version, OtpCert), + {_, Sign} = public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm), + filter_suites_signature(Sign, Ciphers, Version). + %%-------------------------------------------------------------------- -spec filter_suites([erl_cipher_suite()] | [cipher_suite()], map()) -> [erl_cipher_suite()] | [cipher_suite()]. @@ -2676,141 +2662,184 @@ next_iv(Bin, IV) -> <<_:FirstPart/binary, NextIV:IVSz/binary>> = Bin, NextIV. -rsa_signed_suites() -> - dhe_rsa_suites() ++ rsa_suites() ++ - psk_rsa_suites() ++ srp_rsa_suites() ++ - ecdh_rsa_suites() ++ ecdhe_rsa_suites(). - -rsa_keyed_suites() -> - dhe_rsa_suites() ++ rsa_suites() ++ - psk_rsa_suites() ++ srp_rsa_suites() ++ - ecdhe_rsa_suites(). - -dhe_rsa_suites() -> - [?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 - ]. - -psk_rsa_suites() -> - [?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, - ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, - ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_PSK_WITH_RC4_128_SHA]. -srp_rsa_suites() -> - [?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA, - ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA]. - -rsa_suites() -> - [?TLS_RSA_WITH_AES_256_CBC_SHA256, - ?TLS_RSA_WITH_AES_256_CBC_SHA, - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, - ?TLS_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_RSA_WITH_AES_256_GCM_SHA384]. - -ecdh_rsa_suites() -> - [?TLS_ECDH_RSA_WITH_NULL_SHA, - ?TLS_ECDH_RSA_WITH_RC4_128_SHA, - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, - ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384]. - -ecdhe_rsa_suites() -> - [?TLS_ECDHE_RSA_WITH_NULL_SHA, - ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, - ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, - ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256]. - -dsa_signed_suites() -> - dhe_dss_suites() ++ srp_dss_suites(). - -dhe_dss_suites() -> - [?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, - ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384]. - -srp_dss_suites() -> - [?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA, - ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. - -ec_keyed_suites() -> - ecdh_ecdsa_suites() ++ ecdhe_ecdsa_suites() - ++ ecdh_rsa_suites(). +filter_suites_pubkey(rsa, CiphersSuites0, Version, OtpCert) -> + KeyUses = key_uses(OtpCert), + CiphersSuites = filter_keyuse_suites(keyEncipherment, KeyUses, + (CiphersSuites0 -- ec_keyed_suites(CiphersSuites0)) + -- dss_keyed_suites(CiphersSuites0), + rsa_suites_encipher(CiphersSuites0)), + filter_keyuse_suites(digitalSignature, KeyUses, CiphersSuites, + rsa_signed_suites(CiphersSuites, Version)); +filter_suites_pubkey(dsa, Ciphers, _, _OtpCert) -> + (Ciphers -- rsa_keyed_suites(Ciphers)) -- ec_keyed_suites(Ciphers); +filter_suites_pubkey(ec, Ciphers, _, OtpCert) -> + Uses = key_uses(OtpCert), + filter_keyuse_suites(digitalSignature, Uses, + (Ciphers -- rsa_keyed_suites(Ciphers)) -- dss_keyed_suites(Ciphers), + ecdsa_sign_suites(Ciphers)). + +filter_suites_signature(rsa, Ciphers, Version) -> + Ciphers -- ecdsa_signed_suites(Ciphers, Version) -- dsa_signed_suites(Ciphers, Version); +filter_suites_signature(dsa, Ciphers, Version) -> + Ciphers -- ecdsa_signed_suites(Ciphers, Version) -- rsa_signed_suites(Ciphers, Version); +filter_suites_signature(ecdsa, Ciphers, Version) -> + Ciphers -- rsa_signed_suites(Ciphers, Version) -- dsa_signed_suites(Ciphers, Version). + + +%% From RFC 5246 - Section 7.4.2. Server Certificate +%% If the client provided a "signature_algorithms" extension, then all +%% certificates provided by the server MUST be signed by a +%% hash/signature algorithm pair that appears in that extension. Note +%% that this implies that a certificate containing a key for one +%% signature algorithm MAY be signed using a different signature +%% algorithm (for instance, an RSA key signed with a DSA key). This is +%% a departure from TLS 1.1, which required that the algorithms be the +%% same. +%% Note that this also implies that the DH_DSS, DH_RSA, +%% ECDH_ECDSA, and ECDH_RSA key exchange algorithms do not restrict the +%% algorithm used to sign the certificate. Fixed DH certificates MAY be +%% signed with any hash/signature algorithm pair appearing in the +%% extension. The names DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are +%% historical. +%% Note: DH_DSS and DH_RSA is not supported +rsa_signed({3,N}) when N >= 3 -> + fun(rsa) -> true; + (dhe_rsa) -> true; + (ecdhe_rsa) -> true; + (rsa_psk) -> true; + (srp_rsa) -> true; + (_) -> false + end; +rsa_signed(_) -> + fun(rsa) -> true; + (dhe_rsa) -> true; + (ecdhe_rsa) -> true; + (ecdh_rsa) -> true; + (rsa_psk) -> true; + (srp_rsa) -> true; + (_) -> false + end. +%% Cert should be signed by RSA +rsa_signed_suites(Ciphers, Version) -> + filter_suites(Ciphers, #{key_exchange_filters => [rsa_signed(Version)], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). +ecdsa_signed({3,N}) when N >= 3 -> + fun(ecdhe_ecdsa) -> true; + (_) -> false + end; +ecdsa_signed(_) -> + fun(ecdhe_ecdsa) -> true; + (ecdh_ecdsa) -> true; + (_) -> false + end. + +%% Cert should be signed by ECDSA +ecdsa_signed_suites(Ciphers, Version) -> + filter_suites(Ciphers, #{key_exchange_filters => [ecdsa_signed(Version)], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +rsa_keyed(dhe_rsa) -> + true; +rsa_keyed(rsa) -> + true; +rsa_keyed(rsa_psk) -> + true; +rsa_keyed(srp_rsa) -> + true; +rsa_keyed(ecdhe_rsa) -> + true; +rsa_keyed(_) -> + false. -ecdsa_signed_suites() -> - ecdh_ecdsa_suites() ++ ecdhe_ecdsa_suites(). +%% Certs key is an RSA key +rsa_keyed_suites(Ciphers) -> + filter_suites(Ciphers, #{key_exchange_filters => [fun(Kex) -> rsa_keyed(Kex) end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +%% RSA Certs key can be used for encipherment +rsa_suites_encipher(Ciphers) -> + filter_suites(Ciphers, #{key_exchange_filters => [fun(rsa) -> true; + (rsa_psk) -> true; + (_) -> false + end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +dss_keyed(dhe_dss) -> + true; +dss_keyed(spr_dss) -> + true; +dss_keyed(_) -> + false. + +%% Cert should be have DSS key (DSA) +dss_keyed_suites(Ciphers) -> + filter_suites(Ciphers, #{key_exchange_filters => [fun(Kex) -> dss_keyed(Kex) end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +%% Cert should be signed by DSS (DSA) +dsa_signed_suites(Ciphers, Version) -> + filter_suites(Ciphers, #{key_exchange_filters => [dsa_signed(Version)], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +dsa_signed({3,N}) when N >= 3 -> + fun(dhe_dss) -> true; + (ecdhe_dss) -> true; + (_) -> false + end; +dsa_signed(_) -> + fun(dhe_dss) -> true; + (ecdh_dss) -> true; + (ecdhe_dss) -> true; + (_) -> false + end. -ecdh_suites() -> - ecdh_rsa_suites() ++ ecdh_ecdsa_suites(). +ec_keyed(ecdh_ecdsa) -> + true; +ec_keyed(ecdhe_ecdsa) -> + true; +ec_keyed(ecdh_rsa) -> + true; +ec_keyed(_) -> + false. -ecdh_ecdsa_suites() -> - [?TLS_ECDH_ECDSA_WITH_NULL_SHA, - ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, - ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, - ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, - ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384]. - -ecdhe_ecdsa_suites() -> - [?TLS_ECDHE_ECDSA_WITH_NULL_SHA, - ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, - ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, - ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, - ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, - ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256]. - -filter_keyuse(OtpCert, Ciphers, Suites, SignSuites) -> +%% Certs key is an ECC key +ec_keyed_suites(Ciphers) -> + filter_suites(Ciphers, #{key_exchange_filters => [fun(Kex) -> ec_keyed(Kex) end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +%% EC Certs key can be used for signing +ecdsa_sign_suites(Ciphers)-> + filter_suites(Ciphers, #{key_exchange_filters => [fun(ecdhe_ecdsa) -> true; + (_) -> false + end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +key_uses(OtpCert) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, TBSExtensions = TBSCert#'OTPTBSCertificate'.extensions, Extensions = ssl_certificate:extensions_list(TBSExtensions), case ssl_certificate:select_extension(?'id-ce-keyUsage', Extensions) of undefined -> - Ciphers; - #'Extension'{extnValue = KeyUse} -> - Result = filter_keyuse_suites(keyEncipherment, - KeyUse, Ciphers, Suites), - filter_keyuse_suites(digitalSignature, - KeyUse, Result, SignSuites) + undefined; + #'Extension'{extnValue = KeyUses} -> + KeyUses end. filter_keyuse_suites(Use, KeyUse, CipherSuits, Suites) -> diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl index 022fb7eac0..452a98e683 100644 --- a/lib/ssl/src/ssl_config.erl +++ b/lib/ssl/src/ssl_config.erl @@ -132,7 +132,13 @@ private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'}, privateKey = Key}) -> public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key)); - +private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-ecPublicKey', + parameters = {asn1_OPENTYPE, Parameters}}, + privateKey = Key}) -> + ECKey = public_key:der_decode('ECPrivateKey', iolist_to_binary(Key)), + ECParameters = public_key:der_decode('EcpkParameters', Parameters), + ECKey#'ECPrivateKey'{parameters = ECParameters}; private_key(Key) -> Key. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 3f8c1f97f9..ec034af44c 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1472,7 +1472,7 @@ connection_info(#state{sni_hostname = SNIHostname, RecordCB = record_cb(Connection), CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher:suite_definition(CipherSuite), IsNamedCurveSuite = lists:member(KexAlg, - [ecdh_ecdsa, ecdhe_ecdsa, ecdh_anon]), + [ecdh_ecdsa, ecdhe_ecdsa, ecdh_rsa, ecdh_anon]), CurveInfo = case ECCCurve of {namedCurve, Curve} when IsNamedCurveSuite -> [{ecc, {named_curve, pubkey_cert_records:namedCurves(Curve)}}]; @@ -1572,11 +1572,14 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo, handle_peer_cert_key(client, _, {?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey, PublicKeyParams}, - KeyAlg, State) when KeyAlg == ecdh_rsa; - KeyAlg == ecdh_ecdsa -> + KeyAlg, #state{session = Session} = State) when KeyAlg == ecdh_rsa; + KeyAlg == ecdh_ecdsa -> ECDHKey = public_key:generate_key(PublicKeyParams), + {namedCurve, Oid} = PublicKeyParams, + Curve = pubkey_cert_records:namedCurves(Oid), %% Need API function PremasterSecret = ssl_handshake:premaster_secret(PublicKey, ECDHKey), - master_secret(PremasterSecret, State#state{diffie_hellman_keys = ECDHKey}); + master_secret(PremasterSecret, State#state{diffie_hellman_keys = ECDHKey, + session = Session#session{ecc = {named_curve, Curve}}}); %% We do currently not support cipher suites that use fixed DH. %% If we want to implement that the following clause can be used %% to extract DH parameters form cert. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 8ddd4623c1..090e7b69b7 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -772,11 +772,12 @@ available_suites(UserSuites, Version) -> lists:filtermap(fun(Suite) -> lists:member(Suite, VersionSuites) end, UserSuites). available_suites(ServerCert, UserSuites, Version, undefined, Curve) -> - ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)) - -- unavailable_ecc_suites(Curve); + Suites = ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version), Version), + filter_unavailable_ecc_suites(Curve, Suites); available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) -> Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve), - filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns, []). + filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns, + Version, []). available_signature_algs(undefined, _) -> undefined; @@ -814,7 +815,7 @@ prf({3,0}, _, _, _, _, _) -> prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) -> {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}. -select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, #session{ecc = ECCCurve} = +select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, #session{ecc = ECCCurve0} = Session, Version, #ssl_options{ciphers = UserSuites, honor_cipher_order = HonorCipherOrder} = SslOpts, Cache, CacheCb, Cert) -> @@ -823,10 +824,12 @@ select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, Cache, CacheCb), case Resumed of undefined -> - Suites = available_suites(Cert, UserSuites, Version, HashSigns, ECCCurve), - CipherSuite = select_cipher_suite(CipherSuites, Suites, HonorCipherOrder), + Suites = available_suites(Cert, UserSuites, Version, HashSigns, ECCCurve0), + CipherSuite0 = select_cipher_suite(CipherSuites, Suites, HonorCipherOrder), + {ECCCurve, CipherSuite} = cert_curve(Cert, ECCCurve0, CipherSuite0), Compression = select_compression(Compressions), {new, Session#session{session_id = SessionId, + ecc = ECCCurve, cipher_suite = CipherSuite, compression_method = Compression}}; _ -> @@ -1066,11 +1069,11 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo, TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, Sign = sign_algo(SignAlgo), - SubSing = sign_algo(SubjAlgo), - - case lists:filter(fun({_, S} = Algos) when S == Sign -> + SubSign = sign_algo(SubjAlgo), + + case lists:filter(fun({_, S} = Algos) when S == SubSign -> is_acceptable_hash_sign(Algos, Sign, - SubSing, KeyExAlgo, SupportedHashSigns); + SubSign, KeyExAlgo, SupportedHashSigns); (_) -> false end, HashSigns) of @@ -2075,25 +2078,26 @@ handle_psk_identity(_PSKIdentity, LookupFun) handle_psk_identity(PSKIdentity, {Fun, UserState}) -> Fun(psk, PSKIdentity, UserState). -filter_hashsigns([], [], _, Acc) -> - lists:reverse(Acc); -filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, - Acc) when KeyExchange == dhe_ecdsa; - KeyExchange == ecdhe_ecdsa -> - do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Acc); -filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, +filter_hashsigns([], [], _, _, Acc) -> + lists:reverse(Acc); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version, + Acc) when KeyExchange == dhe_ecdsa; + KeyExchange == ecdhe_ecdsa -> + do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Version, Acc); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version, Acc) when KeyExchange == rsa; KeyExchange == dhe_rsa; KeyExchange == ecdhe_rsa; KeyExchange == srp_rsa; KeyExchange == rsa_psk -> - do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Acc); -filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when + do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Version, Acc); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version, Acc) when KeyExchange == dhe_dss; KeyExchange == srp_dss -> - do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Acc); -filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when + do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Version, Acc); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Verion, + Acc) when KeyExchange == dh_dss; KeyExchange == dh_rsa; KeyExchange == dh_ecdsa; @@ -2102,8 +2106,9 @@ filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], Has %% Fixed DH certificates MAY be signed with any hash/signature %% algorithm pair appearing in the hash_sign extension. The names %% DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are historical. - filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); -filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when + filter_hashsigns(Suites, Algos, HashSigns, Verion, [Suite| Acc]); +filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version, + Acc) when KeyExchange == dh_anon; KeyExchange == ecdh_anon; KeyExchange == srp_anon; @@ -2111,20 +2116,28 @@ filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], Has KeyExchange == dhe_psk; KeyExchange == ecdhe_psk -> %% In this case hashsigns is not used as the kexchange is anonaymous - filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]). + filter_hashsigns(Suites, Algos, HashSigns, Version, [Suite| Acc]). -do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Acc) -> +do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Version, Acc) -> case lists:keymember(SignAlgo, 2, HashSigns) of true -> - filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]); + filter_hashsigns(Suites, Algos, HashSigns, Version, [Suite| Acc]); false -> - filter_hashsigns(Suites, Algos, HashSigns, Acc) + filter_hashsigns(Suites, Algos, HashSigns, Version, Acc) end. -unavailable_ecc_suites(no_curve) -> - ssl_cipher:ec_keyed_suites(); -unavailable_ecc_suites(_) -> - []. +filter_unavailable_ecc_suites(no_curve, Suites) -> + ECCSuites = ssl_cipher:filter_suites(Suites, #{key_exchange_filters => [fun(ecdh_ecdsa) -> true; + (ecdhe_ecdsa) -> true; + (ecdh_rsa) -> true; + (_) -> false + end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}), + Suites -- ECCSuites; +filter_unavailable_ecc_suites(_, Suites) -> + Suites. %%-------------Extension handling -------------------------------- handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite, @@ -2220,8 +2233,11 @@ sign_algo(Alg) -> is_acceptable_hash_sign(Algos, _, _, KeyExAlgo, SupportedHashSigns) when KeyExAlgo == dh_dss; KeyExAlgo == dh_rsa; - KeyExAlgo == dh_ecdsa -> - %% dh_* could be called only dh in TLS-1.2 + KeyExAlgo == ecdh_ecdsa; + KeyExAlgo == ecdh_rsa; + KeyExAlgo == ecdh_ecdsa + -> + %% *dh_* could be called only *dh in TLS-1.2 is_acceptable_hash_sign(Algos, SupportedHashSigns); is_acceptable_hash_sign(Algos, rsa, ecdsa, ecdh_rsa, SupportedHashSigns) -> is_acceptable_hash_sign(Algos, SupportedHashSigns); @@ -2436,3 +2452,27 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> {false, false} -> {ok, ConnectionStates} end. + +cert_curve(_, _, no_suite) -> + {no_curve, no_suite}; +cert_curve(Cert, ECCCurve0, CipherSuite) -> + case ssl_cipher:suite_definition(CipherSuite) of + #{key_exchange := Kex} when Kex == ecdh_ecdsa; + Kex == ecdh_rsa -> + OtpCert = public_key:pkix_decode_cert(Cert, otp), + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + #'OTPSubjectPublicKeyInfo'{algorithm = AlgInfo} + = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + {namedCurve, Oid} = AlgInfo#'PublicKeyAlgorithm'.parameters, + try pubkey_cert_records:namedCurves(Oid) of + Curve -> + {{named_curve, Curve}, CipherSuite} + catch + _:_ -> + {no_curve, no_suite} + end; + _ -> + {ECCCurve0, CipherSuite} + end. + + diff --git a/lib/ssl/test/ssl_ECC.erl b/lib/ssl/test/ssl_ECC.erl index 489a72e50e..2096cf8166 100644 --- a/lib/ssl/test/ssl_ECC.erl +++ b/lib/ssl/test/ssl_ECC.erl @@ -89,7 +89,7 @@ client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) -> %% ECDH_ECDSA client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]), + Ext = x509_test:extensions([{key_usage, [keyAgreement]}]), {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]}, {client_chain, @@ -99,7 +99,7 @@ client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> ssl_test_lib:ssl_options(SOpts, Config), [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]), + Ext = x509_test:extensions([{key_usage, [keyAgreement]}]), {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]}, {client_chain, @@ -110,7 +110,7 @@ client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) -> [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]), + Ext = x509_test:extensions([{key_usage, [keyAgreement]}]), {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]}, {client_chain, diff --git a/lib/ssl/test/ssl_ECC_openssl_SUITE.erl b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl index ba609aa0dc..280fa94ecb 100644 --- a/lib/ssl/test/ssl_ECC_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl @@ -33,39 +33,57 @@ %%-------------------------------------------------------------------- all() -> - [ - {group, 'tlsv1.2'}, - {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'dtlsv1.2'}, - {group, 'dtlsv1'} - ]. + case test_cases() of + [_|_] -> + all_groups(); + [] -> + [skip] + end. + +all_groups() -> + case ssl_test_lib:openssl_sane_dtls() of + true -> + [{group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'}]; + false -> + [{group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}] + end. groups() -> - [ - {'tlsv1.2', [], test_cases()}, - {'tlsv1.1', [], test_cases()}, - {'tlsv1', [], test_cases()}, - {'dtlsv1.2', [], test_cases()}, - {'dtlsv1', [], test_cases()} - ]. + case ssl_test_lib:openssl_sane_dtls() of + true -> + [{'tlsv1.2', [], test_cases()}, + {'tlsv1.1', [], test_cases()}, + {'tlsv1', [], test_cases()}, + {'dtlsv1.2', [], test_cases()}, + {'dtlsv1', [], test_cases()}]; + false -> + [{'tlsv1.2', [], test_cases()}, + {'tlsv1.1', [], test_cases()}, + {'tlsv1', [], test_cases()}] + end. test_cases()-> - %% cert_combinations(). - server_ecdh_rsa(). + cert_combinations(). + cert_combinations() -> - lists:append(lists:filtermap(fun({Name, Suites}) -> - case ssl_test_lib:openssl_filter(Name) of - [] -> - false; - [_|_] -> - {true, Suites} - end - end, [{"ECDH-RSA", server_ecdh_rsa()}, - {"ECDHE-RSA", server_ecdhe_rsa()}, - {"ECDH-ECDSA", server_ecdh_ecdsa()}, - {"ECDHE-ECDSA", server_ecdhe_ecdsa()} - ])). + lists:append(lists:map(fun({Name, Suites}) -> + case ssl_test_lib:openssl_filter(Name) of + [] -> + []; + [_|_] -> + Suites + end + end, [{"ECDH-ECDSA", server_ecdh_ecdsa()}, + {"ECDH-RSA", server_ecdh_rsa()}, + {"ECDHE-RSA", server_ecdhe_rsa()}, + {"ECDHE-ECDSA", server_ecdhe_ecdsa()} + ])). server_ecdh_rsa() -> [client_ecdh_rsa_server_ecdh_rsa, client_ecdhe_rsa_server_ecdh_rsa, @@ -91,11 +109,11 @@ init_per_suite(Config0) -> end_per_suite(Config0), try crypto:start() of ok -> - case ssl_test_lib:sufficient_crypto_support(cipher_ec) of + case ssl_test_lib:sufficient_crypto_support(cipher_ec) of true -> Config0; false -> - {skip, "Crypto does not support ECC"} + {skip, "Openssl does not support ECC"} end catch _:_ -> {skip, "Crypto did not start"} @@ -131,7 +149,8 @@ end_per_group(GroupName, Config0) -> end. %%-------------------------------------------------------------------- - +init_per_testcase(skip, Config) -> + Config; init_per_testcase(TestCase, Config) -> ssl_test_lib:ct_log_supported_protocol_versions(Config), Version = proplists:get_value(tls_version, Config), @@ -149,6 +168,9 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- +skip(Config) when is_list(Config) -> + {skip, openssl_does_not_support_ECC}. + %% Test diffrent certificate chain types, note that it is the servers %% chain that affect what cipher suit that will be choosen diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index fe4f02f100..d3b13050e3 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -273,7 +273,8 @@ init_per_suite(Config0) -> proplists:get_value(priv_dir, Config0)), Config1 = ssl_test_lib:make_dsa_cert(Config0), Config2 = ssl_test_lib:make_ecdsa_cert(Config1), - Config = ssl_test_lib:make_ecdh_rsa_cert(Config2), + Config3 = ssl_test_lib:make_rsa_cert(Config2), + Config = ssl_test_lib:make_ecdh_rsa_cert(Config3), ssl_test_lib:cert_options(Config) catch _:_ -> {skip, "Crypto did not start"} @@ -3180,10 +3181,10 @@ der_input(Config) when is_list(Config) -> Size = ets:info(CADb, size), - SeverVerifyOpts = ssl_test_lib:ssl_options(server_opts, Config), + SeverVerifyOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ServerCert, ServerKey, ServerCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | SeverVerifyOpts]), - ClientVerifyOpts = ssl_test_lib:ssl_options(client_opts, Config), + ClientVerifyOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientCert, ClientKey, ClientCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | ClientVerifyOpts]), ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 3a7e844cf8..8c27571d64 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1434,16 +1434,33 @@ sufficient_crypto_support(_) -> check_key_exchange_send_active(Socket, false) -> send_recv_result_active(Socket); check_key_exchange_send_active(Socket, KeyEx) -> - {ok, [{cipher_suite, Suite}]} = ssl:connection_information(Socket, [cipher_suite]), - true = check_key_exchange(Suite, KeyEx), + {ok, Info} = + ssl:connection_information(Socket, [cipher_suite, protocol]), + Suite = proplists:get_value(cipher_suite, Info), + Version = proplists:get_value(protocol, Info), + true = check_key_exchange(Suite, KeyEx, Version), send_recv_result_active(Socket). -check_key_exchange({KeyEx,_, _}, KeyEx) -> +check_key_exchange({KeyEx,_, _}, KeyEx, _) -> true; -check_key_exchange({KeyEx,_,_,_}, KeyEx) -> +check_key_exchange({KeyEx,_,_,_}, KeyEx, _) -> true; -check_key_exchange(KeyEx1, KeyEx2) -> - ct:pal("Negotiated ~p Expected ~p", [KeyEx1, KeyEx2]), +check_key_exchange(KeyEx1, KeyEx2, Version) -> + case Version of + 'tlsv1.2' -> + v_1_2_check(element(1, KeyEx1), KeyEx2); + 'dtlsv1.2' -> + v_1_2_check(element(1, KeyEx1), KeyEx2); + _ -> + ct:pal("Negotiated ~p Expected ~p", [KeyEx1, KeyEx2]), + false + end. + +v_1_2_check(ecdh_ecdsa, ecdh_rsa) -> + true; +v_1_2_check(ecdh_rsa, ecdh_ecdsa) -> + true; +v_1_2_check(_, _) -> false. send_recv_result_active(Socket) -> @@ -1567,12 +1584,62 @@ openssl_dsa_support() -> true end. +%% Acctual support is tested elsewhere, this is to exclude some LibreSSL and OpenSSL versions +openssl_sane_dtls() -> + case os:cmd("openssl version") of + "OpenSSL 0." ++ _ -> + false; + "OpenSSL 1.0.1s-freebsd" ++ _ -> + false; + "OpenSSL 1.0.2k-freebsd" ++ _ -> + false; + "OpenSSL 1.0.2d" ++ _ -> + false; + "OpenSSL 1.0.2n" ++ _ -> + false; + "OpenSSL 1.0.2m" ++ _ -> + false; + "OpenSSL 1.0.0" ++ _ -> + false; + "OpenSSL" ++ _ -> + true; + "LibreSSL 2.7" ++ _ -> + true; + _ -> + false + end. +openssl_sane_client_cert() -> + case os:cmd("openssl version") of + "LibreSSL 2.5.2" ++ _ -> + true; + "LibreSSL 2.4" ++ _ -> + false; + "LibreSSL 2.3" ++ _ -> + false; + "LibreSSL 2.1" ++ _ -> + false; + "LibreSSL 2.0" ++ _ -> + false; + "LibreSSL 2.0" ++ _ -> + false; + "OpenSSL 1.0.1s-freebsd" -> + false; + "OpenSSL 1.0.0" ++ _ -> + false; + _ -> + true + end. + check_sane_openssl_version(Version) -> case supports_ssl_tls_version(Version) of true -> case {Version, os:cmd("openssl version")} of {'sslv3', "OpenSSL 1.0.2" ++ _} -> false; + {'dtlsv1', _} -> + not is_fips(openssl); + {'dtlsv1.2', _} -> + not is_fips(openssl); {_, "OpenSSL 1.0.2" ++ _} -> true; {_, "OpenSSL 1.0.1" ++ _} -> @@ -1581,7 +1648,7 @@ check_sane_openssl_version(Version) -> false; {'tlsv1.1', "OpenSSL 1.0.0" ++ _} -> false; - {'dtlsv1.2', "OpenSSL 1.0.0" ++ _} -> + {'dtlsv1.2', "OpenSSL 1.0.2" ++ _} -> false; {'dtlsv1', "OpenSSL 1.0.0" ++ _} -> false; @@ -1703,9 +1770,12 @@ supports_ssl_tls_version(sslv2 = Version) -> VersionFlag = version_flag(Version), Exe = "openssl", Args = ["s_client", VersionFlag], + [{trap_exit, Trap}] = process_info(self(), [trap_exit]), + process_flag(trap_exit, true), Port = ssl_test_lib:portable_open_port(Exe, Args), Bool = do_supports_ssl_tls_version(Port, ""), consume_port_exit(Port), + process_flag(trap_exit, Trap), Bool end; diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 9c60a6315e..a2e8ef8be0 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -37,26 +37,43 @@ %%-------------------------------------------------------------------- all() -> - [ - {group, basic}, - {group, 'tlsv1.2'}, - {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'sslv3'}, - {group, 'dtlsv1.2'}, - {group, 'dtlsv1'} - ]. + case ssl_test_lib:openssl_sane_dtls() of + true -> + [{group, basic}, + {group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'}]; + false -> + [{group, basic}, + {group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}] + end. groups() -> - [{basic, [], basic_tests()}, - {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, - {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, - {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, - {'sslv3', [], all_versions_tests()}, - {'dtlsv1.2', [], dtls_all_versions_tests()}, - {'dtlsv1', [], dtls_all_versions_tests()} - ]. - + case ssl_test_lib:openssl_sane_dtls() of + true -> + [{basic, [], basic_tests()}, + {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'sslv3', [], all_versions_tests()}, + {'dtlsv1.2', [], dtls_all_versions_tests()}, + {'dtlsv1', [], dtls_all_versions_tests()} + ]; + false -> + [{basic, [], basic_tests()}, + {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + {'sslv3', [], all_versions_tests()} + ] + end. + basic_tests() -> [basic_erlang_client_openssl_server, basic_erlang_server_openssl_client, @@ -85,9 +102,20 @@ all_versions_tests() -> expired_session, ssl2_erlang_server_openssl_client ]. + dtls_all_versions_tests() -> - [ - erlang_client_openssl_server, + case ssl_test_lib:openssl_sane_client_cert() of + true -> + [erlang_server_openssl_client_client_cert, + erlang_client_openssl_server_no_server_ca_cert, + erlang_client_openssl_server_client_cert + | dtls_all_versions_tests_2()]; + false -> + dtls_all_versions_tests_2() + end. + +dtls_all_versions_tests_2() -> + [erlang_client_openssl_server, erlang_server_openssl_client, erlang_client_openssl_server_dsa_cert, erlang_server_openssl_client_dsa_cert, @@ -98,12 +126,8 @@ dtls_all_versions_tests() -> erlang_client_openssl_server_renegotiate, erlang_client_openssl_server_nowrap_seqnum, erlang_server_openssl_client_nowrap_seqnum, - erlang_client_openssl_server_no_server_ca_cert, - erlang_client_openssl_server_client_cert, - erlang_server_openssl_client_client_cert, ciphers_rsa_signed_certs, ciphers_dsa_signed_certs - %%erlang_client_bad_openssl_server, %%expired_session ]. @@ -167,7 +191,15 @@ end_per_suite(_Config) -> application:stop(crypto). init_per_group(basic, Config0) -> - ssl_test_lib:clean_tls_version(Config0); + case ssl_test_lib:supports_ssl_tls_version('tlsv1.2') + orelse ssl_test_lib:supports_ssl_tls_version('tlsv1.1') + orelse ssl_test_lib:supports_ssl_tls_version('tlsv1') + of + true -> + ssl_test_lib:clean_tls_version(Config0); + false -> + {skip, "only sslv3 supported by OpenSSL"} + end; init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) of @@ -381,7 +413,7 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) -> Exe = "openssl", Args = ["s_client", "-connect", hostname_format(Hostname) ++ - ":" ++ integer_to_list(Port) ++ no_v2_flag() | workaround_openssl_s_clinent()], + ":" ++ integer_to_list(Port) ++ no_low_flag() | workaround_openssl_s_clinent()], OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), true = port_command(OpenSslPort, Data), @@ -1963,10 +1995,10 @@ hostname_format(Hostname) -> "localhost" end. -no_v2_flag() -> +no_low_flag() -> case ssl_test_lib:supports_ssl_tls_version(sslv2) of true -> - " -no_ssl2 "; + " -no_ssl2 -no_ssl3"; false -> - "" + " -no_ssl3" end. diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 0ff22c5eab..eb85a55717 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 8.2.5 +SSL_VSN = 8.2.6 diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 6d3d5baa23..dd509191ef 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -109,6 +109,7 @@ new_type_test(is_function, 2) -> true; new_type_test(is_integer, 1) -> true; new_type_test(is_list, 1) -> true; new_type_test(is_map, 1) -> true; +new_type_test(is_map_key, 2) -> true; new_type_test(is_number, 1) -> true; new_type_test(is_pid, 1) -> true; new_type_test(is_port, 1) -> true; @@ -315,6 +316,7 @@ bif(is_function, 2) -> true; bif(is_integer, 1) -> true; bif(is_list, 1) -> true; bif(is_map, 1) -> true; +bif(is_map_key, 2) -> true; bif(is_number, 1) -> true; bif(is_pid, 1) -> true; bif(is_port, 1) -> true; diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index ec8cfd56c2..428c23524b 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -929,6 +929,7 @@ bool_test(is_port,1) -> true; bool_test(is_reference,1) -> true; bool_test(is_tuple,1) -> true; bool_test(is_map,1) -> true; +bool_test(is_map_key, 2) -> true; bool_test(is_binary,1) -> true; bool_test(is_function,1) -> true; bool_test(is_record,2) -> true; diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index fd51aca861..e08db0ea79 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -804,6 +804,7 @@ resulting regexp is surrounded by \\_< and \\_>." "is_integer" "is_list" "is_map" + "is_map_key" "is_number" "is_pid" "is_port" diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index d0152a4915..1db90c1d86 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -125,7 +125,7 @@ %% -------------------------------------------------------------------- %% start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []). -stop() -> gen_server:call(?MODULE, stop, infinity). +stop() -> gen_server:stop(?MODULE, normal, infinity). init([]) -> {ok, #state{ locks = [], duration = 0 } }. start_internal() -> @@ -442,9 +442,6 @@ handle_call({save, Filename}, _From, State) -> {reply, {error, Error}, State} end; -handle_call(stop, _From, State) -> - {stop, normal, ok, State}; - handle_call(Command, _From, State) -> {reply, {error, {undefined, Command}}, State}. |