aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/src')
-rw-r--r--lib/stdlib/src/Makefile4
-rw-r--r--lib/stdlib/src/array.erl21
-rw-r--r--lib/stdlib/src/beam_lib.erl52
-rw-r--r--lib/stdlib/src/erl_lint.erl67
-rw-r--r--lib/stdlib/src/erl_parse.yrl2
-rw-r--r--lib/stdlib/src/erl_posix_msg.erl4
-rw-r--r--lib/stdlib/src/erl_pp.erl195
-rw-r--r--lib/stdlib/src/gen_fsm.erl154
-rw-r--r--lib/stdlib/src/gen_server.erl53
-rw-r--r--lib/stdlib/src/gen_statem.erl2219
-rw-r--r--lib/stdlib/src/io_lib.erl23
-rw-r--r--lib/stdlib/src/io_lib_format.erl110
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl53
-rw-r--r--lib/stdlib/src/maps.erl157
-rw-r--r--lib/stdlib/src/otp_internal.erl176
-rw-r--r--lib/stdlib/src/rand.erl563
-rw-r--r--lib/stdlib/src/slave.erl17
-rw-r--r--lib/stdlib/src/stdlib.app.src2
-rw-r--r--lib/stdlib/src/stdlib.appup.src30
-rw-r--r--lib/stdlib/src/string.erl86
-rw-r--r--lib/stdlib/src/sys.erl178
-rw-r--r--lib/stdlib/src/uri_string.erl23
22 files changed, 2680 insertions, 1509 deletions
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index c95f7637f7..86003c953d 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -155,8 +155,10 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
ifeq ($(NATIVE_LIBS_ENABLED),yes)
ERL_COMPILE_FLAGS += +native
+else
+ERL_COMPILE_FLAGS += -Werror
endif
-ERL_COMPILE_FLAGS += -I../include -I../../kernel/include -Werror
+ERL_COMPILE_FLAGS += -I../include -I../../kernel/include
# ----------------------------------------------------
# Targets
diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl
index 939b1fb488..1504326c61 100644
--- a/lib/stdlib/src/array.erl
+++ b/lib/stdlib/src/array.erl
@@ -126,11 +126,12 @@
%% per write than base 10, but the speedup is only 21%.)
-define(DEFAULT, undefined).
--define(LEAFSIZE, 10). % the "base"
--define(NODESIZE, ?LEAFSIZE). % (no reason to have a different size)
+-define(LEAFSIZE, 10). % the "base" (assumed to be > 1)
+-define(NODESIZE, ?LEAFSIZE). % must not be LEAFSIZE-1; keep same as leaf
-define(NODEPATTERN(S), {_,_,_,_,_,_,_,_,_,_,S}). % NODESIZE+1 elements!
--define(NEW_NODE(S), % beware of argument duplication!
- setelement((?NODESIZE+1),erlang:make_tuple((?NODESIZE+1),(S)),(S))).
+-define(NEW_NODE(E,S), % general case (currently unused)
+ setelement((?NODESIZE+1),erlang:make_tuple((?NODESIZE+1),(E)),(S))).
+-define(NEW_NODE(S), erlang:make_tuple((?NODESIZE+1),(S))). % when E = S
-define(NEW_LEAF(D), erlang:make_tuple(?LEAFSIZE,(D))).
-define(NODELEAFS, ?NODESIZE*?LEAFSIZE).
@@ -605,7 +606,7 @@ grow(I, E, M) ->
grow_1(I, E, M).
grow_1(I, E, M) when I >= M ->
- grow(I, setelement(1, ?NEW_NODE(M), E), ?extend(M));
+ grow_1(I, setelement(1, ?NEW_NODE(M), E), ?extend(M));
grow_1(_I, E, M) ->
{E, M}.
@@ -1631,12 +1632,11 @@ foldl_test_() ->
?_assert(foldl(Sum, 0, from_list(lists:seq(0,10))) =:= 55),
?_assert(foldl(Reverse, [], from_list(lists:seq(0,1000)))
=:= lists:reverse(lists:seq(0,1000))),
- ?_assert({999,[N0*100+1+2,N0*2+1+1,0]} =:=
- foldl(Vals, {0,[]},
+ ?_assertEqual({N0*100+1-2,[N0*100+1+2,N0*2+1+1,0]},
+ foldl(Vals, {0,[]},
set(N0*100+1,2,
set(N0*2+1,1,
set(0,0,new())))))
-
].
-endif.
@@ -1786,12 +1786,11 @@ foldr_test_() ->
?_assert(foldr(Sum, 0, from_list(lists:seq(0,10))) =:= 55),
?_assert(foldr(List, [], from_list(lists:seq(0,1000)))
=:= lists:seq(0,1000)),
- ?_assert({999,[0,N0*2+1+1,N0*100+1+2]} =:=
- foldr(Vals, {0,[]},
+ ?_assertEqual({N0*100+1-2,[0,N0*2+1+1,N0*100+1+2]},
+ foldr(Vals, {0,[]},
set(N0*100+1,2,
set(N0*2+1,1,
set(0,0,new())))))
-
].
-endif.
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index 3386cfcbe6..aa992f17ab 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -32,8 +32,12 @@
all_chunks/1,
diff_dirs/2,
strip/1,
+ strip/2,
strip_files/1,
+ strip_files/2,
strip_release/1,
+ strip_release/2,
+ significant_chunks/0,
build_module/1,
version/1,
md5/1,
@@ -188,7 +192,16 @@ diff_dirs(Dir1, Dir2) ->
Beam2 :: beam().
strip(FileName) ->
- try strip_file(FileName)
+ strip(FileName, []).
+
+-spec strip(Beam1, AdditionalChunks) ->
+ {'ok', {module(), Beam2}} | {'error', 'beam_lib', info_rsn()} when
+ Beam1 :: beam(),
+ AdditionalChunks :: [chunkid()],
+ Beam2 :: beam().
+
+strip(FileName, AdditionalChunks) ->
+ try strip_file(FileName, AdditionalChunks)
catch Error -> Error end.
-spec strip_files(Files) ->
@@ -196,8 +209,17 @@ strip(FileName) ->
Files :: [beam()],
Beam :: beam().
-strip_files(Files) when is_list(Files) ->
- try strip_fils(Files)
+strip_files(Files) ->
+ strip_files(Files, []).
+
+-spec strip_files(Files, AdditionalChunks) ->
+ {'ok', [{module(), Beam}]} | {'error', 'beam_lib', info_rsn()} when
+ Files :: [beam()],
+ AdditionalChunks :: [chunkid()],
+ Beam :: beam().
+
+strip_files(Files, AdditionalChunks) when is_list(Files) ->
+ try strip_fils(Files, AdditionalChunks)
catch Error -> Error end.
-spec strip_release(Dir) ->
@@ -207,7 +229,17 @@ strip_files(Files) when is_list(Files) ->
Reason :: {'not_a_directory', term()} | info_rsn().
strip_release(Root) ->
- catch strip_rel(Root).
+ strip_release(Root, []).
+
+-spec strip_release(Dir, AdditionalChunks) ->
+ {'ok', [{module(), file:filename()}]}
+ | {'error', 'beam_lib', Reason} when
+ Dir :: atom() | file:filename(),
+ AdditionalChunks :: [chunkid()],
+ Reason :: {'not_a_directory', term()} | info_rsn().
+
+strip_release(Root, AdditionalChunks) ->
+ catch strip_rel(Root, AdditionalChunks).
-spec version(Beam) ->
{'ok', {module(), [Version :: term()]}} |
@@ -401,17 +433,17 @@ cmp_lists([{Id, C1} | R1], [{Id, C2} | R2]) ->
cmp_lists(_, _) ->
error(different_chunks).
-strip_rel(Root) ->
+strip_rel(Root, AdditionalChunks) ->
ok = assert_directory(Root),
- strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam"))).
+ strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam")), AdditionalChunks).
%% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error)
-strip_fils(Files) ->
- {ok, [begin {ok, Reply} = strip_file(F), Reply end || F <- Files]}.
+strip_fils(Files, AdditionalChunks) ->
+ {ok, [begin {ok, Reply} = strip_file(F, AdditionalChunks), Reply end || F <- Files]}.
%% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error)
-strip_file(File) ->
- {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()),
+strip_file(File, AdditionalChunks) ->
+ {ok, {Mod, Chunks}} = read_significant_chunks(File, AdditionalChunks ++ significant_chunks()),
{ok, Stripped0} = build_module(Chunks),
Stripped = compress(Stripped0),
case File of
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index e0cd68617b..0cd0aef124 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -79,6 +79,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
-type fa() :: {atom(), arity()}. % function+arity
-type ta() :: {atom(), arity()}. % type+arity
+-type module_or_mfa() :: module() | mfa().
+
-record(typeinfo, {attr, line}).
%% Usage of records, functions, and imports. The variable table, which
@@ -115,6 +117,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
:: erl_anno:anno(),
clashes=[], %Exported functions named as BIFs
not_deprecated=[], %Not considered deprecated
+ not_removed=gb_sets:empty() %Not considered removed
+ :: gb_sets:set(module_or_mfa()),
func=[], %Current function
warn_format=0, %Warn format calls
enabled_warnings=[], %All enabled warnings (ordset).
@@ -382,6 +386,8 @@ format_error({redefine_callback, {F, A}}) ->
format_error({bad_callback, {M, F, A}}) ->
io_lib:format("explicit module not allowed for callback ~tw:~tw/~w",
[M, F, A]);
+format_error({bad_module, {M, F, A}}) ->
+ io_lib:format("spec for function ~w:~tw/~w from other module", [M, F, A]);
format_error({spec_fun_undefined, {F, A}}) ->
io_lib:format("spec for undefined function ~tw/~w", [F, A]);
format_error({missing_spec, {F,A}}) ->
@@ -573,7 +579,10 @@ start(File, Opts) ->
false, Opts)},
{missing_spec_all,
bool_option(warn_missing_spec_all, nowarn_missing_spec_all,
- false, Opts)}
+ false, Opts)},
+ {removed,
+ bool_option(warn_removed, nowarn_removed,
+ true, Opts)}
],
Enabled1 = [Category || {Category,true} <- Enabled0],
Enabled = ordsets:from_list(Enabled1),
@@ -670,8 +679,9 @@ forms(Forms0, St0) ->
no_auto = AutoImportSuppressed}),
St2 = bif_clashes(Forms, St1),
St3 = not_deprecated(Forms, St2),
- St4 = foldl(fun form/2, pre_scan(Forms, St3), Forms),
- post_traversal_check(Forms, St4).
+ St4 = not_removed(Forms, St3),
+ St5 = foldl(fun form/2, pre_scan(Forms, St4), Forms),
+ post_traversal_check(Forms, St5).
pre_scan([{attribute,L,compile,C} | Fs], St) ->
case is_warn_enabled(export_all, St) andalso
@@ -831,19 +841,39 @@ bif_clashes(Forms, #lint{nowarn_bif_clash=Nowarn} = St) ->
%% not_deprecated(Forms, State0) -> State
-not_deprecated(Forms, St0) ->
+not_deprecated(Forms, #lint{compile=Opts}=St0) ->
%% There are no line numbers in St0#lint.compile.
MFAsL = [{MFA,L} ||
{attribute, L, compile, Args} <- Forms,
{nowarn_deprecated_function, MFAs0} <- lists:flatten([Args]),
MFA <- lists:flatten([MFAs0])],
- Nowarn = [MFA || {MFA,_L} <- MFAsL],
+ Nowarn = [MFA ||
+ {nowarn_deprecated_function, MFAs0} <- Opts,
+ MFA <- lists:flatten([MFAs0])],
ML = [{M,L} || {{M,_F,_A},L} <- MFAsL, is_atom(M)],
St1 = foldl(fun ({M,L}, St2) ->
check_module_name(M, L, St2)
end, St0, ML),
St1#lint{not_deprecated = ordsets:from_list(Nowarn)}.
+%% not_removed(Forms, State0) -> State
+
+not_removed(Forms, #lint{compile=Opts}=St0) ->
+ %% There are no line numbers in St0#lint.compile.
+ MFAsL = [{MFA,L} ||
+ {attribute, L, compile, Args} <- Forms,
+ {nowarn_removed, MFAs0} <- lists:flatten([Args]),
+ MFA <- lists:flatten([MFAs0])],
+ Nowarn = [MFA ||
+ {nowarn_removed, MFAs0} <- Opts,
+ MFA <- lists:flatten([MFAs0])],
+ St1 = foldl(fun ({{M, _F, _A}, L}, St2) ->
+ check_module_name(M, L, St2);
+ ({M,L}, St2) ->
+ check_module_name(M, L, St2)
+ end, St0, MFAsL),
+ St1#lint{not_removed = gb_sets:from_list(Nowarn)}.
+
%% The nowarn_bif_clash directive is not only deprecated, it's actually an error from R14A
disallowed_compile_flags(Forms, St0) ->
%% There are (still) no line numbers in St0#lint.compile.
@@ -2248,6 +2278,9 @@ expr({'fun',Line,Body}, Vt, St) ->
case Body of
{clauses,Cs} ->
fun_clauses(Cs, Vt, St);
+ {function,record_info,2} ->
+ %% It is illegal to call record_info/2 with unknown arguments.
+ {[],add_error(Line, illegal_record_info, St)};
{function,F,A} ->
%% BifClash - Fun expression
%% N.B. Only allows BIFs here as well, NO IMPORTS!!
@@ -2979,7 +3012,13 @@ spec_decl(Line, MFA0, TypeSpecs, St00 = #lint{specs = Specs, module = Mod}) ->
St1 = St0#lint{specs = dict:store(MFA, Line, Specs)},
case dict:is_key(MFA, Specs) of
true -> add_error(Line, {redefine_spec, MFA0}, St1);
- false -> check_specs(TypeSpecs, spec_wrong_arity, Arity, St1)
+ false ->
+ case MFA of
+ {Mod, _, _} ->
+ check_specs(TypeSpecs, spec_wrong_arity, Arity, St1);
+ _ ->
+ add_error(Line, {bad_module, MFA}, St1)
+ end
end.
%% callback_decl(Line, Fun, Types, State) -> State.
@@ -3767,13 +3806,23 @@ deprecated_function(Line, M, F, As, St) ->
add_warning(Line, {deprecated, MFA, Replacement, Rel}, St)
end;
{removed, String} when is_list(String) ->
- add_warning(Line, {removed, MFA, String}, St);
+ add_removed_warning(Line, MFA, {removed, MFA, String}, St);
{removed, Replacement, Rel} ->
- add_warning(Line, {removed, MFA, Replacement, Rel}, St);
+ add_removed_warning(Line, MFA, {removed, MFA, Replacement, Rel}, St);
no ->
St
end.
+add_removed_warning(Line, {M, _, _}=MFA, Warning, #lint{not_removed=NotRemoved}=St) ->
+ case is_warn_enabled(removed, St) andalso
+ not gb_sets:is_element(M, NotRemoved) andalso
+ not gb_sets:is_element(MFA, NotRemoved) of
+ true ->
+ add_warning(Line, Warning, St);
+ false ->
+ St
+ end.
+
-dialyzer({no_match, deprecated_type/5}).
deprecated_type(L, M, N, As, St) ->
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 5fa9c4f75c..4ad94f2507 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -841,7 +841,7 @@ Erlang code.
-type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}.
-type af_map_pattern() ::
- {'map', anno(), [af_assoc_exact(abstract_expr)]}.
+ {'map', anno(), [af_assoc_exact(abstract_expr())]}.
-type abstract_type() :: af_annotated_type()
| af_atom()
diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl
index 8959fea498..b9ed4a3a9d 100644
--- a/lib/stdlib/src/erl_posix_msg.erl
+++ b/lib/stdlib/src/erl_posix_msg.erl
@@ -81,9 +81,9 @@ message_1(el2hlt) -> <<"level 2 halted">>;
message_1(el2nsync) -> <<"level 2 not synchronized">>;
message_1(el3hlt) -> <<"level 3 halted">>;
message_1(el3rst) -> <<"level 3 reset">>;
-message_1(elibacc) -> <<"can not access a needed shared library">>;
+message_1(elibacc) -> <<"cannot access a needed shared library">>;
message_1(elibbad) -> <<"accessing a corrupted shared library">>;
-message_1(elibexec) -> <<"can not exec a shared library directly">>;
+message_1(elibexec) -> <<"cannot exec a shared library directly">>;
message_1(elibmax) ->
<<"attempting to link in more shared libraries than system limit">>;
message_1(elibscn) -> <<".lib section in a.out corrupted">>;
diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index ada3ff5de3..255c0ae81f 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -26,7 +26,7 @@
attribute/1,attribute/2,function/1,function/2,
guard/1,guard/2,exprs/1,exprs/2,exprs/3,expr/1,expr/2,expr/3,expr/4]).
--import(lists, [append/1,foldr/3,mapfoldl/3,reverse/1,reverse/2]).
+-import(lists, [append/1,foldr/3,map/2,mapfoldl/3,reverse/1,reverse/2]).
-import(io_lib, [write/1,format/2]).
-import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0,
type_inop_prec/1, type_preop_prec/1]).
@@ -41,10 +41,11 @@
io_lib:chars())).
-type(option() :: {hook, hook_function()}
- | {encoding, latin1 | unicode | utf8}).
+ | {encoding, latin1 | unicode | utf8}
+ | {quote_singleton_atom_types, boolean()}).
-type(options() :: hook_function() | [option()]).
--record(pp, {value_fun, string_fun, char_fun}).
+-record(pp, {value_fun, singleton_atom_type_fun, string_fun, char_fun}).
-record(options, {hook, encoding, opts}).
@@ -206,22 +207,43 @@ options(Hook) ->
#options{hook = Hook, encoding = encoding([]), opts = Hook}.
state(Options) when is_list(Options) ->
+ Quote = proplists:get_bool(quote_singleton_atom_types, Options),
case encoding(Options) of
- latin1 -> state();
- unicode -> unicode_state()
+ latin1 -> latin1_state(Quote);
+ unicode -> unicode_state(Quote)
end;
state(_Hook) ->
- state().
+ latin1_state(false).
-state() ->
+latin1_state(Quote) ->
Options = [{encoding,latin1}],
- #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end,
+ ValueFun = fun(V) -> io_lib_pretty:print(V, Options) end,
+ SingletonFun =
+ case Quote of
+ true ->
+ fun(A) ->
+ io_lib:write_string_as_latin1(atom_to_list(A), $')
+ end; %'
+ false ->
+ ValueFun
+ end,
+ #pp{value_fun = ValueFun,
+ singleton_atom_type_fun = SingletonFun,
string_fun = fun io_lib:write_string_as_latin1/1,
char_fun = fun io_lib:write_char_as_latin1/1}.
-unicode_state() ->
+unicode_state(Quote) ->
Options = [{encoding,unicode}],
- #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end,
+ ValueFun = fun(V) -> io_lib_pretty:print(V, Options) end,
+ SingletonFun =
+ case Quote of
+ true ->
+ fun(A) -> io_lib:write_string(atom_to_list(A), $') end; %'
+ false ->
+ ValueFun
+ end,
+ #pp{value_fun = ValueFun,
+ singleton_atom_type_fun = SingletonFun,
string_fun = fun io_lib:write_string/1,
char_fun = fun io_lib:write_char/1}.
@@ -350,7 +372,7 @@ ltype({user_type,Line,T,Ts}, _) ->
ltype({remote_type,Line,[M,F,Ts]}, _) ->
simple_type({remote,Line,M,F}, Ts);
ltype({atom,_,T}, _) ->
- {atom,T};
+ {singleton_atom_type,T};
ltype(E, P) ->
lexpr(E, P, options(none)).
@@ -360,7 +382,12 @@ binary_type(I1, I2) ->
P = max_prec(),
E1 = [[leaf("_:"),lexpr(I1, P, options(none))] || B],
E2 = [[leaf("_:_*"),lexpr(I2, P, options(none))] || U],
- {seq,'<<','>>',[$,],E1++E2}.
+ case E1++E2 of
+ [] ->
+ leaf("<<>>");
+ Es ->
+ {seq,'<<','>>',[$,],Es}
+ end.
map_type(Fs) ->
{first,[$#],map_pair_types(Fs)}.
@@ -386,6 +413,8 @@ typed(B, Type) ->
{_L,_P,R} = type_inop_prec('::'),
{list,[{cstep,[B,' ::'],ltype(Type, R)}]}.
+tuple_type([], _) ->
+ leaf("{}");
tuple_type(Ts, F) ->
{seq,${,$},[$,],ltypes(Ts, F, 0)}.
@@ -454,7 +483,7 @@ pname(A) when is_atom(A) ->
write(A).
falist([]) ->
- [leaf("[]")];
+ ['[]'];
falist(Falist) ->
L = [begin
{Name,Arity} = Fa,
@@ -562,22 +591,22 @@ lexpr({map, _, Map, Fs}, Prec, Opts) ->
El = {first,[Rl,$#],map_fields(Fs, Opts)},
maybe_paren(P, Prec, El);
lexpr({block,_,Es}, _, Opts) ->
- {list,[{step,'begin',body(Es, Opts)},'end']};
+ {list,[{step,'begin',body(Es, Opts)},{reserved,'end'}]};
lexpr({'if',_,Cs}, _, Opts) ->
- {list,[{step,'if',if_clauses(Cs, Opts)},'end']};
+ {list,[{step,'if',if_clauses(Cs, Opts)},{reserved,'end'}]};
lexpr({'case',_,Expr,Cs}, _, Opts) ->
- {list,[{step,{list,[{step,'case',lexpr(Expr, Opts)},'of']},
+ {list,[{step,{list,[{step,'case',lexpr(Expr, Opts)},{reserved,'of'}]},
cr_clauses(Cs, Opts)},
- 'end']};
+ {reserved,'end'}]};
lexpr({'cond',_,Cs}, _, Opts) ->
- {list,[{step,leaf("cond"),cond_clauses(Cs, Opts)},'end']};
+ {list,[{step,leaf("cond"),cond_clauses(Cs, Opts)},{reserved,'end'}]};
lexpr({'receive',_,Cs}, _, Opts) ->
- {list,[{step,'receive',cr_clauses(Cs, Opts)},'end']};
+ {list,[{step,'receive',cr_clauses(Cs, Opts)},{reserved,'end'}]};
lexpr({'receive',_,Cs,To,ToOpt}, _, Opts) ->
Al = {list,[{step,[lexpr(To, Opts),' ->'],body(ToOpt, Opts)}]},
{list,[{step,'receive',cr_clauses(Cs, Opts)},
{step,'after',Al},
- 'end']};
+ {reserved,'end'}]};
lexpr({'fun',_,{function,F,A}}, _Prec, _Opts) ->
[leaf("fun "),{atom,F},leaf(format("/~w", [A]))];
lexpr({'fun',L,{function,_,_}=Func,Extra}, Prec, Opts) ->
@@ -596,15 +625,17 @@ lexpr({'fun',_,{function,M,F,A}}, _Prec, Opts) ->
ArityItem = lexpr(A, Opts),
["fun ",NameItem,$:,CallItem,$/,ArityItem];
lexpr({'fun',_,{clauses,Cs}}, _Prec, Opts) ->
- {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']};
+ {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},{reserved,'end'}]};
lexpr({named_fun,_,Name,Cs}, _Prec, Opts) ->
- {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']};
+ {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},
+ {reserved,'end'}]};
lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) ->
{force_nl,fun_info(Extra),
- {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}};
+ {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},{reserved,'end'}]}};
lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) ->
{force_nl,fun_info(Extra),
- {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}};
+ {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},
+ {reserved,'end'}]}};
lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) ->
case erl_internal:bif(M, F, length(Args)) of
true ->
@@ -619,7 +650,7 @@ lexpr({'try',_,Es,Scs,Ccs,As}, _, Opts) ->
Scs =:= [] ->
{step,'try',body(Es, Opts)};
true ->
- {step,{list,[{step,'try',body(Es, Opts)},'of']},
+ {step,{list,[{step,'try',body(Es, Opts)},{reserved,'of'}]},
cr_clauses(Scs, Opts)}
end,
if
@@ -634,7 +665,7 @@ lexpr({'try',_,Es,Scs,Ccs,As}, _, Opts) ->
true ->
{step,'after',body(As, Opts)}
end,
- 'end']};
+ {reserved,'end'}]};
lexpr({'catch',_,Expr}, Prec, Opts) ->
{P,R} = preop_prec('catch'),
El = {list,[{step,'catch',lexpr(Expr, R, Opts)}]},
@@ -647,7 +678,7 @@ lexpr({match,_,Lhs,Rhs}, Prec, Opts) ->
maybe_paren(P, Prec, El);
lexpr({op,_,Op,Arg}, Prec, Opts) ->
{P,R} = preop_prec(Op),
- Ol = leaf(format("~s ", [Op])),
+ Ol = {reserved, leaf(format("~s ", [Op]))},
El = [Ol,lexpr(Arg, R, Opts)],
maybe_paren(P, Prec, El);
lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) when Op =:= 'orelse';
@@ -655,14 +686,14 @@ lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) when Op =:= 'orelse';
%% Breaks lines since R12B.
{L,P,R} = inop_prec(Op),
Ll = lexpr(Larg, L, Opts),
- Ol = leaf(format("~s", [Op])),
+ Ol = {reserved, leaf(format("~s", [Op]))},
Lr = lexpr(Rarg, R, Opts),
El = {prefer_nl,[[]],[Ll,Ol,Lr]},
maybe_paren(P, Prec, El);
lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) ->
{L,P,R} = inop_prec(Op),
Ll = lexpr(Larg, L, Opts),
- Ol = leaf(format("~s", [Op])),
+ Ol = {reserved, leaf(format("~s", [Op]))},
Lr = lexpr(Rarg, R, Opts),
El = {list,[Ll,Ol,Lr]},
maybe_paren(P, Prec, El);
@@ -882,16 +913,18 @@ lc_qual(Q, Opts) ->
lexpr(Q, 0, Opts).
proper_list(Es, Opts) ->
- {seq,$[,$],$,,lexprs(Es, Opts)}.
+ {seq,$[,$],[$,],lexprs(Es, Opts)}.
improper_list(Es, Opts) ->
- {seq,$[,$],{$,,$|},lexprs(Es, Opts)}.
+ {seq,$[,$],[{$,,' |'}],lexprs(Es, Opts)}.
tuple(L, Opts) ->
tuple(L, fun lexpr/2, Opts).
+tuple([], _F, _Opts) ->
+ leaf("{}");
tuple(Es, F, Opts) ->
- {seq,${,$},$,,lexprs(Es, F, Opts)}.
+ {seq,${,$},[$,],lexprs(Es, F, Opts)}.
args(As, Opts) ->
{seq,$(,$),[$,],lexprs(As, Opts)}.
@@ -939,6 +972,7 @@ frmt(Item, I, PP) ->
%%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative
%%% indentation.
%%% - {atom,A}: an atom
+%%% - {singleton_atom_type,A}: an singleton atom type
%%% - {char,C}: a character
%%% - {string,S}: a string.
%%% - {value,T}: a term.
@@ -983,8 +1017,10 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) ->
end,
{BCharsL++Chars,Size};
no ->
- {BCharsL++insert_newlines(CharsSizeL, I, ST),
- nsz(lists:last(Sizes), I0)}
+ CharsList = handle_step(CharsSizeL, I, ST),
+ {LChars, LSize} =
+ maybe_newlines(CharsList, LItems, I, NSepChars, ST),
+ {[BCharsL,LChars],nsz(LSize, I0)}
end;
f({force_nl,_ExtraInfoItem,Item}, I, ST, WT, PP) when I < 0 ->
%% Extra info is a comment; cannot have that on the same line
@@ -1000,23 +1036,28 @@ f({prefer_nl,Sep,LItems}, I0, ST, WT, PP) ->
Sizes =:= [] ->
{[], 0};
true ->
- {insert_newlines(CharsSize2L, I0, ST),nsz(lists:last(Sizes), I0)}
+ {insert_newlines(CharsSize2L, I0, ST),
+ nsz(lists:last(Sizes), I0)}
end;
f({value,V}, I, ST, WT, PP) ->
f(write_a_value(V, PP), I, ST, WT, PP);
f({atom,A}, I, ST, WT, PP) ->
f(write_an_atom(A, PP), I, ST, WT, PP);
+f({singleton_atom_type,A}, I, ST, WT, PP) ->
+ f(write_a_singleton_atom_type(A, PP), I, ST, WT, PP);
f({char,C}, I, ST, WT, PP) ->
f(write_a_char(C, PP), I, ST, WT, PP);
f({string,S}, I, ST, WT, PP) ->
f(write_a_string(S, I, PP), I, ST, WT, PP);
+f({reserved,R}, I, ST, WT, PP) ->
+ f(R, I, ST, WT, PP);
f({hook,HookExpr,Precedence,Func,Options}, I, _ST, _WT, _PP) ->
Chars = Func(HookExpr, I, Precedence, Options),
{Chars,indentation(Chars, I)};
f({ehook,HookExpr,Precedence,{Mod,Func,Eas}=ModFuncEas}, I, _ST, _WT, _PP) ->
Chars = apply(Mod, Func, [HookExpr,I,Precedence,ModFuncEas|Eas]),
{Chars,indentation(Chars, I)};
-f(WordName, _I, _ST, WT, _PP) -> % when is_atom(WordName)
+f(WordName, _I, _ST, WT, _PP) when is_atom(WordName) ->
word(WordName, WT).
-define(IND, 4).
@@ -1038,12 +1079,18 @@ fl(CItems, Sep0, I0, After, ST, WT, PP) ->
true ->
[CharSize1,f([Item2,S], incr(I0, ?IND), ST, WT, PP)]
end;
+ ({reserved,Word}, S) ->
+ [f([Word,S], I0, ST, WT, PP),{[],0}];
(Item, S) ->
[f([Item,S], I0, ST, WT, PP),{[],0}]
end,
- {Sep,LastSep} = case Sep0 of {_,_} -> Sep0; _ -> {Sep0,Sep0} end,
+ {Sep,LastSep} = sep(Sep0),
fl1(CItems, F, Sep, LastSep, After).
+sep([{S,LS}]) -> {[S],[LS]};
+sep({_,_}=Sep) -> Sep;
+sep(S) -> {S, S}.
+
fl1([CItem], F, _Sep, _LastSep, After) ->
[F(CItem,After)];
fl1([CItem1,CItem2], F, _Sep, LastSep, After) ->
@@ -1069,20 +1116,64 @@ unz1(CharSizes) ->
nonzero(CharSizes) ->
lists:filter(fun({_,Sz}) -> Sz =/= 0 end, CharSizes).
-insert_newlines(CharsSizesL, I, ST) when I >= 0 ->
- insert_nl(foldr(fun([{_C1,0},{_C2,0}], A) ->
- A;
- ([{C1,_Sz1},{_C2,0}], A) ->
- [C1|A];
- ([{C1,_Sz1},{C2,Sz2}], A) when Sz2 > 0 ->
- [insert_nl([C1,C2], I+?IND, ST)|A]
- end, [], CharsSizesL), I, ST).
+maybe_newlines([{Chars,Size}], [], _I, _NSepChars, _ST) ->
+ {Chars,Size};
+maybe_newlines(CharsSizeList, Items, I, NSepChars, ST) when I >= 0 ->
+ maybe_sep(CharsSizeList, Items, I, NSepChars, nl_indent(I, ST)).
+
+maybe_sep([{Chars1,Size1}|CharsSizeL], [Item|Items], I0, NSepChars, Sep) ->
+ I1 = case classify_item(Item) of
+ atomic ->
+ I0 + Size1;
+ _ ->
+ ?MAXLINE+1
+ end,
+ maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, Size1, [Chars1]).
+
+maybe_sep1([{Chars,Size}|CharsSizeL], [Item|Items],
+ I0, I, Sep, NSepChars, Sz0, A) ->
+ case classify_item(Item) of
+ atomic when is_integer(Size) ->
+ Size1 = Size + 1,
+ I1 = I + Size1,
+ if
+ I1 =< ?MAXLINE ->
+ A1 = if
+ NSepChars > 0 -> [Chars,$\s|A];
+ true -> [Chars|A]
+ end,
+ maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars,
+ Sz0 + Size1, A1);
+ true ->
+ A1 = [Chars,Sep|A],
+ maybe_sep1(CharsSizeL, Items, I0, I0 + Size, Sep,
+ NSepChars, Size1, A1)
+ end;
+ _ ->
+ A1 = [Chars,Sep|A],
+ maybe_sep1(CharsSizeL, Items, I0, ?MAXLINE+1, Sep, NSepChars,
+ 0, A1)
+ end;
+maybe_sep1(_CharsSizeL, _Items, _Io, _I, _Sep, _NSepChars, Sz, A) ->
+ {lists:reverse(A), Sz}.
+insert_newlines(CharsSizesL, I, ST) when I >= 0 ->
+ {CharsL, _} = unz1(handle_step(CharsSizesL, I, ST)),
+ insert_nl(CharsL, I, ST).
+
+handle_step(CharsSizesL, I, ST) ->
+ map(fun([{_C1,0},{_C2,0}]) ->
+ {[], 0};
+ ([{C1,Sz1},{_C2,0}]) ->
+ {C1, Sz1};
+ ([{C1,Sz1},{C2,Sz2}]) when Sz2 > 0 ->
+ {insert_nl([C1,C2], I+?IND, ST),line_size([Sz1,Sz2])}
+ end, CharsSizesL).
insert_nl(CharsL, I, ST) ->
insert_sep(CharsL, nl_indent(I, ST)).
-insert_sep([Chars1 | CharsL], Sep) ->
+insert_sep([Chars1|CharsL], Sep) ->
[Chars1 | [[Sep,Chars] || Chars <- CharsL]].
nl_indent(0, _T) ->
@@ -1090,6 +1181,12 @@ nl_indent(0, _T) ->
nl_indent(I, T) when I > 0 ->
[$\n|spaces(I, T)].
+classify_item({atom, _}) -> atomic;
+classify_item({singleton_atom_type, _}) -> atomic;
+classify_item(Atom) when is_atom(Atom) -> atomic;
+classify_item({leaf, _, _}) -> atomic;
+classify_item(_) -> complex.
+
same_line(I0, SizeL, NSepChars) ->
try
Size = lists:sum(SizeL) + NSepChars,
@@ -1150,6 +1247,9 @@ write_a_value(V, PP) ->
write_an_atom(A, PP) ->
flat_leaf(write_atom(A, PP)).
+write_a_singleton_atom_type(A, PP) ->
+ flat_leaf(write_singleton_atom_type(A, PP)).
+
write_a_char(C, PP) ->
flat_leaf(write_char(C, PP)).
@@ -1184,6 +1284,9 @@ write_value(V, PP) ->
write_atom(A, PP) ->
(PP#pp.value_fun)(A).
+write_singleton_atom_type(A, PP) ->
+ (PP#pp.singleton_atom_type_fun)(A).
+
write_string(S, PP) ->
(PP#pp.string_fun)(S).
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index caaaf8fa2e..1e18710738 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -411,12 +411,13 @@ decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTime
sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
[Name, StateName, StateData, Mod, Time, HibernateAfterTimeout], Hib);
{'EXIT', Parent, Reason} ->
- terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug);
+ terminate(
+ Reason, Name, undefined, Msg, Mod, StateName, StateData, Debug);
_Msg when Debug =:= [] ->
handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout);
_Msg ->
Debug1 = sys:handle_debug(Debug, fun print_event/3,
- {Name, StateName}, {in, Msg}),
+ Name, {in, Msg, StateName}),
handle_msg(Msg, Parent, Name, StateName, StateData,
Mod, Time, HibernateAfterTimeout, Debug1)
end.
@@ -431,7 +432,7 @@ system_continue(Parent, Debug, [Name, StateName, StateData, Mod, Time, Hibernate
system_terminate(Reason, _Parent, Debug,
[Name, StateName, StateData, Mod, _Time, _HibernateAfterTimeout]) ->
- terminate(Reason, Name, [], Mod, StateName, StateData, Debug).
+ terminate(Reason, Name, undefined, [], Mod, StateName, StateData, Debug).
system_code_change([Name, StateName, StateData, Mod, Time, HibernateAfterTimeout],
_Module, OldVsn, Extra) ->
@@ -452,7 +453,7 @@ system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time, Hibernate
%% Format debug messages. Print them as the call-back module sees
%% them, not as the real erlang messages. Use trace for that.
%%-----------------------------------------------------------------
-print_event(Dev, {in, Msg}, {Name, StateName}) ->
+print_event(Dev, {in, Msg, StateName}, Name) ->
case Msg of
{'$gen_event', Event} ->
io:format(Dev, "*DBG* ~tp got event ~tp in state ~tw~n",
@@ -461,6 +462,16 @@ print_event(Dev, {in, Msg}, {Name, StateName}) ->
io:format(Dev,
"*DBG* ~tp got all_state_event ~tp in state ~tw~n",
[Name, Event, StateName]);
+ {'$gen_sync_event', {From,_Tag}, Event} ->
+ io:format(Dev,
+ "*DBG* ~tp got sync_event ~tp "
+ "from ~tw in state ~tw~n",
+ [Name, Event, From, StateName]);
+ {'$gen_sync_all_state_event', {From,_Tag}, Event} ->
+ io:format(Dev,
+ "*DBG* ~tp got sync_all_state_event ~tp "
+ "from ~tw in state ~tw~n",
+ [Name, Event, From, StateName]);
{timeout, Ref, {'$gen_timer', Message}} ->
io:format(Dev,
"*DBG* ~tp got timer ~tp in state ~tw~n",
@@ -473,11 +484,11 @@ print_event(Dev, {in, Msg}, {Name, StateName}) ->
io:format(Dev, "*DBG* ~tp got ~tp in state ~tw~n",
[Name, Msg, StateName])
end;
-print_event(Dev, {out, Msg, To, StateName}, Name) ->
+print_event(Dev, {out, Msg, {To,_Tag}, StateName}, Name) ->
io:format(Dev, "*DBG* ~tp sent ~tp to ~tw~n"
" and switched to state ~tw~n",
[Name, Msg, To, StateName]);
-print_event(Dev, return, {Name, StateName}) ->
+print_event(Dev, {noreply, StateName}, Name) ->
io:format(Dev, "*DBG* ~tp switched to state ~tw~n",
[Name, StateName]).
@@ -495,9 +506,9 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi
reply(From, Reply),
loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, []);
{stop, Reason, NStateData} ->
- terminate(Reason, Name, Msg, Mod, StateName, NStateData, []);
+ terminate(Reason, Name, From, Msg, Mod, StateName, NStateData, []);
{stop, Reason, Reply, NStateData} when From =/= undefined ->
- {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod,
+ {'EXIT', R} = (catch terminate(Reason, Name, From, Msg, Mod,
StateName, NStateData, [])),
reply(From, Reply),
exit(R);
@@ -510,10 +521,10 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi
error_logger=>#{tag=>warning_msg}}),
loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, []);
{'EXIT', What} ->
- terminate(What, Name, Msg, Mod, StateName, StateData, []);
+ terminate(What, Name, From, Msg, Mod, StateName, StateData, []);
Reply ->
terminate({bad_return_value, Reply},
- Name, Msg, Mod, StateName, StateData, [])
+ Name, From, Msg, Mod, StateName, StateData, [])
end.
handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTimeout, Debug) ->
@@ -521,11 +532,11 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi
case catch dispatch(Msg, Mod, StateName, StateData) of
{next_state, NStateName, NStateData} ->
Debug1 = sys:handle_debug(Debug, fun print_event/3,
- {Name, NStateName}, return),
+ Name, {noreply, NStateName}),
loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, Debug1);
{next_state, NStateName, NStateData, Time1} ->
Debug1 = sys:handle_debug(Debug, fun print_event/3,
- {Name, NStateName}, return),
+ Name, {noreply, NStateName}),
loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, Debug1);
{reply, Reply, NStateName, NStateData} when From =/= undefined ->
Debug1 = reply(Name, From, Reply, Debug, NStateName),
@@ -534,17 +545,18 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi
Debug1 = reply(Name, From, Reply, Debug, NStateName),
loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, Debug1);
{stop, Reason, NStateData} ->
- terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug);
+ terminate(
+ Reason, Name, From, Msg, Mod, StateName, NStateData, Debug);
{stop, Reason, Reply, NStateData} when From =/= undefined ->
- {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod,
+ {'EXIT', R} = (catch terminate(Reason, Name, From, Msg, Mod,
StateName, NStateData, Debug)),
_ = reply(Name, From, Reply, Debug, StateName),
exit(R);
{'EXIT', What} ->
- terminate(What, Name, Msg, Mod, StateName, StateData, Debug);
+ terminate(What, Name, From, Msg, Mod, StateName, StateData, Debug);
Reply ->
terminate({bad_return_value, Reply},
- Name, Msg, Mod, StateName, StateData, Debug)
+ Name, From, Msg, Mod, StateName, StateData, Debug)
end.
dispatch({'$gen_event', Event}, Mod, StateName, StateData) ->
@@ -571,24 +583,25 @@ from(_) -> undefined.
reply({To, Tag}, Reply) ->
catch To ! {Tag, Reply}.
-reply(Name, {To, Tag}, Reply, Debug, StateName) ->
- reply({To, Tag}, Reply),
+reply(Name, From, Reply, Debug, StateName) ->
+ reply(From, Reply),
sys:handle_debug(Debug, fun print_event/3, Name,
- {out, Reply, To, StateName}).
+ {out, Reply, From, StateName}).
%%% ---------------------------------------------------
%%% Terminate the server.
%%% ---------------------------------------------------
--spec terminate(term(), _, _, atom(), _, _, _) -> no_return().
+-spec terminate(term(), _, _, _, atom(), _, _, _) -> no_return().
-terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) ->
+terminate(Reason, Name, From, Msg, Mod, StateName, StateData, Debug) ->
case erlang:function_exported(Mod, terminate, 3) of
true ->
case catch Mod:terminate(Reason, StateName, StateData) of
{'EXIT', R} ->
FmtStateData = format_status(terminate, Mod, get(), StateData),
- error_info(R, Name, Msg, StateName, FmtStateData, Debug),
+ error_info(
+ R, Name, From, Msg, StateName, FmtStateData, Debug),
exit(R);
_ ->
ok
@@ -605,29 +618,51 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) ->
exit(Shutdown);
_ ->
FmtStateData1 = format_status(terminate, Mod, get(), StateData),
- error_info(Reason,Name,Msg,StateName,FmtStateData1,Debug),
+ error_info(
+ Reason, Name, From, Msg, StateName, FmtStateData1, Debug),
exit(Reason)
end.
-error_info(Reason, Name, Msg, StateName, StateData, Debug) ->
+error_info(Reason, Name, From, Msg, StateName, StateData, Debug) ->
+ Log = sys:get_log(Debug),
?LOG_ERROR(#{label=>{gen_fsm,terminate},
name=>Name,
last_message=>Msg,
state_name=>StateName,
state_data=>StateData,
- reason=>Reason},
+ log=>Log,
+ reason=>Reason,
+ client_info=>client_stacktrace(From)},
#{domain=>[otp],
report_cb=>fun gen_fsm:format_log/1,
error_logger=>#{tag=>error}}),
- sys:print_log(Debug),
ok.
+client_stacktrace(undefined) ->
+ undefined;
+client_stacktrace({Pid,_Tag}) ->
+ client_stacktrace(Pid);
+client_stacktrace(Pid) when is_pid(Pid), node(Pid) =:= node() ->
+ case process_info(Pid, [current_stacktrace, registered_name]) of
+ undefined ->
+ {Pid,dead};
+ [{current_stacktrace, Stacktrace}, {registered_name, []}] ->
+ {Pid,{Pid,Stacktrace}};
+ [{current_stacktrace, Stacktrace}, {registered_name, Name}] ->
+ {Pid,{Name,Stacktrace}}
+ end;
+client_stacktrace(Pid) when is_pid(Pid) ->
+ {Pid,remote}.
+
+
format_log(#{label:={gen_fsm,terminate},
name:=Name,
last_message:=Msg,
state_name:=StateName,
state_data:=StateData,
- reason:=Reason}) ->
+ log:=Log,
+ reason:=Reason,
+ client_info:=ClientInfo}) ->
Reason1 =
case Reason of
{undef,[{M,F,A,L}|MFAs]} ->
@@ -645,27 +680,39 @@ format_log(#{label:={gen_fsm,terminate},
_ ->
Reason
end,
+ {ClientFmt,ClientArgs} = format_client_log(ClientInfo),
{"** State machine ~tp terminating \n" ++
get_msg_str(Msg) ++
"** When State == ~tp~n"
"** Data == ~tp~n"
- "** Reason for termination = ~n** ~tp~n",
- [Name, get_msg(Msg), StateName, StateData, Reason1]};
+ "** Reason for termination ==~n** ~tp~n" ++
+ case Log of
+ [] -> [];
+ _ -> "** Log ==~n** ~tp~n"
+ end ++ ClientFmt,
+ [Name|error_logger:limit_term(get_msg(Msg))] ++
+ [StateName,
+ error_logger:limit_term(StateData),
+ error_logger:limit_term(Reason1) |
+ case Log of
+ [] -> [];
+ _ -> [[error_logger:limit_term(D) || D <- Log]]
+ end] ++ ClientArgs};
format_log(#{label:={gen_fsm,no_handle_info},
module:=Mod,
message:=Msg}) ->
{"** Undefined handle_info in ~p~n"
"** Unhandled message: ~tp~n",
- [Mod, Msg]}.
+ [Mod, error_logger:limit_term(Msg)]}.
get_msg_str({'$gen_event', _Event}) ->
"** Last event in was ~tp~n";
-get_msg_str({'$gen_sync_event', _Event}) ->
- "** Last sync event in was ~tp~n";
+get_msg_str({'$gen_sync_event', _From, _Event}) ->
+ "** Last sync event in was ~tp from ~tw~n";
get_msg_str({'$gen_all_state_event', _Event}) ->
"** Last event in was ~tp (for all states)~n";
-get_msg_str({'$gen_sync_all_state_event', _Event}) ->
- "** Last sync event in was ~tp (for all states)~n";
+get_msg_str({'$gen_sync_all_state_event', _From, _Event}) ->
+ "** Last sync event in was ~tp (for all states) from ~tw~n";
get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}) ->
"** Last timer event in was ~tp~n";
get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}) ->
@@ -673,13 +720,24 @@ get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}) ->
get_msg_str(_Msg) ->
"** Last message in was ~tp~n".
-get_msg({'$gen_event', Event}) -> Event;
-get_msg({'$gen_sync_event', Event}) -> Event;
-get_msg({'$gen_all_state_event', Event}) -> Event;
-get_msg({'$gen_sync_all_state_event', Event}) -> Event;
-get_msg({timeout, Ref, {'$gen_timer', Msg}}) -> {timeout, Ref, Msg};
-get_msg({timeout, _Ref, {'$gen_event', Event}}) -> Event;
-get_msg(Msg) -> Msg.
+get_msg({'$gen_event', Event}) -> [Event];
+get_msg({'$gen_sync_event', {From,_Tag}, Event}) -> [Event,From];
+get_msg({'$gen_all_state_event', Event}) -> [Event];
+get_msg({'$gen_sync_all_state_event', {From,_Tag}, Event}) -> [Event,From];
+get_msg({timeout, Ref, {'$gen_timer', Msg}}) -> [{timeout, Ref, Msg}];
+get_msg({timeout, _Ref, {'$gen_event', Event}}) -> [Event];
+get_msg(Msg) -> [Msg].
+
+format_client_log(undefined) ->
+ {"", []};
+format_client_log({From,dead}) ->
+ {"** Client ~p is dead~n", [From]};
+format_client_log({From,remote}) ->
+ {"** Client ~p is remote on node ~p~n", [From, node(From)]};
+format_client_log({_From,{Name,Stacktrace}}) ->
+ {"** Client ~tp stacktrace~n"
+ "** ~tp~n",
+ [Name, error_logger:limit_term(Stacktrace)]}.
%%-----------------------------------------------------------------
%% Status information
@@ -689,18 +747,18 @@ format_status(Opt, StatusData) ->
StatusData,
Header = gen:format_status_header("Status for state machine",
Name),
- Log = sys:get_debug(log, Debug, []),
- Specfic = format_status(Opt, Mod, PDict, StateData),
- Specfic = case format_status(Opt, Mod, PDict, StateData) of
- S when is_list(S) -> S;
- S -> [S]
- end,
+ Log = sys:get_log(Debug),
+ Specific =
+ case format_status(Opt, Mod, PDict, StateData) of
+ S when is_list(S) -> S;
+ S -> [S]
+ end,
[{header, Header},
{data, [{"Status", SysState},
{"Parent", Parent},
{"Logged events", Log},
{"StateName", StateName}]} |
- Specfic].
+ Specific].
format_status(Opt, Mod, PDict, State) ->
DefStatus = case Opt of
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 44e9231ebe..c7b6406f54 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -773,10 +773,10 @@ handle_common_reply(Reply, Parent, Name, From, Msg, Mod, HibernateAfterTimeout,
terminate({bad_return_value, BadReply}, ?STACKTRACE(), Name, From, Msg, Mod, State, Debug)
end.
-reply(Name, {To, Tag}, Reply, State, Debug) ->
- reply({To, Tag}, Reply),
+reply(Name, From, Reply, State, Debug) ->
+ reply(From, Reply),
sys:handle_debug(Debug, fun print_event/3, Name,
- {out, Reply, To, State} ).
+ {out, Reply, From, State} ).
%%-----------------------------------------------------------------
@@ -810,7 +810,7 @@ system_replace_state(StateFun, [Name, State, Mod, Time, HibernateAfterTimeout])
print_event(Dev, {in, Msg}, Name) ->
case Msg of
{'$gen_call', {From, _Tag}, Call} ->
- io:format(Dev, "*DBG* ~tp got call ~tp from ~w~n",
+ io:format(Dev, "*DBG* ~tp got call ~tp from ~tw~n",
[Name, Call, From]);
{'$gen_cast', Cast} ->
io:format(Dev, "*DBG* ~tp got cast ~tp~n",
@@ -818,8 +818,8 @@ print_event(Dev, {in, Msg}, Name) ->
_ ->
io:format(Dev, "*DBG* ~tp got ~tp~n", [Name, Msg])
end;
-print_event(Dev, {out, Msg, To, State}, Name) ->
- io:format(Dev, "*DBG* ~tp sent ~tp to ~w, new state ~tp~n",
+print_event(Dev, {out, Msg, {To,_Tag}, State}, Name) ->
+ io:format(Dev, "*DBG* ~tp sent ~tp to ~tw, new state ~tp~n",
[Name, Msg, To, State]);
print_event(Dev, {noreply, State}, Name) ->
io:format(Dev, "*DBG* ~tp new state ~tp~n", [Name, State]);
@@ -885,16 +885,17 @@ error_info(_Reason, application_controller, _From, _Msg, _Mod, _State, _Debug) -
%% of it instead
ok;
error_info(Reason, Name, From, Msg, Mod, State, Debug) ->
+ Log = sys:get_log(Debug),
?LOG_ERROR(#{label=>{gen_server,terminate},
name=>Name,
last_message=>Msg,
state=>format_status(terminate, Mod, get(), State),
+ log=>format_log_state(Mod, Log),
reason=>Reason,
client_info=>client_stacktrace(From)},
#{domain=>[otp],
report_cb=>fun gen_server:format_log/1,
error_logger=>#{tag=>error}}),
- sys:print_log(Debug),
ok.
client_stacktrace(undefined) ->
@@ -917,6 +918,7 @@ format_log(#{label:={gen_server,terminate},
name:=Name,
last_message:=Msg,
state:=State,
+ log:=Log,
reason:=Reason,
client_info:=Client}) ->
Reason1 =
@@ -934,20 +936,30 @@ format_log(#{label:={gen_server,terminate},
end
end;
_ ->
- error_logger:limit_term(Reason)
+ Reason
end,
{ClientFmt,ClientArgs} = format_client_log(Client),
+ [LimitedMsg,LimitedState,LimitedReason|LimitedLog] =
+ [error_logger:limit_term(D) || D <- [Msg,State,Reason1|Log]],
{"** Generic server ~tp terminating \n"
"** Last message in was ~tp~n"
"** When Server state == ~tp~n"
- "** Reason for termination == ~n** ~tp~n" ++ ClientFmt,
- [Name, Msg, error_logger:limit_term(State), Reason1] ++ ClientArgs};
+ "** Reason for termination ==~n** ~tp~n" ++
+ case LimitedLog of
+ [] -> [];
+ _ -> "** Log ==~n** ~tp~n"
+ end ++ ClientFmt,
+ [Name, LimitedMsg, LimitedState, LimitedReason] ++
+ case LimitedLog of
+ [] -> [];
+ _ -> [LimitedLog]
+ end ++ ClientArgs};
format_log(#{label:={gen_server,no_handle_info},
module:=Mod,
message:=Msg}) ->
{"** Undefined handle_info in ~p~n"
"** Unhandled message: ~tp~n",
- [Mod, Msg]}.
+ [Mod, error_logger:limit_term(Msg)]}.
format_client_log(undefined) ->
{"", []};
@@ -958,7 +970,7 @@ format_client_log({From,remote}) ->
format_client_log({_From,{Name,Stacktrace}}) ->
{"** Client ~tp stacktrace~n"
"** ~tp~n",
- [Name, Stacktrace]}.
+ [Name, error_logger:limit_term(Stacktrace)]}.
%%-----------------------------------------------------------------
%% Status information
@@ -966,16 +978,25 @@ format_client_log({_From,{Name,Stacktrace}}) ->
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, State, Mod, _Time, _HibernateAfterTimeout]] = StatusData,
Header = gen:format_status_header("Status for generic server", Name),
- Log = sys:get_debug(log, Debug, []),
- Specfic = case format_status(Opt, Mod, PDict, State) of
+ Log = sys:get_log(Debug),
+ Specific = case format_status(Opt, Mod, PDict, State) of
S when is_list(S) -> S;
S -> [S]
end,
[{header, Header},
{data, [{"Status", SysState},
{"Parent", Parent},
- {"Logged events", Log}]} |
- Specfic].
+ {"Logged events", format_log_state(Mod, Log)}]} |
+ Specific].
+
+format_log_state(Mod, Log) ->
+ [case Event of
+ {out,Msg,From,State} ->
+ {out,Msg,From,format_status(terminate, Mod, get(), State)};
+ {noreply,State} ->
+ {noreply,format_status(terminate, Mod, get(), State)};
+ _ -> Event
+ end || Event <- Log].
format_status(Opt, Mod, PDict, State) ->
DefStatus = case Opt of
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 8965af253b..49911eac2c 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -67,6 +67,14 @@
%% Type that is exported just to be documented
-export_type([transition_option/0]).
+%% Type exports for start_link & friends
+-export_type(
+ [server_name/0,
+ server_ref/0,
+ start_opt/0,
+ start_ret/0,
+ enter_loop_opt/0]).
+
%%%==========================================================================
%%% Interface functions.
%%%==========================================================================
@@ -330,6 +338,7 @@
%% Type validation functions
+%% - return true if the value is of the type, false otherwise
-compile(
{inline,
[callback_mode/1, state_enter/1,
@@ -373,71 +382,76 @@ timeout_event_type(Type) ->
-define(
+ relative_timeout(T),
+ ((is_integer(T) andalso 0 =< (T)) orelse (T) =:= infinity)).
+
+-define(
+ absolute_timeout(T),
+ (is_integer(T) orelse (T) =:= infinity)).
+
+-define(
STACKTRACE(),
element(2, erlang:process_info(self(), current_stacktrace))).
-define(not_sys_debug, []).
%%
%% This is a macro to only evaluate arguments if Debug =/= [].
-%% Debug is evaluated multiple times.
+%% Debug is evaluated 2 times.
-define(
- sys_debug(Debug, NameState, Entry),
+ sys_debug(Debug, Extra, SystemEvent),
case begin Debug end of
?not_sys_debug ->
begin Debug end;
_ ->
- sys_debug(begin Debug end, begin NameState end, begin Entry end)
+ sys_debug(
+ begin Debug end, begin Extra end, begin SystemEvent end)
end).
--record(state,
+-record(params,
{callback_mode = undefined :: callback_mode() | undefined,
state_enter = false :: boolean(),
+ parent :: pid(),
module :: atom(),
- name :: atom(),
- state :: term(),
- data :: term(),
+ name :: atom() | pid(),
+ hibernate_after = infinity :: timeout()
+ }).
+
+-record(state,
+ {state_data = {undefined,undefined} ::
+ {State :: term(),Data :: term()},
postponed = [] :: [{event_type(),term()}],
- %%
timers = {#{},#{}} ::
- {%% timer ref => the timer's event type
+ {%% TimerRef => TimeoutType
TimerRefs :: #{reference() => timeout_event_type()},
- %% timer's event type => timer ref
- TimerTypes :: #{timeout_event_type() => reference()}},
- hibernate = false :: boolean(),
- hibernate_after = infinity :: timeout()}).
-
--record(trans_opts,
- {hibernate = false,
- postpone = false,
- timeouts_r = [],
- next_events_r = []}).
+ %% TimeoutType => TimerRef
+ TimeoutTypes :: #{timeout_event_type() => reference()}},
+ hibernate = false :: boolean()
+ }).
%%%==========================================================================
%%% API
-type server_name() ::
- {'global', GlobalName :: term()}
+ {'global', GlobalName :: term()}
| {'via', RegMod :: module(), Name :: term()}
| {'local', atom()}.
-type server_ref() ::
- pid()
+ pid()
| (LocalName :: atom())
| {Name :: atom(), Node :: atom()}
| {'global', GlobalName :: term()}
| {'via', RegMod :: module(), ViaName :: term()}.
--type debug_opt() ::
- {'debug',
- Dbgs ::
- ['trace' | 'log' | 'statistics' | 'debug'
- | {'logfile', string()}]}.
--type hibernate_after_opt() ::
- {'hibernate_after', HibernateAfterTimeout :: timeout()}.
-type start_opt() ::
- debug_opt()
- | {'timeout', Time :: timeout()}
- | hibernate_after_opt()
- | {'spawn_opt', [proc_lib:spawn_option()]}.
--type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}.
+ {'timeout', Time :: timeout()}
+ | {'spawn_opt', [proc_lib:spawn_option()]}
+ | enter_loop_opt().
+-type start_ret() ::
+ {'ok', pid()}
+ | 'ignore'
+ | {'error', term()}.
+-type enter_loop_opt() ::
+ {'hibernate_after', HibernateAfterTimeout :: timeout()}
+ | {'debug', Dbgs :: [sys:debug_option()]}.
@@ -550,14 +564,14 @@ reply({To,Tag}, Reply) when is_pid(To) ->
%% started by proc_lib into a state machine using
%% the same arguments as you would have returned from init/1
-spec enter_loop(
- Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()],
+ Module :: module(), Opts :: [enter_loop_opt()],
State :: state(), Data :: data()) ->
no_return().
enter_loop(Module, Opts, State, Data) ->
enter_loop(Module, Opts, State, Data, self()).
%%
-spec enter_loop(
- Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()],
+ Module :: module(), Opts :: [enter_loop_opt()],
State :: state(), Data :: data(),
Server_or_Actions ::
server_name() | pid() | [action()]) ->
@@ -571,7 +585,7 @@ enter_loop(Module, Opts, State, Data, Server_or_Actions) ->
end.
%%
-spec enter_loop(
- Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()],
+ Module :: module(), Opts :: [enter_loop_opt()],
State :: state(), Data :: data(),
Server :: server_name() | pid(),
Actions :: [action()] | action()) ->
@@ -579,7 +593,12 @@ enter_loop(Module, Opts, State, Data, Server_or_Actions) ->
enter_loop(Module, Opts, State, Data, Server, Actions) ->
is_atom(Module) orelse error({atom,Module}),
Parent = gen:get_parent(),
- enter(Module, Opts, State, Data, Server, Actions, Parent).
+ Name = gen:get_proc_name(Server),
+ Debug = gen:debug_options(Name, Opts),
+ HibernateAfterTimeout = gen:hibernate_after(Opts),
+ enter(
+ Parent, Debug, Module, Name, HibernateAfterTimeout,
+ State, Data, Actions).
%%---------------------------------------------------------------------------
%% API helpers
@@ -651,36 +670,29 @@ send(Proc, Msg) ->
ok.
%% Here the init_it/6 and enter_loop/5,6,7 functions converge
-enter(Module, Opts, State, Data, Server, Actions, Parent) ->
+enter(
+ Parent, Debug, Module, Name, HibernateAfterTimeout,
+ State, Data, Actions) ->
%% The values should already have been type checked
- Name = gen:get_proc_name(Server),
- Debug = gen:debug_options(Name, Opts),
- HibernateAfterTimeout = gen:hibernate_after(Opts),
- Events = [],
- Event = {internal,init_state},
+ Q = [{internal,init_state}],
%% We enforce {postpone,false} to ensure that
%% our fake Event gets discarded, thought it might get logged
- NewActions = listify(Actions) ++ [{postpone,false}],
- S =
- #state{
+ Actions_1 = listify(Actions) ++ [{postpone,false}],
+ P =
+ #params{
+ parent = Parent,
module = Module,
name = Name,
- state = State,
- data = Data,
hibernate_after = HibernateAfterTimeout},
- CallEnter = true,
- NewDebug = ?sys_debug(Debug, {Name,State}, {enter,Event,State}),
- case call_callback_mode(S) of
- #state{} = NewS ->
- loop_event_actions_list(
- Parent, NewDebug, NewS,
- Events, Event, State, Data, false,
- NewActions, CallEnter);
- [Class,Reason,Stacktrace] ->
- terminate(
- Class, Reason, Stacktrace, NewDebug,
- S, [Event|Events])
- end.
+ S = #state{state_data = {State,Data}},
+ Debug_1 = ?sys_debug(Debug, Name, {enter,State}),
+ loop_callback_mode(
+ P, Debug_1, S, Q, {State,Data},
+ %% Tunneling Actions through CallbackEvent here...
+ %% Special path to go to action handling, after first
+ %% finding out the callback mode. CallbackEvent is
+ %% a 2-tuple and Actions a list, which achieves this distinction.
+ Actions_1).
%%%==========================================================================
%%% gen callbacks
@@ -688,34 +700,46 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
init_it(Starter, self, ServerRef, Module, Args, Opts) ->
init_it(Starter, self(), ServerRef, Module, Args, Opts);
init_it(Starter, Parent, ServerRef, Module, Args, Opts) ->
+ Name = gen:get_proc_name(ServerRef),
+ Debug = gen:debug_options(Name, Opts),
+ HibernateAfterTimeout = gen:hibernate_after(Opts),
try Module:init(Args) of
Result ->
- init_result(Starter, Parent, ServerRef, Module, Result, Opts)
+ init_result(
+ Starter, Parent, ServerRef, Module, Result,
+ Name, Debug, HibernateAfterTimeout)
catch
Result ->
- init_result(Starter, Parent, ServerRef, Module, Result, Opts);
+ init_result(
+ Starter, Parent, ServerRef, Module, Result,
+ Name, Debug, HibernateAfterTimeout);
Class:Reason:Stacktrace ->
- Name = gen:get_proc_name(ServerRef),
gen:unregister_name(ServerRef),
proc_lib:init_ack(Starter, {error,Reason}),
error_info(
- Class, Reason, Stacktrace,
- #state{name = Name},
- []),
+ Class, Reason, Stacktrace, Debug,
+ #params{parent = Parent, name = Name, module = Module},
+ #state{}, []),
erlang:raise(Class, Reason, Stacktrace)
end.
%%---------------------------------------------------------------------------
%% gen callbacks helpers
-init_result(Starter, Parent, ServerRef, Module, Result, Opts) ->
+init_result(
+ Starter, Parent, ServerRef, Module, Result,
+ Name, Debug, HibernateAfterTimeout) ->
case Result of
{ok,State,Data} ->
proc_lib:init_ack(Starter, {ok,self()}),
- enter(Module, Opts, State, Data, ServerRef, [], Parent);
+ enter(
+ Parent, Debug, Module, Name, HibernateAfterTimeout,
+ State, Data, []);
{ok,State,Data,Actions} ->
proc_lib:init_ack(Starter, {ok,self()}),
- enter(Module, Opts, State, Data, ServerRef, Actions, Parent);
+ enter(
+ Parent, Debug, Module, Name, HibernateAfterTimeout,
+ State, Data, Actions);
{stop,Reason} ->
gen:unregister_name(ServerRef),
proc_lib:init_ack(Starter, {error,Reason}),
@@ -725,31 +749,34 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) ->
proc_lib:init_ack(Starter, ignore),
exit(normal);
_ ->
- Name = gen:get_proc_name(ServerRef),
gen:unregister_name(ServerRef),
Error = {bad_return_from_init,Result},
proc_lib:init_ack(Starter, {error,Error}),
error_info(
- error, Error, ?STACKTRACE(),
- #state{name = Name},
- []),
+ error, Error, ?STACKTRACE(), Debug,
+ #params{parent = Parent, name = Name, module = Module},
+ #state{}, []),
exit(Error)
end.
%%%==========================================================================
%%% sys callbacks
+%%%
+%%% We use {P,S} as state (Misc) for the sys module,
+%%% wrap/unwrap it for the server loop* and update
+%%% P#params{parent = Parent}.
-system_continue(Parent, Debug, S) ->
- loop(Parent, Debug, S).
+system_continue(Parent, Debug, {P,S}) ->
+ loop(update_parent(P, Parent), Debug, S).
-system_terminate(Reason, _Parent, Debug, S) ->
- terminate(exit, Reason, ?STACKTRACE(), Debug, S, []).
+system_terminate(Reason, Parent, Debug, {P,S}) ->
+ terminate(
+ exit, Reason, ?STACKTRACE(),
+ update_parent(P, Parent), Debug, S, []).
system_code_change(
- #state{
- module = Module,
- state = State,
- data = Data} = S,
+ {#params{module = Module} = P,
+ #state{state_data = {State,Data}} = S},
_Mod, OldVsn, Extra) ->
case
try Module:code_change(OldVsn, State, Data, Extra)
@@ -759,44 +786,54 @@ system_code_change(
of
{ok,NewState,NewData} ->
{ok,
- S#state{
- callback_mode = undefined,
- state = NewState,
- data = NewData}};
+ {P#params{callback_mode = undefined},
+ S#state{state_data = {NewState,NewData}}}};
{ok,_} = Error ->
error({case_clause,Error});
Error ->
Error
end.
-system_get_state(#state{state = State, data = Data}) ->
- {ok,{State,Data}}.
+system_get_state({_P,#state{state_data = State_Data}}) ->
+ {ok,State_Data}.
system_replace_state(
- StateFun,
- #state{
- state = State,
- data = Data} = S) ->
- {NewState,NewData} = Result = StateFun({State,Data}),
- {ok,Result,S#state{state = NewState, data = NewData}}.
+ StateFun, {P,#state{state_data = State_Data} = S}) ->
+ %%
+ NewState_NewData = StateFun(State_Data),
+ {ok,NewState_NewData,{P,S#state{state_data = NewState_NewData}}}.
format_status(
Opt,
[PDict,SysState,Parent,Debug,
- #state{name = Name, postponed = P} = S]) ->
+ {#params{name = Name} = P,
+ #state{postponed = Postponed} = S}]) ->
Header = gen:format_status_header("Status for state machine", Name),
- Log = sys:get_debug(log, Debug, []),
+ Log = sys:get_log(Debug),
[{header,Header},
{data,
[{"Status",SysState},
{"Parent",Parent},
{"Logged Events",Log},
- {"Postponed",P}]} |
- case format_status(Opt, PDict, S) of
+ {"Postponed",Postponed}]} |
+ case format_status(Opt, PDict, update_parent(P, Parent), S) of
L when is_list(L) -> L;
T -> [T]
end].
+%% Update #params.parent only if it differs. This should not
+%% be possible today (OTP-22.0), but could happen for example
+%% if someone implements changing a server's parent
+%% in a new sys call.
+-compile({inline, update_parent/2}).
+update_parent(P, Parent) ->
+ case P of
+ #params{parent = Parent} ->
+ P;
+ #params{} ->
+ P#params{parent = Parent}
+ end.
+
%%---------------------------------------------------------------------------
%% Format debug messages. Print them as the call-back module sees
%% them, not as the real erlang messages. Use trace for that.
@@ -805,34 +842,46 @@ format_status(
sys_debug(Debug, NameState, Entry) ->
sys:handle_debug(Debug, fun print_event/3, NameState, Entry).
-print_event(Dev, {in,Event}, {Name,State}) ->
- io:format(
- Dev, "*DBG* ~tp receive ~ts in state ~tp~n",
- [Name,event_string(Event),State]);
-print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) ->
- io:format(
- Dev, "*DBG* ~tp send ~tp to ~p from state ~tp~n",
- [Name,Reply,To,State]);
-print_event(Dev, {terminate,Reason}, {Name,State}) ->
- io:format(
- Dev, "*DBG* ~tp terminate ~tp in state ~tp~n",
- [Name,Reason,State]);
-print_event(Dev, {Tag,Event,NextState}, {Name,State}) ->
- StateString =
- case NextState of
- State ->
- io_lib:format("~tp", [State]);
- _ ->
- io_lib:format("~tp => ~tp", [State,NextState])
- end,
- io:format(
- Dev, "*DBG* ~tp ~tw ~ts in state ~ts~n",
- [Name,Tag,event_string(Event),StateString]).
+print_event(Dev, SystemEvent, Name) ->
+ case SystemEvent of
+ {in,Event,State} ->
+ io:format(
+ Dev, "*DBG* ~tp receive ~ts in state ~tp~n",
+ [Name,event_string(Event),State]);
+ {code_change,Event,State} ->
+ io:format(
+ Dev, "*DBG* ~tp receive ~ts after code change in state ~tp~n",
+ [Name,event_string(Event),State]);
+ {out,Reply,{To,_Tag}} ->
+ io:format(
+ Dev, "*DBG* ~tp send ~tp to ~tw~n",
+ [Name,Reply,To]);
+ {enter,State} ->
+ io:format(
+ Dev, "*DBG* ~tp enter in state ~tp~n",
+ [Name,State]);
+ {terminate,Reason,State} ->
+ io:format(
+ Dev, "*DBG* ~tp terminate ~tp in state ~tp~n",
+ [Name,Reason,State]);
+ {Tag,Event,State,NextState}
+ when Tag =:= postpone; Tag =:= consume ->
+ StateString =
+ case NextState of
+ State ->
+ io_lib:format("~tp", [State]);
+ _ ->
+ io_lib:format("~tp => ~tp", [State,NextState])
+ end,
+ io:format(
+ Dev, "*DBG* ~tp ~tw ~ts in state ~ts~n",
+ [Name,Tag,event_string(Event),StateString])
+ end.
event_string(Event) ->
case Event of
{{call,{Pid,_Tag}},Request} ->
- io_lib:format("call ~tp from ~w", [Request,Pid]);
+ io_lib:format("call ~tp from ~tw", [Request,Pid]);
{EventType,EventContent} ->
io_lib:format("~tw ~tp", [EventType,EventContent])
end.
@@ -840,874 +889,1169 @@ event_string(Event) ->
%%%==========================================================================
%%% Internal callbacks
-wakeup_from_hibernate(Parent, Debug, S) ->
+wakeup_from_hibernate(P, Debug, S) ->
%% It is a new message that woke us up so we have to receive it now
- loop_receive(Parent, Debug, S).
+ loop_receive(P, Debug, S).
%%%==========================================================================
-%%% State Machine engine implementation of proc_lib/gen server
+%%% State Machine engine implementation on proc_lib/gen
%% Server loop, consists of all loop* functions
%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3
+%%
+%% The loop tries to keep all temporary values in arguments
+%% and takes shortcuts for ?not_sys_debug, empty lists, etc.
+%% The engine state #state{} is picked apart during the loop,
+%% new values are kept in arguments, and a new #state{} is
+%% composed at the end of the loop. #params{} collect engine
+%% state fields that rarely changes.
+%%
+%% The loop is optimized a bit for staying in the loop, assuming that
+%% system events are rare. So a detour to sys requires re-packing
+%% of the engine state.
%% Entry point for system_continue/3
-loop(Parent, Debug, #state{hibernate = true} = S) ->
- loop_hibernate(Parent, Debug, S);
-loop(Parent, Debug, S) ->
- loop_receive(Parent, Debug, S).
+%%
+loop(P, Debug, #state{hibernate = true} = S) ->
+ loop_hibernate(P, Debug, S);
+loop(P, Debug, S) ->
+ loop_receive(P, Debug, S).
-loop_hibernate(Parent, Debug, S) ->
+%% Go to hibernation
+%%
+loop_hibernate(P, Debug, S) ->
%%
%% Does not return but restarts process at
%% wakeup_from_hibernate/3 that jumps to loop_receive/3
%%
- proc_lib:hibernate(
- ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
+ proc_lib:hibernate(?MODULE, wakeup_from_hibernate, [P, Debug, S]),
error(
{should_not_have_arrived_here_but_instead_in,
- {wakeup_from_hibernate,3}}).
+ {?MODULE,wakeup_from_hibernate,3}}).
+
%% Entry point for wakeup_from_hibernate/3
+%%
+%% Receive a new process message
+%%
loop_receive(
- Parent, Debug, #state{hibernate_after = HibernateAfterTimeout} = S) ->
+ #params{hibernate_after = HibernateAfterTimeout} = P, Debug, S) ->
%%
receive
Msg ->
case Msg of
+ {'$gen_call',From,Request} ->
+ loop_receive_result(P, Debug, S, {{call,From},Request});
+ {'$gen_cast',Cast} ->
+ loop_receive_result(P, Debug, S, {cast,Cast});
+ %%
+ {timeout,TimerRef,TimeoutMsg} ->
+ {TimerRefs,TimeoutTypes} = S#state.timers,
+ case TimerRefs of
+ #{TimerRef := TimeoutType} ->
+ %% Our timer
+ Timers =
+ {maps:remove(TimerRef, TimerRefs),
+ maps:remove(TimeoutType, TimeoutTypes)},
+ S_1 = S#state{timers = Timers},
+ loop_receive_result(
+ P, Debug, S_1, {TimeoutType,TimeoutMsg});
+ #{} ->
+ loop_receive_result(P, Debug, S, {info,Msg})
+ end;
+ %%
{system,Pid,Req} ->
%% Does not return but tail recursively calls
%% system_continue/3 that jumps to loop/3
sys:handle_system_msg(
- Req, Pid, Parent, ?MODULE, Debug, S,
+ Req, Pid, P#params.parent, ?MODULE, Debug,
+ {P,S},
S#state.hibernate);
- {'EXIT',Parent,Reason} = EXIT ->
- %% EXIT is not a 2-tuple therefore
- %% not an event but this will stand out
- %% in the crash report...
- Q = [EXIT],
- terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q);
- {timeout,TimerRef,TimerMsg} ->
- case S#state.timers of
- {#{TimerRef := TimerType} = TimerRefs,TimerTypes} ->
- %% Our timer
- NewTimers =
- {maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes)},
- loop_receive_result(
- Parent, Debug,
- S#state{timers = NewTimers},
- TimerType, TimerMsg);
- {#{},_} ->
- %% Not our timer; present it as an event
- loop_receive_result(Parent, Debug, S, info, Msg)
- end;
- _ ->
- %% External msg
- case Msg of
- {'$gen_call',From,Request} ->
- loop_receive_result(
- Parent, Debug, S, {call,From}, Request);
- {'$gen_cast',Cast} ->
- loop_receive_result(Parent, Debug, S, cast, Cast);
+ {'EXIT',Pid,Reason} ->
+ case P#params.parent of
+ Pid ->
+ terminate(
+ exit, Reason, ?STACKTRACE(), P, Debug, S, []);
_ ->
- loop_receive_result(Parent, Debug, S, info, Msg)
- end
+ loop_receive_result(P, Debug, S, {info,Msg})
+ end;
+ %%
+ _ ->
+ loop_receive_result(P, Debug, S, {info,Msg})
end
after
- HibernateAfterTimeout ->
- loop_hibernate(Parent, Debug, S)
+ HibernateAfterTimeout ->
+ loop_hibernate(P, Debug, S)
end.
-loop_receive_result(Parent, ?not_sys_debug, S, Type, Content) ->
+%% We have received an event
+%%
+loop_receive_result(P, ?not_sys_debug = Debug, S, Event) ->
%% Here is the queue of not yet handled events created
Events = [],
- loop_event(Parent, ?not_sys_debug, S, Events, Type, Content);
+ loop_event(P, Debug, S, Event, Events);
loop_receive_result(
- Parent, Debug, #state{name = Name, state = State} = S, Type, Content) ->
- NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}),
+ #params{name = Name, callback_mode = CallbackMode} = P, Debug,
+ #state{state_data = {State,_Data}} = S, Event) ->
+ Debug_1 =
+ case CallbackMode of
+ undefined ->
+ sys_debug(Debug, Name, {code_change,Event,State});
+ _ ->
+ sys_debug(Debug, Name, {in,Event,State})
+ end,
%% Here is the queue of not yet handled events created
Events = [],
- loop_event(Parent, NewDebug, S, Events, Type, Content).
+ loop_event(P, Debug_1, S, Event, Events).
-%% Entry point for handling an event, received or enqueued
+%% Handle one event; received or enqueued
+%%
loop_event(
- Parent, Debug, #state{hibernate = Hibernate} = S,
- Events, Type, Content) ->
+ P, Debug, #state{hibernate = true} = S, Event, Events) ->
%%
- case Hibernate of
- true ->
- %%
- %% If (this old) Hibernate is true here it can only be
- %% because it was set from an event action
- %% and we did not go into hibernation since there were
- %% events in queue, so we do what the user
- %% might rely on i.e collect garbage which
- %% would have happened if we actually hibernated
- %% and immediately was awakened.
- %%
- _ = garbage_collect(),
- loop_event_state_function(
- Parent, Debug, S, Events, Type, Content);
- false ->
- loop_event_state_function(
- Parent, Debug, S, Events, Type, Content)
- end.
+ %% If (this old) Hibernate is true here it can only be
+ %% because it was set from an event action
+ %% and we did not go into hibernation since there were
+ %% events in queue, so we do what the user
+ %% might rely on i.e collect garbage which
+ %% would have happened if we actually hibernated
+ %% and immediately was awakened.
+ %%
+ _ = garbage_collect(),
+ loop_event_handler(P, Debug, S, Event, Events);
+loop_event(P, Debug, S, Event, Events) ->
+ loop_event_handler(P, Debug, S, Event, Events).
-%% Call the state function
-loop_event_state_function(
- Parent, Debug,
- #state{state = State, data = Data} = S,
- Events, Type, Content) ->
+%% Call the state function, eventually
+%%
+-compile({inline, [loop_event_handler/5]}).
+loop_event_handler(
+ P, Debug, #state{state_data = State_Data} = S, Event, Events) ->
%%
%% The field 'hibernate' in S is now invalid and will be
- %% restored when looping back to loop/3 or loop_event/6.
+ %% restored when looping back to loop/3 or loop_event/5.
%%
- Event = {Type,Content},
- TransOpts = false,
- case call_state_function(S, Type, Content, State, Data) of
- {Result, NewS} ->
- loop_event_result(
- Parent, Debug, NewS,
- Events, Event, State, Data, TransOpts, Result);
- [Class,Reason,Stacktrace] ->
- terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
- end.
+ Q = [Event|Events],
+ loop_callback_mode(P, Debug, S, Q, State_Data, Event).
-%% Make a state enter call to the state function
-loop_event_state_enter(
- Parent, Debug, #state{state = PrevState} = S,
- Events, Event, NextState, NewData, TransOpts) ->
+%% Figure out the callback mode
+%%
+loop_callback_mode(
+ #params{callback_mode = undefined} = P, Debug, S,
+ Q, State_Data, CallbackEvent) ->
%%
- case call_state_function(S, enter, PrevState, NextState, NewData) of
- {Result, NewS} ->
- loop_event_result(
- Parent, Debug, NewS,
- Events, Event, NextState, NewData, TransOpts, Result);
- [Class,Reason,Stacktrace] ->
+ Module = P#params.module,
+ try Module:callback_mode() of
+ CallbackMode ->
+ loop_callback_mode_result(
+ P, Debug, S,
+ Q, State_Data, CallbackEvent,
+ CallbackMode, listify(CallbackMode), undefined, false)
+ catch
+ CallbackMode ->
+ loop_callback_mode_result(
+ P, Debug, S,
+ Q, State_Data, CallbackEvent,
+ CallbackMode, listify(CallbackMode), undefined, false);
+ Class:Reason:Stacktrace ->
terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
+ Class, Reason, Stacktrace, P, Debug, S, Q)
+ end;
+loop_callback_mode(P, Debug, S, Q, State_Data, CallbackEvent) ->
+ loop_state_callback(P, Debug, S, Q, State_Data, CallbackEvent).
+
+%% Check the result of Module:callback_mode()
+%%
+loop_callback_mode_result(
+ P, Debug, S, Q, State_Data, CallbackEvent,
+ CallbackMode, [H|T], NewCallbackMode, NewStateEnter) ->
+ %%
+ case callback_mode(H) of
+ true ->
+ loop_callback_mode_result(
+ P, Debug, S, Q, State_Data, CallbackEvent,
+ CallbackMode, T, H, NewStateEnter);
+ false ->
+ case state_enter(H) of
+ true ->
+ loop_callback_mode_result(
+ P, Debug, S, Q, State_Data, CallbackEvent,
+ CallbackMode, T, NewCallbackMode, true);
+ false ->
+ terminate(
+ error,
+ {bad_return_from_callback_mode,CallbackMode},
+ ?STACKTRACE(),
+ P, Debug, S, Q)
+ end
+ end;
+loop_callback_mode_result(
+ P, Debug, S, Q, State_Data, CallbackEvent,
+ CallbackMode, [], NewCallbackMode, NewStateEnter) ->
+ %%
+ case NewCallbackMode of
+ undefined ->
+ terminate(
+ error,
+ {bad_return_from_callback_mode,CallbackMode},
+ ?STACKTRACE(),
+ P, Debug, S, Q);
+ _ ->
+ P_1 =
+ P#params{
+ callback_mode = NewCallbackMode,
+ state_enter = NewStateEnter},
+ loop_state_callback(
+ P_1, Debug, S, Q, State_Data, CallbackEvent)
end.
-%% Process the result from the state function.
-%% When TransOpts =:= false it was a state function call,
-%% otherwise it is an option tuple and it was a state enter call.
+
+%% Make a state enter call to the state function, we loop back here
+%% from further down if state enter calls are enabled
+%%
+loop_state_enter(
+ P, Debug, #state{state_data = {PrevState,_PrevData}} = S,
+ Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone) ->
+ %%
+ StateCall = false,
+ CallbackEvent = {enter,PrevState},
+ loop_state_callback(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ StateCall, CallbackEvent).
+
+%% Make a state call (not state enter call) to the state function
+%%
+loop_state_callback(P, Debug, S, Q, State_Data, CallbackEvent) ->
+ NextEventsR = [],
+ Hibernate = false,
+ TimeoutsR = [],
+ Postpone = false,
+ StateCall = true,
+ loop_state_callback(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ StateCall, CallbackEvent).
+%%
+loop_state_callback(
+ #params{callback_mode = CallbackMode, module = Module} = P,
+ Debug, S, Q, {State,Data} = State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ StateCall, {Type,Content}) ->
+ try
+ case CallbackMode of
+ state_functions ->
+ Module:State(Type, Content, Data);
+ handle_event_function ->
+ Module:handle_event(Type, Content, State, Data)
+ end
+ of
+ Result ->
+ loop_state_callback_result(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ StateCall, Result)
+ catch
+ Result ->
+ loop_state_callback_result(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ StateCall, Result);
+ Class:Reason:Stacktrace ->
+ terminate(Class, Reason, Stacktrace, P, Debug, S, Q)
+ end;
+loop_state_callback(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ StateCall, Actions) when is_list(Actions) ->
+ %% Tunneled actions from enter/8
+ CallEnter = true,
+ loop_actions_list(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions).
+
+%% Process the result from the state function
%%
-loop_event_result(
- Parent, Debug, S,
- Events, Event, State, Data, TransOpts, Result) ->
+loop_state_callback_result(
+ P, Debug, S, Q, {State,_Data} = State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ StateCall, Result) ->
%%
case Result of
{next_state,State,NewData} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, NewData, TransOpts,
- [], false);
+ loop_actions(
+ P, Debug, S, Q, {State,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ false);
{next_state,NextState,NewData}
- when TransOpts =:= false ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, NextState, NewData, TransOpts,
- [], true);
+ when StateCall ->
+ loop_actions(
+ P, Debug, S, Q, {NextState,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ true);
{next_state,_NextState,_NewData} ->
terminate(
error,
{bad_state_enter_return_from_state_function,Result},
- ?STACKTRACE(), Debug,
+ ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = Data,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events]);
+ state_data = State_Data,
+ hibernate = Hibernate},
+ Q);
{next_state,State,NewData,Actions} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, NewData, TransOpts,
- Actions, false);
+ loop_actions(
+ P, Debug, S, Q, {State,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ false, StateCall, Actions);
{next_state,NextState,NewData,Actions}
- when TransOpts =:= false ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, NextState, NewData, TransOpts,
- Actions, true);
+ when StateCall ->
+ loop_actions(
+ P, Debug, S, Q, {NextState,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ true, StateCall, Actions);
{next_state,_NextState,_NewData,_Actions} ->
terminate(
error,
{bad_state_enter_return_from_state_function,Result},
- ?STACKTRACE(), Debug,
+ ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = Data,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events]);
+ state_data = State_Data,
+ hibernate = Hibernate},
+ Q);
%%
{keep_state,NewData} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, NewData, TransOpts,
- [], false);
+ loop_actions(
+ P, Debug, S, Q, {State,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ false);
{keep_state,NewData,Actions} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, NewData, TransOpts,
- Actions, false);
+ loop_actions(
+ P, Debug, S, Q, {State,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ false, StateCall, Actions);
%%
keep_state_and_data ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, Data, TransOpts,
- [], false);
+ loop_actions(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ false);
{keep_state_and_data,Actions} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, Data, TransOpts,
- Actions, false);
+ loop_actions(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ false, StateCall, Actions);
%%
{repeat_state,NewData} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, NewData, TransOpts,
- [], true);
+ loop_actions(
+ P, Debug, S, Q, {State,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ true);
{repeat_state,NewData,Actions} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, NewData, TransOpts,
- Actions, true);
+ loop_actions(
+ P, Debug, S, Q, {State,NewData},
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ true, StateCall, Actions);
%%
repeat_state_and_data ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, Data, TransOpts,
- [], true);
+ loop_actions(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ true);
{repeat_state_and_data,Actions} ->
- loop_event_actions(
- Parent, Debug, S,
- Events, Event, State, Data, TransOpts,
- Actions, true);
+ loop_actions(
+ P, Debug, S, Q, State_Data,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ true, StateCall, Actions);
%%
stop ->
terminate(
- exit, normal, ?STACKTRACE(), Debug,
+ exit, normal, ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = Data,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events]);
+ state_data = State_Data,
+ hibernate = Hibernate},
+ Q);
{stop,Reason} ->
terminate(
- exit, Reason, ?STACKTRACE(), Debug,
+ exit, Reason, ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = Data,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events]);
+ state_data = State_Data,
+ hibernate = Hibernate},
+ Q);
{stop,Reason,NewData} ->
terminate(
- exit, Reason, ?STACKTRACE(), Debug,
+ exit, Reason, ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = NewData,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events]);
+ state_data = {State,NewData},
+ hibernate = Hibernate},
+ Q);
%%
{stop_and_reply,Reason,Replies} ->
reply_then_terminate(
- exit, Reason, ?STACKTRACE(), Debug,
+ exit, Reason, ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = Data,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events], Replies);
+ state_data = State_Data,
+ hibernate = Hibernate},
+ Q, Replies);
{stop_and_reply,Reason,Replies,NewData} ->
reply_then_terminate(
- exit, Reason, ?STACKTRACE(), Debug,
+ exit, Reason, ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = NewData,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events], Replies);
+ state_data = {State,NewData},
+ hibernate = Hibernate},
+ Q, Replies);
%%
_ ->
terminate(
error,
{bad_return_from_state_function,Result},
- ?STACKTRACE(), Debug,
+ ?STACKTRACE(), P, Debug,
S#state{
- state = State, data = Data,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events])
+ state_data = State_Data,
+ hibernate = Hibernate},
+ Q)
end.
%% Ensure that Actions are a list
-loop_event_actions(
- Parent, Debug, S,
- Events, Event, NextState, NewerData, TransOpts,
- Actions, CallEnter) ->
- loop_event_actions_list(
- Parent, Debug, S,
- Events, Event, NextState, NewerData, TransOpts,
- listify(Actions), CallEnter).
-
-%% Process actions from the state function
-loop_event_actions_list(
- Parent, Debug, #state{state_enter = StateEnter} = S,
- Events, Event, NextState, NewerData, TransOpts,
- Actions, CallEnter) ->
+%%
+loop_actions(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, _StateCall, []) ->
+ loop_actions(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter);
+loop_actions(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions) ->
%%
- case parse_actions(TransOpts, Debug, S, Actions) of
- {NewDebug,NewTransOpts}
- when StateEnter, CallEnter ->
- loop_event_state_enter(
- Parent, NewDebug, S,
- Events, Event, NextState, NewerData, NewTransOpts);
- {NewDebug,NewTransOpts} ->
- loop_event_done(
- Parent, NewDebug, S,
- Events, Event, NextState, NewerData, NewTransOpts);
- [Class,Reason,Stacktrace,NewDebug] ->
- terminate(
- Class, Reason, Stacktrace, NewDebug,
- S#state{
- state = NextState,
- data = NewerData,
- hibernate = hibernate_in_trans_opts(TransOpts)},
- [Event|Events])
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, listify(Actions)).
+%%
+%% Shortcut for no actions
+-compile({inline, [loop_actions/10]}).
+loop_actions(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter) ->
+ %%
+ %% Shortcut for no actions
+ case CallEnter andalso P#params.state_enter of
+ true ->
+ loop_state_enter(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone);
+ false ->
+ loop_state_transition(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone)
end.
--compile({inline, [hibernate_in_trans_opts/1]}).
-hibernate_in_trans_opts(false) ->
- (#trans_opts{})#trans_opts.hibernate;
-hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) ->
- Hibernate.
-
-parse_actions(false, Debug, S, Actions) ->
- parse_actions(true, Debug, S, Actions, #trans_opts{});
-parse_actions(TransOpts, Debug, S, Actions) ->
- parse_actions(false, Debug, S, Actions, TransOpts).
+%% Process the returned actions
%%
-parse_actions(_StateCall, Debug, _S, [], TransOpts) ->
- {Debug,TransOpts};
-parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) ->
+loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, _StateCall, []) ->
+ %%
+ case P#params.state_enter of
+ true when CallEnter ->
+ loop_state_enter(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone);
+ _ ->
+ loop_state_transition(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone)
+ end;
+loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, [Action|Actions]) ->
+ %%
case Action of
%% Actual actions
{reply,From,Reply} ->
- parse_actions_reply(
- StateCall, Debug, S, Actions, TransOpts, From, Reply);
+ loop_actions_reply(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions,
+ From, Reply);
%%
%% Actions that set options
- {hibernate,NewHibernate} when is_boolean(NewHibernate) ->
- parse_actions(
- StateCall, Debug, S, Actions,
- TransOpts#trans_opts{hibernate = NewHibernate});
+ {hibernate,Hibernate_1} when is_boolean(Hibernate_1) ->
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate_1, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions);
hibernate ->
- parse_actions(
- StateCall, Debug, S, Actions,
- TransOpts#trans_opts{hibernate = true});
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, true, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions);
%%
- {postpone,NewPostpone} when not NewPostpone orelse StateCall ->
- parse_actions(
- StateCall, Debug, S, Actions,
- TransOpts#trans_opts{postpone = NewPostpone});
+ {postpone,Postpone_1} when not Postpone_1 orelse StateCall ->
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone_1,
+ CallEnter, StateCall, Actions);
postpone when StateCall ->
- parse_actions(
- StateCall, Debug, S, Actions,
- TransOpts#trans_opts{postpone = true});
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, true,
+ CallEnter, StateCall, Actions);
postpone ->
- [error,
- {bad_state_enter_action_from_state_function,Action},
- ?STACKTRACE(),
- Debug];
+ terminate(
+ error,
+ {bad_state_enter_action_from_state_function,Action},
+ ?STACKTRACE(), P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ hibernate = Hibernate},
+ Q);
%%
{next_event,Type,Content} ->
- parse_actions_next_event(
- StateCall, Debug, S, Actions, TransOpts, Type, Content);
+ loop_actions_next_event(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions, Type, Content);
%%
- _ ->
- parse_actions_timeout(
- StateCall, Debug, S, Actions, TransOpts, Action)
+ Timeout ->
+ loop_actions_timeout(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions, Timeout)
end.
-parse_actions_reply(
- StateCall, ?not_sys_debug, S, Actions, TransOpts,
+%% Process a reply action
+%%
+loop_actions_reply(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions,
From, Reply) ->
%%
case from(From) of
true ->
+ %% No need for a separate ?not_sys_debug clause here
+ %% since the external call to erlang:'!'/2 in reply/2
+ %% will cause swap out of all live registers anyway
reply(From, Reply),
- parse_actions(StateCall, ?not_sys_debug, S, Actions, TransOpts);
- false ->
- [error,
- {bad_action_from_state_function,{reply,From,Reply}},
- ?STACKTRACE(),
- ?not_sys_debug]
- end;
-parse_actions_reply(
- StateCall, Debug, #state{name = Name, state = State} = S,
- Actions, TransOpts, From, Reply) ->
- %%
- case from(From) of
- true ->
- reply(From, Reply),
- NewDebug = sys_debug(Debug, {Name,State}, {out,Reply,From}),
- parse_actions(StateCall, NewDebug, S, Actions, TransOpts);
+ Debug_1 = ?sys_debug(Debug, P#params.name, {out,Reply,From}),
+ loop_actions_list(
+ P, Debug_1, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions);
false ->
- [error,
- {bad_action_from_state_function,{reply,From,Reply}},
- ?STACKTRACE(),
- Debug]
+ terminate(
+ error,
+ {bad_action_from_state_function,{reply,From,Reply}},
+ ?STACKTRACE(), P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ hibernate = Hibernate},
+ Q)
end.
-parse_actions_next_event(
- StateCall, ?not_sys_debug, S,
- Actions, TransOpts, Type, Content) ->
- case event_type(Type) of
- true when StateCall ->
- NextEventsR = TransOpts#trans_opts.next_events_r,
- parse_actions(
- StateCall, ?not_sys_debug, S, Actions,
- TransOpts#trans_opts{
- next_events_r = [{Type,Content}|NextEventsR]});
- _ ->
- [error,
- {bad_state_enter_action_from_state_function,
- {next_event,Type,Content}},
- ?STACKTRACE(),
- ?not_sys_debug]
- end;
-parse_actions_next_event(
- StateCall, Debug, #state{name = Name, state = State} = S,
- Actions, TransOpts, Type, Content) ->
+%% Process a next_event action
+%%
+loop_actions_next_event(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions, Type, Content) ->
case event_type(Type) of
true when StateCall ->
- NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}),
- NextEventsR = TransOpts#trans_opts.next_events_r,
- parse_actions(
- StateCall, NewDebug, S, Actions,
- TransOpts#trans_opts{
- next_events_r = [{Type,Content}|NextEventsR]});
+ NextEvent = {Type,Content},
+ case Debug of
+ ?not_sys_debug ->
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ [NextEvent|NextEventsR],
+ Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions);
+ _ ->
+ Name = P#params.name,
+ {State,_Data} = S#state.state_data,
+ Debug_1 =
+ sys_debug(Debug, Name, {in,{Type,Content},State}),
+ loop_actions_list(
+ P, Debug_1, S, Q, NextState_NewData,
+ [NextEvent|NextEventsR],
+ Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions)
+ end;
_ ->
- [error,
- {bad_state_enter_action_from_state_function,
- {next_event,Type,Content}},
- ?STACKTRACE(),
- Debug]
+ terminate(
+ error,
+ {if
+ StateCall ->
+ bad_action_from_state_function;
+ true ->
+ bad_state_enter_action_from_state_function
+ end,
+ {next_event,Type,Content}},
+ ?STACKTRACE(), P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ hibernate = Hibernate},
+ Q)
end.
-parse_actions_timeout(
- StateCall, Debug, S, Actions, TransOpts,
- {TimeoutType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) ->
+%% Process a timeout action, or also any unrecognized action
+%%
+loop_actions_timeout(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions,
+ {TimeoutType,Time,TimeoutMsg,TimeoutOpts} = Timeout) ->
%%
- case classify_timeout(TimeoutType, Time, listify(TimerOpts)) of
- absolute ->
- parse_actions_timeout_add(
- StateCall, Debug, S, Actions,
- TransOpts, AbsoluteTimeout);
- relative ->
- RelativeTimeout = {TimeoutType,Time,TimerMsg},
- parse_actions_timeout_add(
- StateCall, Debug, S, Actions,
- TransOpts, RelativeTimeout);
- badarg ->
- [error,
- {bad_action_from_state_function,AbsoluteTimeout},
- ?STACKTRACE(),
- Debug]
+ case timeout_event_type(TimeoutType) of
+ true ->
+ case listify(TimeoutOpts) of
+ %% Optimization cases
+ [] when ?relative_timeout(Time) ->
+ RelativeTimeout = {TimeoutType,Time,TimeoutMsg},
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate,
+ [RelativeTimeout|TimeoutsR], Postpone,
+ CallEnter, StateCall, Actions);
+ [{abs,true}] when ?absolute_timeout(Time) ->
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate,
+ [Timeout|TimeoutsR], Postpone,
+ CallEnter, StateCall, Actions);
+ [{abs,false}] when ?relative_timeout(Time) ->
+ RelativeTimeout = {TimeoutType,Time,TimeoutMsg},
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate,
+ [RelativeTimeout|TimeoutsR], Postpone,
+ CallEnter, StateCall, Actions);
+ %% Generic case
+ TimeoutOptsList ->
+ case parse_timeout_opts_abs(TimeoutOptsList) of
+ true when ?absolute_timeout(Time) ->
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate,
+ [Timeout|TimeoutsR], Postpone,
+ CallEnter, StateCall, Actions);
+ false when ?relative_timeout(Time) ->
+ RelativeTimeout =
+ {TimeoutType,Time,TimeoutMsg},
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate,
+ [RelativeTimeout|TimeoutsR], Postpone,
+ CallEnter, StateCall, Actions);
+ badarg ->
+ terminate(
+ error,
+ {bad_action_from_state_function,Timeout},
+ ?STACKTRACE(), P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ hibernate = Hibernate},
+ Q)
+ end
+ end;
+ false ->
+ terminate(
+ error,
+ {bad_action_from_state_function,Timeout},
+ ?STACKTRACE(), P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ hibernate = Hibernate},
+ Q)
end;
-parse_actions_timeout(
- StateCall, Debug, S, Actions, TransOpts,
- {TimeoutType,Time,_} = RelativeTimeout) ->
- case classify_timeout(TimeoutType, Time, []) of
- relative ->
- parse_actions_timeout_add(
- StateCall, Debug, S, Actions,
- TransOpts, RelativeTimeout);
- badarg ->
- [error,
- {bad_action_from_state_function,RelativeTimeout},
- ?STACKTRACE(),
- Debug]
+loop_actions_timeout(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions,
+ {TimeoutType,Time,_} = Timeout) ->
+ %%
+ case timeout_event_type(TimeoutType) of
+ true when ?relative_timeout(Time) ->
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate,
+ [Timeout|TimeoutsR], Postpone,
+ CallEnter, StateCall, Actions);
+ _ ->
+ terminate(
+ error,
+ {bad_action_from_state_function,Timeout},
+ ?STACKTRACE(), P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ hibernate = Hibernate},
+ Q)
end;
-parse_actions_timeout(
- StateCall, Debug, S, Actions, TransOpts,
- Time) ->
- case classify_timeout(timeout, Time, []) of
- relative ->
+loop_actions_timeout(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone,
+ CallEnter, StateCall, Actions, Time) ->
+ %%
+ if
+ ?relative_timeout(Time) ->
RelativeTimeout = {timeout,Time,Time},
- parse_actions_timeout_add(
- StateCall, Debug, S, Actions,
- TransOpts, RelativeTimeout);
- badarg ->
- [error,
- {bad_action_from_state_function,Time},
- ?STACKTRACE(),
- Debug]
+ loop_actions_list(
+ P, Debug, S, Q, NextState_NewData,
+ NextEventsR, Hibernate,
+ [RelativeTimeout|TimeoutsR], Postpone,
+ CallEnter, StateCall, Actions);
+ true ->
+ terminate(
+ error,
+ {bad_action_from_state_function,Time},
+ ?STACKTRACE(), P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ hibernate = Hibernate},
+ Q)
end.
-parse_actions_timeout_add(
- StateCall, Debug, S, Actions,
- #trans_opts{timeouts_r = TimeoutsR} = TransOpts, Timeout) ->
- parse_actions(
- StateCall, Debug, S, Actions,
- TransOpts#trans_opts{timeouts_r = [Timeout|TimeoutsR]}).
-
%% Do the state transition
-loop_event_done(
- Parent, ?not_sys_debug,
- #state{postponed = P} = S,
- Events, Event, NextState, NewData,
- #trans_opts{
- postpone = Postpone, hibernate = Hibernate,
- timeouts_r = [], next_events_r = []}) ->
- %%
- %% Optimize the simple cases
- %% i.e no timer changes, no inserted events and no debug,
- %% by duplicate stripped down code
- %%
- %% Fast path
- %%
- case Postpone of
- true ->
- loop_event_done_fast(
- Parent, Hibernate,
- S,
- Events, [Event|P], NextState, NewData);
- false ->
- loop_event_done_fast(
- Parent, Hibernate,
- S,
- Events, P, NextState, NewData)
- end;
-loop_event_done(
- Parent, Debug_0,
- #state{
- state = State, postponed = P_0, timers = Timers_0} = S,
- Events_0, Event_0, NextState, NewData,
- #trans_opts{
- hibernate = Hibernate, timeouts_r = TimeoutsR,
- postpone = Postpone, next_events_r = NextEventsR}) ->
+%%
+loop_state_transition(
+ P, Debug, #state{state_data = {State,_Data}, postponed = Postponed} = S,
+ [Event|Events], {NextState,_NewData} = NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postpone) ->
%%
%% All options have been collected and next_events are buffered.
%% Do the actual state transition.
%%
- %% Full feature path
- %%
- [Debug_1|P_1] = % Move current event to postponed if Postpone
+ Postponed_1 = % Move current event to postponed if Postpone
case Postpone of
true ->
- [?sys_debug(
- Debug_0,
- {S#state.name,State},
- {postpone,Event_0,NextState}),
- Event_0|P_0];
+ [Event|Postponed];
false ->
- [?sys_debug(
- Debug_0,
- {S#state.name,State},
- {consume,Event_0,NextState})|P_0]
+ Postponed
end,
- {Events_2,P_2,Timers_2} =
- %% Move all postponed events to queue,
- %% cancel the event timer,
- %% and cancel the state timeout if the state changes
- if
- NextState =:= State ->
- {Events_0,P_1,
- cancel_timer_by_type(timeout, Timers_0)};
- true ->
- {lists:reverse(P_1, Events_0),
- [],
- cancel_timer_by_type(
- state_timeout,
- cancel_timer_by_type(timeout, Timers_0))}
- end,
- {Timers_3,TimeoutEvents} =
- %% Stop and start timers
- parse_timers(Timers_2, TimeoutsR),
- %% Place next events last in reversed queue
- Events_3R = lists:reverse(Events_2, NextEventsR),
- %% Enqueue immediate timeout events
- Events_4R = prepend_timeout_events(TimeoutEvents, Events_3R),
- loop_event_done(
- Parent, Debug_1,
- S#state{
- state = NextState,
- data = NewData,
- postponed = P_2,
- timers = Timers_3,
- hibernate = Hibernate},
- lists:reverse(Events_4R)).
-
-%% Fast path
-%%
-loop_event_done_fast(
- Parent, Hibernate,
- #state{
- state = NextState,
- timers = {_,#{timeout := _}} = Timers} = S,
- Events, P, NextState, NewData) ->
+ case Debug of
+ ?not_sys_debug ->
+ %% Optimization for no sys_debug
+ %% - avoid calling sys_debug/3
+ if
+ NextState =:= State ->
+ loop_keep_state(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed_1);
+ true ->
+ loop_state_change(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed_1)
+ end;
+ _ ->
+ %% With sys_debug
+ Name = P#params.name,
+ Debug_1 =
+ case Postpone of
+ true ->
+ sys_debug(
+ Debug, Name,
+ {postpone,Event,State,NextState});
+ false ->
+ sys_debug(
+ Debug, Name,
+ {consume,Event,State,NextState})
+ end,
+ if
+ NextState =:= State ->
+ loop_keep_state(
+ P, Debug_1, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed_1);
+ true ->
+ loop_state_change(
+ P, Debug_1, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed_1)
+ end
+ end.
+
+%% State transition to the same state
+%%
+loop_keep_state(
+ P, Debug, #state{timers = {TimerRefs,TimeoutTypes} = Timers} = S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed) ->
%%
- %% Same state, event timeout active
+ %% Cancel event timeout
%%
- loop_event_done_fast(
- Parent, Hibernate, S,
- Events, P, NextState, NewData,
- cancel_timer_by_type(timeout, Timers));
-loop_event_done_fast(
- Parent, Hibernate,
- #state{state = NextState} = S,
- Events, P, NextState, NewData) ->
+ case TimeoutTypes of
+ %% Optimization
+ %% - only cancel timer when there is a timer to cancel
+ #{timeout := TimerRef} ->
+ %% Event timeout active
+ loop_next_events(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ cancel_timer_by_ref_and_type(
+ TimerRef, timeout, TimerRefs, TimeoutTypes));
+ _ ->
+ %% No event timeout active
+ loop_next_events(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers)
+ end.
+
+%% State transition to a different state
+%%
+loop_state_change(
+ P, Debug, S, Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed) ->
%%
- %% Same state
+ %% Retry postponed events
%%
- loop_event_done(
- Parent, ?not_sys_debug,
- S#state{
- data = NewData,
- postponed = P,
- hibernate = Hibernate},
- Events);
-loop_event_done_fast(
- Parent, Hibernate,
- #state{
- timers = {_,#{timeout := _}} = Timers} = S,
- Events, P, NextState, NewData) ->
+ case Postponed of
+ [] ->
+ loop_state_change(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR);
+ [E1] ->
+ loop_state_change(
+ P, Debug, S,
+ [E1|Events], NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR);
+ [E2,E1] ->
+ loop_state_change(
+ P, Debug, S,
+ [E1,E2|Events], NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR);
+ _ ->
+ loop_state_change(
+ P, Debug, S,
+ lists:reverse(Postponed, Events), NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR)
+ end.
+%%
+loop_state_change(
+ P, Debug, #state{timers = {TimerRefs,TimeoutTypes} = Timers} = S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR) ->
%%
- %% State change, event timeout active
+ %% Cancel state and event timeout
%%
- loop_event_done_fast(
- Parent, Hibernate, S,
- lists:reverse(P, Events), [], NextState, NewData,
- cancel_timer_by_type(
- state_timeout,
- cancel_timer_by_type(timeout, Timers)));
-loop_event_done_fast(
- Parent, Hibernate,
- #state{
- timers = {_,#{state_timeout := _}} = Timers} = S,
- Events, P, NextState, NewData) ->
+ case TimeoutTypes of
+ %% Optimization
+ %% - only cancel timeout when there is an active timeout
+ %%
+ #{state_timeout := TimerRef} ->
+ %% State timeout active
+ %% - cancel event timeout too since it is faster than inspecting
+ loop_next_events(
+ P, Debug, S, Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, [],
+ cancel_timer_by_type(
+ timeout,
+ cancel_timer_by_ref_and_type(
+ TimerRef, state_timeout, TimerRefs, TimeoutTypes)));
+ #{timeout := TimerRef} ->
+ %% Event timeout active but not state timeout
+ %% - cancel event timeout only
+ loop_next_events(
+ P, Debug, S, Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, [],
+ cancel_timer_by_ref_and_type(
+ TimerRef, timeout, TimerRefs, TimeoutTypes));
+ _ ->
+ %% No state nor event timeout active.
+ loop_next_events(
+ P, Debug, S, Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, [],
+ Timers)
+ end.
+
+%% Continue state transition with processing of
+%% inserted events and timeout events
+%%
+loop_next_events(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, [], Postponed,
+ Timers) ->
%%
- %% State change, state timeout active
+ %% Optimization when there are no timeout actions
+ %% hence no timeout zero events to append to Events
+ %% - avoid loop_timeouts
+ loop_done(
+ P, Debug,
+ S#state{
+ state_data = NextState_NewData,
+ postponed = Postponed,
+ timers = Timers,
+ hibernate = Hibernate},
+ NextEventsR, Events);
+loop_next_events(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers) ->
%%
- loop_event_done_fast(
- Parent, Hibernate, S,
- lists:reverse(P, Events), [], NextState, NewData,
- cancel_timer_by_type(
- state_timeout,
- cancel_timer_by_type(timeout, Timers)));
-loop_event_done_fast(
- Parent, Hibernate,
- #state{} = S,
- Events, P, NextState, NewData) ->
+ Seen = #{},
+ TimeoutEvents = [],
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, TimeoutEvents).
+
+%% Continue state transition with processing of timeout events
+%%
+loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, [], Postponed,
+ Timers, _Seen, TimeoutEvents) ->
%%
- %% State change, no timeout to automatically cancel
+ S_1 =
+ S#state{
+ state_data = NextState_NewData,
+ postponed = Postponed,
+ timers = Timers,
+ hibernate = Hibernate},
+ case TimeoutEvents of
+ [] ->
+ loop_done(P, Debug, S_1, NextEventsR, Events);
+ _ ->
+ case Events of
+ [] ->
+ loop_prepend_timeout_events(
+ P, Debug, S_1, TimeoutEvents,
+ NextEventsR);
+ [E1] ->
+ loop_prepend_timeout_events(
+ P, Debug, S_1, TimeoutEvents,
+ [E1|NextEventsR]);
+ [E2,E1] ->
+ loop_prepend_timeout_events(
+ P, Debug, S_1, TimeoutEvents,
+ [E1,E2|NextEventsR]);
+ _ ->
+ loop_prepend_timeout_events(
+ P, Debug, S_1, TimeoutEvents,
+ lists:reverse(Events, NextEventsR))
+ end
+ end;
+loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, [Timeout|TimeoutsR], Postponed,
+ Timers, Seen, TimeoutEvents) ->
%%
- loop_event_done(
- Parent, ?not_sys_debug,
- S#state{
- state = NextState,
- data = NewData,
- postponed = [],
- hibernate = Hibernate},
- lists:reverse(P, Events)).
+ case Timeout of
+ {TimeoutType,Time,TimeoutMsg} ->
+ %% Relative timeout
+ case Seen of
+ #{TimeoutType := _} ->
+ %% Type seen before - ignore
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, TimeoutEvents);
+ #{} ->
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, TimeoutEvents,
+ TimeoutType, Time, TimeoutMsg, [])
+ end;
+ {TimeoutType,Time,TimeoutMsg,TimeoutOpts} ->
+ %% Absolute timeout
+ case Seen of
+ #{TimeoutType := _} ->
+ %% Type seen before - ignore
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, TimeoutEvents);
+ #{} ->
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, TimeoutEvents,
+ TimeoutType, Time, TimeoutMsg, listify(TimeoutOpts))
+ end
+ end.
%%
-%% Fast path
+loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, TimeoutEvents,
+ TimeoutType, Time, TimeoutMsg, TimeoutOpts) ->
+ %%
+ case Time of
+ infinity ->
+ %% Cancel any running timer
+ loop_timeouts_cancel(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, TimeoutEvents,
+ TimeoutType);
+ 0 when TimeoutOpts =:= [] ->
+ %% Relative timeout zero
+ %% - cancel any running timer
+ %% handle timeout zero events later
+ %%
+ loop_timeouts_cancel(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen, [{TimeoutType,TimeoutMsg}|TimeoutEvents],
+ TimeoutType);
+ _ ->
+ %% (Re)start the timer
+ TimerRef =
+ erlang:start_timer(Time, self(), TimeoutMsg, TimeoutOpts),
+ {TimerRefs,TimeoutTypes} = Timers,
+ case TimeoutTypes of
+ #{TimeoutType := OldTimerRef} ->
+ %% Cancel the running timer,
+ %% update the timeout type,
+ %% insert the new timer ref,
+ %% and remove the old timer ref
+ Timers_1 =
+ {maps:remove(
+ OldTimerRef,
+ TimerRefs#{TimerRef => TimeoutType}),
+ TimeoutTypes#{TimeoutType := TimerRef}},
+ cancel_timer(OldTimerRef),
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers_1, Seen#{TimeoutType => true}, TimeoutEvents);
+ #{} ->
+ %% Insert the new timer type and ref
+ Timers_1 =
+ {TimerRefs#{TimerRef => TimeoutType},
+ TimeoutTypes#{TimeoutType => TimerRef}},
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers_1, Seen#{TimeoutType => true}, TimeoutEvents)
+ end
+ end.
+
+%% Loop helper to cancel a timeout
%%
-loop_event_done_fast(
- Parent, Hibernate, S, Events, P, NextState, NewData, Timers) ->
+loop_timeouts_cancel(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ {TimerRefs,TimeoutTypes} = Timers, Seen, TimeoutEvents,
+ TimeoutType) ->
+ %% This function body should have been:
+ %% Timers_1 = cancel_timer_by_type(TimeoutType, Timers),
+ %% loop_timeouts(
+ %% P, Debug, S,
+ %% Events, NextState_NewData,
+ %% NextEventsR, Hibernate, TimeoutsR, Postponed,
+ %% Timers_1, Seen#{TimeoutType => true}, TimeoutEvents).
%%
- loop_event_done(
- Parent, ?not_sys_debug,
- S#state{
- state = NextState,
- data = NewData,
- postponed = P,
- timers = Timers,
- hibernate = Hibernate},
- Events).
+ %% Explicitly separate cases to get separate code paths for when
+ %% the map key exists vs. not, since otherwise the external call
+ %% to erlang:cancel_timer/1 and to map:remove/2 within
+ %% cancel_timer_by_type/2 would cause all live registers
+ %% to be saved to and restored from the stack also for
+ %% the case when the map key TimeoutType does not exist
+ case TimeoutTypes of
+ #{TimeoutType := TimerRef} ->
+ Timers_1 =
+ cancel_timer_by_ref_and_type(
+ TimerRef, TimeoutType, TimerRefs, TimeoutTypes),
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers_1, Seen#{TimeoutType => true}, TimeoutEvents);
+ #{} ->
+ loop_timeouts(
+ P, Debug, S,
+ Events, NextState_NewData,
+ NextEventsR, Hibernate, TimeoutsR, Postponed,
+ Timers, Seen#{TimeoutType => true}, TimeoutEvents)
+ end.
-loop_event_done(Parent, Debug, S, Q) ->
+%% Continue state transition with prepending timeout zero events
+%% before event queue reversal i.e appending timeout zero events
+%%
+loop_prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR) ->
+ {Debug_1,Events_1R} =
+ prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR),
+ loop_done(P, Debug_1, S, Events_1R, []).
+
+%% Place inserted events first in the event queue
+%%
+loop_done(P, Debug, S, NextEventsR, Events) ->
+ case NextEventsR of
+ [] ->
+ loop_done(P, Debug, S, Events);
+ [E1] ->
+ loop_done(P, Debug, S, [E1|Events]);
+ [E2,E1] ->
+ loop_done(P, Debug, S, [E1,E2|Events]);
+ _ ->
+ loop_done(P, Debug, S, lists:reverse(NextEventsR, Events))
+ end.
+%%
+%% State transition is done, keep looping if there are
+%% enqueued events, otherwise get a new event
+%%
+loop_done(P, Debug, S, Q) ->
+%%% io:format(
+%%% "loop_done: state_data = ~p,~n"
+%%% " postponed = ~p, Q = ~p,~n",
+%%% " timers = ~p.~n"
+%%% [S#state.state_data,,S#state.postponed,Q,S#state.timers]),
case Q of
[] ->
%% Get a new event
- loop(Parent, Debug, S);
- [{Type,Content}|Events] ->
+ loop(P, Debug, S);
+ [Event|Events] ->
%% Loop until out of enqueued events
- loop_event(Parent, Debug, S, Events, Type, Content)
+ loop_event(P, Debug, S, Event, Events)
end.
-
%%---------------------------------------------------------------------------
%% Server loop helpers
-call_callback_mode(#state{module = Module} = S) ->
- try Module:callback_mode() of
- CallbackMode ->
- callback_mode_result(S, CallbackMode)
- catch
- CallbackMode ->
- callback_mode_result(S, CallbackMode);
- Class:Reason:Stacktrace ->
- [Class,Reason,Stacktrace]
- end.
-
-callback_mode_result(S, CallbackMode) ->
- callback_mode_result(
- S, CallbackMode, listify(CallbackMode), undefined, false).
-%%
-callback_mode_result(_S, CallbackMode, [], undefined, _StateEnter) ->
- [error,
- {bad_return_from_callback_mode,CallbackMode},
- ?STACKTRACE()];
-callback_mode_result(S, _CallbackMode, [], CBMode, StateEnter) ->
- S#state{callback_mode = CBMode, state_enter = StateEnter};
-callback_mode_result(S, CallbackMode, [H|T], CBMode, StateEnter) ->
- case callback_mode(H) of
- true ->
- callback_mode_result(S, CallbackMode, T, H, StateEnter);
- false ->
- case state_enter(H) of
- true ->
- callback_mode_result(S, CallbackMode, T, CBMode, true);
- false ->
- [error,
- {bad_return_from_callback_mode,CallbackMode},
- ?STACKTRACE()]
- end
- end.
-
-
-call_state_function(
- #state{callback_mode = undefined} = S, Type, Content, State, Data) ->
- case call_callback_mode(S) of
- #state{} = NewS ->
- call_state_function(NewS, Type, Content, State, Data);
- Error ->
- Error
- end;
-call_state_function(
- #state{callback_mode = CallbackMode, module = Module} = S,
- Type, Content, State, Data) ->
- try
- case CallbackMode of
- state_functions ->
- Module:State(Type, Content, Data);
- handle_event_function ->
- Module:handle_event(Type, Content, State, Data)
- end
- of
- Result ->
- {Result,S}
- catch
- Result ->
- {Result,S};
- Class:Reason:Stacktrace ->
- [Class,Reason,Stacktrace]
- end.
-
-
-%% -> absolute | relative | badarg
-classify_timeout(TimeoutType, Time, Opts) ->
- case timeout_event_type(TimeoutType) of
- true ->
- classify_time(false, Time, Opts);
- false ->
- badarg
- end.
-
-classify_time(Abs, Time, []) ->
- case Abs of
- true when
- is_integer(Time);
- Time =:= infinity ->
- absolute;
- false when
- is_integer(Time), 0 =< Time;
- Time =:= infinity ->
- relative;
- _ ->
- badarg
- end;
-classify_time(_, Time, [{abs,Abs}|Opts]) when is_boolean(Abs) ->
- classify_time(Abs, Time, Opts);
-classify_time(_, _, Opts) when is_list(Opts) ->
- badarg.
-
-%% Stop and start timers as well as create timeout zero events
-%% and pending event timer
+%% Parse an option list for erlang:start_timer/4 to figure out
+%% if the timeout will be absolute or relative
%%
-%% Stop and start timers non-event timers
-parse_timers(Timers, TimeoutsR) ->
- parse_timers(Timers, TimeoutsR, #{}, []).
+parse_timeout_opts_abs(Opts) ->
+ parse_timeout_opts_abs(Opts, false).
%%
-parse_timers(Timers, [], _Seen, TimeoutEvents) ->
- %%
- {Timers,TimeoutEvents};
-parse_timers(
- Timers, [Timeout|TimeoutsR], Seen, TimeoutEvents) ->
- %%
- case Timeout of
- {TimerType,Time,TimerMsg,TimerOpts} ->
- %% Absolute timer
- parse_timers(
- Timers, TimeoutsR, Seen, TimeoutEvents,
- TimerType, Time, TimerMsg, listify(TimerOpts));
- %% Relative timers below
- {TimerType,0,TimerMsg} ->
- parse_timers(
- Timers, TimeoutsR, Seen, TimeoutEvents,
- TimerType, zero, TimerMsg, []);
- {TimerType,Time,TimerMsg} ->
- parse_timers(
- Timers, TimeoutsR, Seen, TimeoutEvents,
- TimerType, Time, TimerMsg, [])
- end.
-
-parse_timers(
- Timers, TimeoutsR, Seen, TimeoutEvents,
- TimerType, Time, TimerMsg, TimerOpts) ->
- case Seen of
- #{TimerType := _} ->
- %% Type seen before - ignore
- parse_timers(
- Timers, TimeoutsR, Seen, TimeoutEvents);
- #{} ->
- %% Unseen type - handle
- NewSeen = Seen#{TimerType => true},
- case Time of
- infinity ->
- %% Cancel any running timer
- parse_timers(
- cancel_timer_by_type(TimerType, Timers),
- TimeoutsR, NewSeen, TimeoutEvents);
- zero ->
- %% Cancel any running timer
- %% Handle zero time timeouts later
- parse_timers(
- cancel_timer_by_type(TimerType, Timers),
- TimeoutsR, NewSeen,
- [{TimerType,TimerMsg}|TimeoutEvents]);
- _ ->
- %% (Re)start the timer
- TimerRef =
- erlang:start_timer(
- Time, self(), TimerMsg, TimerOpts),
- {TimerRefs,TimerTypes} = Timers,
- case TimerTypes of
- #{TimerType := OldTimerRef} ->
- %% Cancel the running timer,
- %% update the timeout type,
- %% insert the new timer ref,
- %% and remove the old timer ref
- cancel_timer(OldTimerRef),
- %% Insert the new timer into
- %% both TimerRefs and TimerTypes
- parse_timers(
- {maps:remove(
- OldTimerRef,
- TimerRefs#{TimerRef => TimerType}),
- TimerTypes#{TimerType := TimerRef}},
- TimeoutsR, NewSeen, TimeoutEvents);
- #{} ->
- %% Insert the new timer type and ref
- parse_timers(
- {TimerRefs#{TimerRef => TimerType},
- TimerTypes#{TimerType => TimerRef}},
- TimeoutsR, NewSeen, TimeoutEvents)
- end
- end
+parse_timeout_opts_abs(Opts, Abs) ->
+ case Opts of
+ [] ->
+ Abs;
+ [{abs,Abs_1}|Opts] when is_boolean(Abs_1) ->
+ parse_timeout_opts_abs(Opts, Abs_1);
+ _ ->
+ badarg
end.
%% Enqueue immediate timeout events (timeout 0 events)
@@ -1717,62 +2061,94 @@ parse_timers(
%% so if there are enqueued events before the event timer
%% timeout 0 event - the event timer is cancelled hence no event.
%%
-%% Other (state_timeout) timeout 0 events that are after
-%% the event timer timeout 0 events are considered to
+%% Other (state_timeout and {timeout,Name}) timeout 0 events
+%% that are after an event timer timeout 0 event are considered to
%% belong to timers that were started after the event timer
%% timeout 0 event fired, so they do not cancel the event timer.
%%
-prepend_timeout_events([], EventsR) ->
- EventsR;
-prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
- prepend_timeout_events(TimeoutEvents, [TimeoutEvent]);
-prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) ->
+prepend_timeout_events(_P, Debug, _S, [], EventsR) ->
+ {Debug,EventsR};
+prepend_timeout_events(
+ P, Debug, S, [{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
+ %% Prepend this since there are no other events in queue
+ case Debug of
+ ?not_sys_debug ->
+ prepend_timeout_events(
+ P, Debug, S, TimeoutEvents, [TimeoutEvent]);
+ _ ->
+ {State,_Data} = S#state.state_data,
+ Debug_1 =
+ sys_debug(
+ Debug, P#params.name, {in,TimeoutEvent,State}),
+ prepend_timeout_events(
+ P, Debug_1, S, TimeoutEvents, [TimeoutEvent])
+ end;
+prepend_timeout_events(
+ P, Debug, S, [{timeout,_}|TimeoutEvents], EventsR) ->
%% Ignore since there are other events in queue
%% so they have cancelled the event timeout 0.
- prepend_timeout_events(TimeoutEvents, EventsR);
-prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) ->
+ prepend_timeout_events(P, Debug, S, TimeoutEvents, EventsR);
+prepend_timeout_events(
+ P, Debug, S, [TimeoutEvent|TimeoutEvents], EventsR) ->
%% Just prepend all others
- prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]).
+ case Debug of
+ ?not_sys_debug ->
+ prepend_timeout_events(
+ P, Debug, S, TimeoutEvents, [TimeoutEvent|EventsR]);
+ _ ->
+ {State,_Data} = S#state.state_data,
+ Debug_1 =
+ sys_debug(
+ Debug, P#params.name, {in,TimeoutEvent,State}),
+ prepend_timeout_events(
+ P, Debug_1, S, TimeoutEvents, [TimeoutEvent|EventsR])
+ end.
%%---------------------------------------------------------------------------
%% Server helpers
-reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) ->
+reply_then_terminate(Class, Reason, Stacktrace, P, Debug, S, Q, Replies) ->
do_reply_then_terminate(
- Class, Reason, Stacktrace, Debug, S, Q, listify(Replies)).
+ Class, Reason, Stacktrace, P, Debug, S, Q, listify(Replies)).
%%
do_reply_then_terminate(
- Class, Reason, Stacktrace, Debug, S, Q, []) ->
- terminate(Class, Reason, Stacktrace, Debug, S, Q);
+ Class, Reason, Stacktrace, P, Debug, S, Q, []) ->
+ terminate(Class, Reason, Stacktrace, P, Debug, S, Q);
do_reply_then_terminate(
- Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) ->
+ Class, Reason, Stacktrace, P, Debug, S, Q, [R|Rs]) ->
case R of
- {reply,{_To,_Tag}=From,Reply} ->
- reply(From, Reply),
- NewDebug =
- ?sys_debug(
- Debug,
- begin
- #state{name = Name, state = State} = S,
- {Name,State}
- end,
- {out,Reply,From}),
- do_reply_then_terminate(
- Class, Reason, Stacktrace, NewDebug, S, Q, Rs);
+ {reply,From,Reply} ->
+ case from(From) of
+ true ->
+ reply(From, Reply),
+ Debug_1 =
+ ?sys_debug(
+ Debug,
+ P#params.name,
+ {out,Reply,From}),
+ do_reply_then_terminate(
+ Class, Reason, Stacktrace, P, Debug_1, S, Q, Rs);
+ false ->
+ terminate(
+ error,
+ {bad_reply_action_from_state_function,R},
+ ?STACKTRACE(),
+ P, Debug, S, Q)
+ end;
_ ->
terminate(
error,
{bad_reply_action_from_state_function,R},
?STACKTRACE(),
- Debug, S, Q)
+ P, Debug, S, Q)
end.
terminate(
- Class, Reason, Stacktrace, Debug,
- #state{module = Module, state = State, data = Data} = S,
- Q) ->
+ Class, Reason, Stacktrace,
+ #params{module = Module} = P, Debug,
+ #state{state_data = {State,Data}} = S, Q) ->
case erlang:function_exported(Module, terminate, 3) of
true ->
try Module:terminate(Reason, State, Data) of
@@ -1780,8 +2156,7 @@ terminate(
catch
_ -> ok;
C:R:ST ->
- error_info(C, R, ST, S, Q),
- sys:print_log(Debug),
+ error_info(C, R, ST, Debug, P, S, Q),
erlang:raise(C, R, ST)
end;
false ->
@@ -1790,14 +2165,13 @@ terminate(
_ =
case Reason of
normal ->
- terminate_sys_debug(Debug, S, State, Reason);
+ terminate_sys_debug(Debug, P, State, Reason);
shutdown ->
- terminate_sys_debug(Debug, S, State, Reason);
+ terminate_sys_debug(Debug, P, State, Reason);
{shutdown,_} ->
- terminate_sys_debug(Debug, S, State, Reason);
+ terminate_sys_debug(Debug, P, State, Reason);
_ ->
- error_info(Class, Reason, Stacktrace, S, Q),
- sys:print_log(Debug)
+ error_info(Class, Reason, Stacktrace, Debug, P, S, Q)
end,
case Stacktrace of
[] ->
@@ -1806,38 +2180,67 @@ terminate(
erlang:raise(Class, Reason, Stacktrace)
end.
-terminate_sys_debug(Debug, S, State, Reason) ->
- ?sys_debug(Debug, {S#state.name,State}, {terminate,Reason}).
+terminate_sys_debug(Debug, P, State, Reason) ->
+ ?sys_debug(Debug, P#params.name, {terminate,Reason,State}).
error_info(
- Class, Reason, Stacktrace,
- #state{
+ Class, Reason, Stacktrace, Debug,
+ #params{
name = Name,
callback_mode = CallbackMode,
- state_enter = StateEnter,
- postponed = P} = S,
+ state_enter = StateEnter} = P,
+ #state{postponed = Postponed} = S,
Q) ->
+ Log = sys:get_log(Debug),
?LOG_ERROR(#{label=>{gen_statem,terminate},
name=>Name,
queue=>Q,
- postponed=>P,
+ postponed=>Postponed,
callback_mode=>CallbackMode,
state_enter=>StateEnter,
- state=>format_status(terminate, get(), S),
- reason=>{Class,Reason,Stacktrace}},
+ state=>format_status(terminate, get(), P, S),
+ log=>Log,
+ reason=>{Class,Reason,Stacktrace},
+ client_info=>client_stacktrace(Q)},
#{domain=>[otp],
report_cb=>fun gen_statem:format_log/1,
error_logger=>#{tag=>error}}).
+client_stacktrace([]) ->
+ undefined;
+client_stacktrace([{{call,{Pid,_Tag}},_Req}|_]) when is_pid(Pid) ->
+ if
+ node(Pid) =:= node() ->
+ case
+ process_info(Pid, [current_stacktrace, registered_name])
+ of
+ undefined ->
+ {Pid,dead};
+ [{current_stacktrace, Stacktrace},
+ {registered_name, []}] ->
+ {Pid,{Pid,Stacktrace}};
+ [{current_stacktrace, Stacktrace},
+ {registered_name, Name}] ->
+ {Pid,{Name,Stacktrace}}
+ end;
+ true ->
+ {Pid,remote}
+ end;
+client_stacktrace([_|_]) ->
+ undefined.
+
+
format_log(#{label:={gen_statem,terminate},
name:=Name,
queue:=Q,
- postponed:=P,
+ postponed:=Postponed,
callback_mode:=CallbackMode,
state_enter:=StateEnter,
state:=FmtData,
- reason:={Class,Reason,Stacktrace}}) ->
+ log:=Log,
+ reason:={Class,Reason,Stacktrace},
+ client_info:=ClientInfo}) ->
{FixedReason,FixedStacktrace} =
case Stacktrace of
[{M,F,Args,_}|ST]
@@ -1857,14 +2260,12 @@ format_log(#{label:={gen_statem,terminate},
true ->
{Reason,Stacktrace};
false ->
- {{'function not exported',{M,F,Arity}},
- ST}
+ {{'function not exported',{M,F,Arity}},ST}
end
end;
_ -> {Reason,Stacktrace}
end,
- [LimitedP, LimitedFmtData, LimitedFixedReason] =
- [error_logger:limit_term(D) || D <- [P, FmtData, FixedReason]],
+ {ClientFmt,ClientArgs} = format_client_log(ClientInfo),
CBMode =
case StateEnter of
true ->
@@ -1884,39 +2285,60 @@ format_log(#{label:={gen_statem,terminate},
[_,_|_] -> "** Queued = ~tp~n";
_ -> ""
end ++
- case P of
+ case Postponed of
[] -> "";
_ -> "** Postponed = ~tp~n"
end ++
case FixedStacktrace of
[] -> "";
_ -> "** Stacktrace =~n** ~tp~n"
- end,
+ end ++
+ case Log of
+ [] -> "";
+ _ -> "** Log =~n** ~tp~n"
+ end ++ ClientFmt,
[Name |
case Q of
[] -> [];
- [Event|_] -> [Event]
+ [Event|_] -> [error_logger:limit_term(Event)]
end] ++
- [LimitedFmtData,
- Class,LimitedFixedReason,
+ [error_logger:limit_term(FmtData),
+ Class,error_logger:limit_term(FixedReason),
CBMode] ++
case Q of
- [_|[_|_] = Events] -> [Events];
+ [_|[_|_] = Events] -> [error_logger:limit_term(Events)];
_ -> []
end ++
- case P of
+ case Postponed of
[] -> [];
- _ -> [LimitedP]
+ _ -> [error_logger:limit_term(Postponed)]
end ++
case FixedStacktrace of
[] -> [];
- _ -> [FixedStacktrace]
- end}.
+ _ -> [error_logger:limit_term(FixedStacktrace)]
+ end ++
+ case Log of
+ [] -> [];
+ _ -> [[error_logger:limit_term(T) || T <- Log]]
+ end ++ ClientArgs}.
+
+format_client_log(undefined) ->
+ {"", []};
+format_client_log({Pid,dead}) ->
+ {"** Client ~p is dead~n", [Pid]};
+format_client_log({Pid,remote}) ->
+ {"** Client ~p is remote on node ~p~n", [Pid, node(Pid)]};
+format_client_log({_Pid,{Name,Stacktrace}}) ->
+ {"** Client ~tp stacktrace~n"
+ "** ~tp~n",
+ [Name, error_logger:limit_term(Stacktrace)]}.
+
%% Call Module:format_status/2 or return a default value
format_status(
Opt, PDict,
- #state{module = Module, state = State, data = Data}) ->
+ #params{module = Module},
+ #state{state_data = {State,Data} = State_Data}) ->
case erlang:function_exported(Module, format_status, 2) of
true ->
try Module:format_status(Opt, [PDict,State,Data])
@@ -1924,21 +2346,21 @@ format_status(
Result -> Result;
_:_ ->
format_status_default(
- Opt, State,
- atom_to_list(Module) ++ ":format_status/2 crashed")
+ Opt,
+ {State,
+ atom_to_list(Module) ++ ":format_status/2 crashed"})
end;
false ->
- format_status_default(Opt, State, Data)
+ format_status_default(Opt, State_Data)
end.
-%% The default Module:format_status/2
-format_status_default(Opt, State, Data) ->
- StateData = {State,Data},
+%% The default Module:format_status/3
+format_status_default(Opt, State_Data) ->
case Opt of
terminate ->
- StateData;
+ State_Data;
_ ->
- [{data,[{"State",StateData}]}]
+ [{data,[{"State",State_Data}]}]
end.
-compile({inline, [listify/1]}).
@@ -1967,14 +2389,21 @@ cancel_timer(TimerRef) ->
%% Cancel timer if running, otherwise no op
%%
-%% Remove the timer from Timers.
+%% Remove the timer from Timers
-compile({inline, [cancel_timer_by_type/2]}).
-cancel_timer_by_type(TimerType, {TimerRefs,TimerTypes} = Timers) ->
- case TimerTypes of
- #{TimerType := TimerRef} ->
+cancel_timer_by_type(TimeoutType, {TimerRefs,TimeoutTypes} = Timers) ->
+ case TimeoutTypes of
+ #{TimeoutType := TimerRef} ->
?cancel_timer(TimerRef),
- {maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes)};
- #{} ->
- Timers
+ {maps:remove(TimerRef, TimerRefs),
+ maps:remove(TimeoutType, TimeoutTypes)};
+ #{} ->
+ Timers
end.
+
+-compile({inline, [cancel_timer_by_ref_and_type/4]}).
+cancel_timer_by_ref_and_type(
+ TimerRef, TimeoutType, TimerRefs, TimeoutTypes) ->
+ ?cancel_timer(TimerRef),
+ {maps:remove(TimerRef, TimerRefs),
+ maps:remove(TimeoutType, TimeoutTypes)}.
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 2b5a374cf2..21d66c5529 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -412,14 +412,25 @@ write_port(Port) ->
write_ref(Ref) ->
erlang:ref_to_list(Ref).
+write_map(_, 1, _E) -> "#{}";
write_map(Map, D, E) when is_integer(D) ->
- [$#,${,write_map_body(maps:to_list(Map), D, D - 1, E),$}].
+ I = maps:iterator(Map),
+ case maps:next(I) of
+ {K, V, NextI} ->
+ D0 = D - 1,
+ W = write_map_assoc(K, V, D0, E),
+ [$#,${,[W | write_map_body(NextI, D0, D0, E)],$}];
+ none -> "#{}"
+ end.
-write_map_body(_, 1, _D0, _E) -> "...";
-write_map_body([], _, _D0, _E) -> [];
-write_map_body([{K,V}], _D, D0, E) -> write_map_assoc(K, V, D0, E);
-write_map_body([{K,V}|KVs], D, D0, E) ->
- [write_map_assoc(K, V, D0, E),$, | write_map_body(KVs, D - 1, D0, E)].
+write_map_body(_, 1, _D0, _E) -> ",...";
+write_map_body(I, D, D0, E) ->
+ case maps:next(I) of
+ {K, V, NextI} ->
+ W = write_map_assoc(K, V, D0, E),
+ [$,,W|write_map_body(NextI, D - 1, D0, E)];
+ none -> ""
+ end.
write_map_assoc(K, V, D, E) ->
[write1(K, D, E)," => ",write1(V, D, E)].
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index d1aa4cd157..157cc07e19 100644
--- a/lib/stdlib/src/io_lib_format.erl
+++ b/lib/stdlib/src/io_lib_format.erl
@@ -327,11 +327,11 @@ indentation([], I) -> I.
%% PadChar, Encoding, StringP, ChrsLim, Indentation) -> String
%% These are the dispatch functions for the various formatting controls.
-control_small($s, [A], F, Adj, P, Pad, latin1) when is_atom(A) ->
+control_small($s, [A], F, Adj, P, Pad, latin1=Enc) when is_atom(A) ->
L = iolist_to_chars(atom_to_list(A)),
- string(L, F, Adj, P, Pad);
-control_small($s, [A], F, Adj, P, Pad, unicode) when is_atom(A) ->
- string(atom_to_list(A), F, Adj, P, Pad);
+ string(L, F, Adj, P, Pad, Enc);
+control_small($s, [A], F, Adj, P, Pad, unicode=Enc) when is_atom(A) ->
+ string(atom_to_list(A), F, Adj, P, Pad, Enc);
control_small($e, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
fwrite_e(A, F, Adj, P, Pad);
control_small($f, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
@@ -371,12 +371,12 @@ control_small($n, [], F, Adj, P, Pad, _Enc) -> newline(F, Adj, P, Pad);
control_small($i, [_A], _F, _Adj, _P, _Pad, _Enc) -> [];
control_small(_C, _As, _F, _Adj, _P, _Pad, _Enc) -> not_small.
-control_limited($s, [L0], F, Adj, P, Pad, latin1, _Str, CL, _I) ->
- L = iolist_to_chars(L0),
- string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad);
-control_limited($s, [L0], F, Adj, P, Pad, unicode, _Str, CL, _I) ->
- L = cdata_to_chars(L0),
- uniconv(string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad));
+control_limited($s, [L0], F, Adj, P, Pad, latin1=Enc, _Str, CL, _I) ->
+ L = iolist_to_chars(L0, F, CL),
+ string(L, limit_field(F, CL), Adj, P, Pad, Enc);
+control_limited($s, [L0], F, Adj, P, Pad, unicode=Enc, _Str, CL, _I) ->
+ L = cdata_to_chars(L0, F, CL),
+ uniconv(string(L, limit_field(F, CL), Adj, P, Pad, Enc));
control_limited($w, [A], F, Adj, P, Pad, Enc, _Str, CL, _I) ->
Chars = io_lib:write(A, [{depth, -1}, {encoding, Enc}, {chars_limit, CL}]),
term(Chars, F, Adj, P, Pad);
@@ -718,7 +718,10 @@ fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 ->
end.
-%% iolist_to_chars(iolist()) -> io_lib:chars()
+iolist_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F ->
+ iolist_to_chars(Cs);
+iolist_to_chars(Cs, _, CharsLimit) ->
+ limit_iolist_to_chars(Cs, sub(CharsLimit, 3), [], normal). % three dots
iolist_to_chars([C|Cs]) when is_integer(C), C >= $\000, C =< $\377 ->
[C | iolist_to_chars(Cs)];
@@ -729,12 +732,34 @@ iolist_to_chars([]) ->
iolist_to_chars(B) when is_binary(B) ->
binary_to_list(B).
-%% cdata() :: clist() | cbinary()
-%% clist() :: maybe_improper_list(char() | cbinary() | clist(),
-%% cbinary() | nil())
-%% cbinary() :: unicode:unicode_binary() | unicode:latin1_binary()
+limit_iolist_to_chars(Cs, 0, S, normal) ->
+ L = limit_iolist_to_chars(Cs, 4, S, final),
+ case iolist_size(L) of
+ N when N < 4 -> L;
+ 4 -> "..."
+ end;
+limit_iolist_to_chars(_Cs, 0, _S, final) -> [];
+limit_iolist_to_chars([C|Cs], Limit, S, Mode) when C >= $\000, C =< $\377 ->
+ [C | limit_iolist_to_chars(Cs, Limit - 1, S, Mode)];
+limit_iolist_to_chars([I|Cs], Limit, S, Mode) ->
+ limit_iolist_to_chars(I, Limit, [Cs|S], Mode);
+limit_iolist_to_chars([], _Limit, [], _Mode) ->
+ [];
+limit_iolist_to_chars([], Limit, [Cs|S], Mode) ->
+ limit_iolist_to_chars(Cs, Limit, S, Mode);
+limit_iolist_to_chars(B, Limit, S, Mode) when is_binary(B) ->
+ case byte_size(B) of
+ Sz when Sz > Limit ->
+ {B1, B2} = split_binary(B, Limit),
+ [binary_to_list(B1) | limit_iolist_to_chars(B2, 0, S, Mode)];
+ Sz ->
+ [binary_to_list(B) | limit_iolist_to_chars([], Limit-Sz, S, Mode)]
+ end.
-%% cdata_to_chars(cdata()) -> io_lib:chars()
+cdata_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F ->
+ cdata_to_chars(Cs);
+cdata_to_chars(Cs, _, CharsLimit) ->
+ limit_cdata_to_chars(Cs, sub(CharsLimit, 3), normal). % three dots
cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 ->
[C | cdata_to_chars(Cs)];
@@ -748,11 +773,25 @@ cdata_to_chars(B) when is_binary(B) ->
_ -> binary_to_list(B)
end.
-limit_string(S, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> S;
-limit_string(S, _F, CharsLimit) ->
- case io_lib:chars_length(S) =< CharsLimit of
- true -> S;
- false -> [string:slice(S, 0, sub(CharsLimit, 3)), "..."]
+limit_cdata_to_chars(Cs, 0, normal) ->
+ L = limit_cdata_to_chars(Cs, 4, final),
+ case string:length(L) of
+ N when N < 4 -> L;
+ 4 -> "..."
+ end;
+limit_cdata_to_chars(_Cs, 0, final) -> [];
+limit_cdata_to_chars(Cs, Limit, Mode) ->
+ case string:next_grapheme(Cs) of
+ {error, <<C,Cs1/binary>>} ->
+ %% This is how ~ts handles Latin1 binaries with option
+ %% chars_limit.
+ [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)];
+ {error, [C|Cs1]} -> % not all versions of module string return this
+ [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)];
+ [] ->
+ [];
+ [GC|Cs1] ->
+ [GC | limit_cdata_to_chars(Cs1, Limit - 1, Mode)]
end.
limit_field(F, CharsLimit) when CharsLimit < 0; F =:= none ->
@@ -762,30 +801,30 @@ limit_field(F, CharsLimit) ->
%% string(String, Field, Adjust, Precision, PadChar)
-string(S, none, _Adj, none, _Pad) -> S;
-string(S, F, Adj, none, Pad) ->
- string_field(S, F, Adj, io_lib:chars_length(S), Pad);
-string(S, none, _Adj, P, Pad) ->
- string_field(S, P, left, io_lib:chars_length(S), Pad);
-string(S, F, Adj, P, Pad) when F >= P ->
+string(S, none, _Adj, none, _Pad, _Enc) -> S;
+string(S, F, Adj, none, Pad, Enc) ->
+ string_field(S, F, Adj, io_lib:chars_length(S), Pad, Enc);
+string(S, none, _Adj, P, Pad, Enc) ->
+ string_field(S, P, left, io_lib:chars_length(S), Pad, Enc);
+string(S, F, Adj, P, Pad, Enc) when F >= P ->
N = io_lib:chars_length(S),
if F > P ->
if N > P ->
- adjust(flat_trunc(S, P), chars(Pad, F-P), Adj);
+ adjust(flat_trunc(S, P, Enc), chars(Pad, F-P), Adj);
N < P ->
adjust([S|chars(Pad, P-N)], chars(Pad, F-P), Adj);
true -> % N == P
adjust(S, chars(Pad, F-P), Adj)
end;
true -> % F == P
- string_field(S, F, Adj, N, Pad)
+ string_field(S, F, Adj, N, Pad, Enc)
end.
-string_field(S, F, _Adj, N, _Pad) when N > F ->
- flat_trunc(S, F);
-string_field(S, F, Adj, N, Pad) when N < F ->
+string_field(S, F, _Adj, N, _Pad, Enc) when N > F ->
+ flat_trunc(S, F, Enc);
+string_field(S, F, Adj, N, Pad, _Enc) when N < F ->
adjust(S, chars(Pad, F-N), Adj);
-string_field(S, _, _, _, _) -> % N == F
+string_field(S, _, _, _, _, _) -> % N == F
S.
%% unprefixed_integer(Int, Field, Adjust, Base, PadChar, Lowercase)
@@ -837,7 +876,10 @@ adjust(Data, Pad, right) -> [Pad|Data].
%% Flatten and truncate a deep list to at most N elements.
-flat_trunc(List, N) when is_integer(N), N >= 0 ->
+flat_trunc(List, N, latin1) when is_integer(N), N >= 0 ->
+ {S, _} = lists:split(N, lists:flatten(List)),
+ S;
+flat_trunc(List, N, unicode) when is_integer(N), N >= 0 ->
string:slice(List, 0, N).
%% A deep version of lists:duplicate/2
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 19e4140893..77f02eafe0 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -722,55 +722,40 @@ printable_list(_L, 1, _T, _Enc) ->
false;
printable_list(L, _D, T, latin1) when T < 0 ->
io_lib:printable_latin1_list(L);
-printable_list(L, _D, T, Enc) when T >= 0 ->
- case slice(L, tsub(T, 2), Enc) of
- false ->
- false;
- {prefix, Prefix} when Enc =:= latin1 ->
- io_lib:printable_latin1_list(Prefix) andalso {true, Prefix};
- {prefix, Prefix} ->
- %% Probably an overestimation.
- io_lib:printable_list(Prefix) andalso {true, Prefix};
- all when Enc =:= latin1 ->
- io_lib:printable_latin1_list(L);
+printable_list(L, _D, T, latin1) when T >= 0 ->
+ N = tsub(T, 2),
+ case printable_latin1_list(L, N) of
all ->
- io_lib:printable_list(L)
- end;
-printable_list(L, _D, T, _Uni) when T < 0->
- io_lib:printable_list(L).
-
-slice(L, N, latin1) ->
- try lists:split(N, L) of
- {_, []} ->
- all;
- {[], _} ->
- false;
- {L1, _} ->
- {prefix, L1}
- catch
- _:_ ->
- all
+ true;
+ 0 ->
+ {L1, _} = lists:split(N, L),
+ {true, L1};
+ _NC ->
+ false
end;
-slice(L, N, _Uni) ->
+printable_list(L, _D, T, _Unicode) when T >= 0 ->
+ N = tsub(T, 2),
%% Be careful not to traverse more of L than necessary.
try string:slice(L, 0, N) of
"" ->
false;
Prefix ->
- %% Assume no binaries are introduced by string:slice().
case is_flat(L, lists:flatlength(Prefix)) of
true ->
case string:equal(Prefix, L) of
true ->
- all;
+ io_lib:printable_list(L);
false ->
- {prefix, Prefix}
+ io_lib:printable_list(Prefix)
+ andalso {true, Prefix}
end;
false ->
false
end
catch _:_ -> false
- end.
+ end;
+printable_list(L, _D, T, _Uni) when T < 0->
+ io_lib:printable_list(L).
is_flat(_L, 0) ->
true;
@@ -797,6 +782,8 @@ printable_bin0(Bin, D, T, Enc) ->
end,
printable_bin(Bin, Len, D, Enc).
+printable_bin(_Bin, 0, _D, _Enc) ->
+ false;
printable_bin(Bin, Len, D, latin1) ->
N = erlang:min(20, Len),
L = binary_to_list(Bin, 1, N),
@@ -847,7 +834,7 @@ printable_bin1(Bin, Start, Len) ->
end.
%% -> all | integer() >=0. Adopted from io_lib.erl.
-% printable_latin1_list([_ | _], 0) -> 0;
+printable_latin1_list([_ | _], 0) -> 0;
printable_latin1_list([C | Cs], N) when C >= $\s, C =< $~ ->
printable_latin1_list(Cs, N - 1);
printable_latin1_list([C | Cs], N) when C >= $\240, C =< $\377 ->
diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl
index 60463feec2..51965ddb57 100644
--- a/lib/stdlib/src/maps.erl
+++ b/lib/stdlib/src/maps.erl
@@ -21,7 +21,7 @@
-module(maps).
-export([get/3, filter/2,fold/3,
- map/2, size/1,
+ map/2, size/1, new/0,
update_with/3, update_with/4,
without/2, with/2,
iterator/1, next/1]).
@@ -29,13 +29,15 @@
%% BIFs
-export([get/2, find/2, from_list/1,
is_key/2, keys/1, merge/2,
- new/0, put/3, remove/2, take/2,
+ put/3, remove/2, take/2,
to_list/1, update/3, values/1]).
--opaque iterator() :: {term(), term(), iterator()}
- | none | nonempty_improper_list(integer(),map()).
+-opaque iterator(Key, Value) :: {Key, Value, iterator(Key, Value)} | none
+ | nonempty_improper_list(integer(), #{Key => Value}).
--export_type([iterator/0]).
+-type iterator() :: iterator(term(), term()).
+
+-export_type([iterator/2, iterator/0]).
-dialyzer({no_improper_lists, iterator/1}).
@@ -50,9 +52,7 @@
get(_,_) -> erlang:nif_error(undef).
-spec find(Key,Map) -> {ok, Value} | error when
- Key :: term(),
- Map :: map(),
- Value :: term().
+ Map :: #{Key => Value, _ => _}.
find(_,_) -> erlang:nif_error(undef).
@@ -75,9 +75,8 @@ is_key(_,_) -> erlang:nif_error(undef).
-spec keys(Map) -> Keys when
- Map :: map(),
- Keys :: [Key],
- Key :: term().
+ Map :: #{Key => _},
+ Keys :: [Key].
keys(_) -> erlang:nif_error(undef).
@@ -91,13 +90,6 @@ keys(_) -> erlang:nif_error(undef).
merge(_,_) -> erlang:nif_error(undef).
-
--spec new() -> Map when
- Map :: map().
-
-new() -> erlang:nif_error(undef).
-
-
%% Shadowed by erl_bif_types: maps:put/3
-spec put(Key,Value,Map1) -> Map2 when
Key :: term(),
@@ -116,17 +108,13 @@ put(_,_,_) -> erlang:nif_error(undef).
remove(_,_) -> erlang:nif_error(undef).
-spec take(Key,Map1) -> {Value,Map2} | error when
- Key :: term(),
- Map1 :: map(),
- Value :: term(),
- Map2 :: map().
+ Map1 :: #{Key => Value, _ => _},
+ Map2 :: #{_ => _}.
take(_,_) -> erlang:nif_error(undef).
-spec to_list(Map) -> [{Key,Value}] when
- Map :: map(),
- Key :: term(),
- Value :: term().
+ Map :: #{Key => Value}.
to_list(Map) when is_map(Map) ->
to_list_internal(erts_internal:map_next(0, Map, []));
@@ -140,79 +128,69 @@ to_list_internal(Acc) ->
%% Shadowed by erl_bif_types: maps:update/3
-spec update(Key,Value,Map1) -> Map2 when
- Key :: term(),
- Value :: term(),
- Map1 :: map(),
- Map2 :: map().
+ Map1 :: #{Key := _, _ => _},
+ Map2 :: #{Key := Value, _ => _}.
update(_,_,_) -> erlang:nif_error(undef).
-spec values(Map) -> Values when
- Map :: map(),
- Values :: [Value],
- Value :: term().
+ Map :: #{_ => Value},
+ Values :: [Value].
values(_) -> erlang:nif_error(undef).
%% End of BIFs
+-spec new() -> Map when
+ Map :: #{}.
+
+new() -> #{}.
+
-spec update_with(Key,Fun,Map1) -> Map2 when
- Key :: term(),
- Map1 :: map(),
- Map2 :: map(),
- Fun :: fun((Value1 :: term()) -> Value2 :: term()).
+ Map1 :: #{Key := Value1, _ => _},
+ Map2 :: #{Key := Value2, _ => _},
+ Fun :: fun((Value1) -> Value2).
update_with(Key,Fun,Map) when is_function(Fun,1), is_map(Map) ->
- try maps:get(Key,Map) of
- Val -> maps:update(Key,Fun(Val),Map)
- catch
- error:{badkey,_} ->
- erlang:error({badkey,Key},[Key,Fun,Map])
+ case Map of
+ #{Key := Value} -> Map#{Key := Fun(Value)};
+ #{} -> erlang:error({badkey,Key},[Key,Fun,Map])
end;
update_with(Key,Fun,Map) ->
erlang:error(error_type(Map),[Key,Fun,Map]).
-spec update_with(Key,Fun,Init,Map1) -> Map2 when
- Key :: term(),
- Map1 :: Map1,
- Map2 :: Map2,
- Fun :: fun((Value1 :: term()) -> Value2 :: term()),
- Init :: term().
+ Map1 :: #{Key => Value1, _ => _},
+ Map2 :: #{Key := Value2 | Init, _ => _},
+ Fun :: fun((Value1) -> Value2).
update_with(Key,Fun,Init,Map) when is_function(Fun,1), is_map(Map) ->
- case maps:find(Key,Map) of
- {ok,Val} -> maps:update(Key,Fun(Val),Map);
- error -> maps:put(Key,Init,Map)
+ case Map of
+ #{Key := Value} -> Map#{Key := Fun(Value)};
+ #{} -> Map#{Key => Init}
end;
update_with(Key,Fun,Init,Map) ->
erlang:error(error_type(Map),[Key,Fun,Init,Map]).
-spec get(Key, Map, Default) -> Value | Default when
- Key :: term(),
- Map :: map(),
- Value :: term(),
- Default :: term().
+ Map :: #{Key => Value, _ => _}.
get(Key,Map,Default) when is_map(Map) ->
- case maps:find(Key, Map) of
- {ok, Value} ->
- Value;
- error ->
- Default
+ case Map of
+ #{Key := Value} -> Value;
+ #{} -> Default
end;
get(Key,Map,Default) ->
erlang:error({badmap,Map},[Key,Map,Default]).
--spec filter(Pred,MapOrIter) -> Map when
+-spec filter(Pred, MapOrIter) -> Map when
Pred :: fun((Key, Value) -> boolean()),
- Key :: term(),
- Value :: term(),
- MapOrIter :: map() | iterator(),
- Map :: map().
+ MapOrIter :: #{Key => Value} | iterator(Key, Value),
+ Map :: #{Key => Value}.
filter(Pred,Map) when is_function(Pred,2), is_map(Map) ->
maps:from_list(filter_1(Pred, iterator(Map)));
@@ -235,14 +213,11 @@ filter_1(Pred, Iter) ->
end.
-spec fold(Fun,Init,MapOrIter) -> Acc when
- Fun :: fun((K, V, AccIn) -> AccOut),
+ Fun :: fun((Key, Value, AccIn) -> AccOut),
Init :: term(),
- Acc :: term(),
- AccIn :: term(),
- AccOut :: term(),
- MapOrIter :: map() | iterator(),
- K :: term(),
- V :: term().
+ Acc :: AccOut,
+ AccIn :: Init | AccOut,
+ MapOrIter :: #{Key => Value} | iterator(Key, Value).
fold(Fun,Init,Map) when is_function(Fun,3), is_map(Map) ->
fold_1(Fun,Init,iterator(Map));
@@ -260,12 +235,9 @@ fold_1(Fun, Acc, Iter) ->
end.
-spec map(Fun,MapOrIter) -> Map when
- Fun :: fun((K, V1) -> V2),
- MapOrIter :: map() | iterator(),
- Map :: map(),
- K :: term(),
- V1 :: term(),
- V2 :: term().
+ Fun :: fun((Key, Value1) -> Value2),
+ MapOrIter :: #{Key => Value1} | iterator(Key, Value1),
+ Map :: #{Key => Value2}.
map(Fun,Map) when is_function(Fun, 2), is_map(Map) ->
maps:from_list(map_1(Fun, iterator(Map)));
@@ -291,17 +263,15 @@ size(Val) ->
erlang:error({badmap,Val},[Val]).
-spec iterator(Map) -> Iterator when
- Map :: map(),
- Iterator :: iterator().
+ Map :: #{Key => Value},
+ Iterator :: iterator(Key, Value).
iterator(M) when is_map(M) -> [0 | M];
iterator(M) -> erlang:error({badmap, M}, [M]).
-spec next(Iterator) -> {Key, Value, NextIterator} | 'none' when
- Iterator :: iterator(),
- Key :: term(),
- Value :: term(),
- NextIterator :: iterator().
+ Iterator :: iterator(Key, Value),
+ NextIterator :: iterator(Key, Value).
next({K, V, I}) ->
{K, V, I};
next([Path | Map]) when is_integer(Path), is_map(Map) ->
@@ -318,29 +288,26 @@ next(Iter) ->
K :: term().
without(Ks,M) when is_list(Ks), is_map(M) ->
- lists:foldl(fun(K, M1) -> maps:remove(K, M1) end, M, Ks);
+ lists:foldl(fun maps:remove/2, M, Ks);
without(Ks,M) ->
erlang:error(error_type(M),[Ks,M]).
-spec with(Ks, Map1) -> Map2 when
Ks :: [K],
- Map1 :: map(),
- Map2 :: map(),
- K :: term().
+ Map1 :: #{K => V, _ => _},
+ Map2 :: #{K => V}.
with(Ks,Map1) when is_list(Ks), is_map(Map1) ->
- Fun = fun(K, List) ->
- case maps:find(K, Map1) of
- {ok, V} ->
- [{K, V} | List];
- error ->
- List
- end
- end,
- maps:from_list(lists:foldl(Fun, [], Ks));
+ maps:from_list(with_1(Ks, Map1));
with(Ks,M) ->
erlang:error(error_type(M),[Ks,M]).
+with_1([K|Ks], Map) ->
+ case Map of
+ #{K := V} -> [{K,V}|with_1(Ks, Map)];
+ #{} -> with_1(Ks, Map)
+ end;
+with_1([], _Map) -> [].
error_type(M) when is_map(M) -> badarg;
error_type(V) -> {badmap, V}.
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index aaed13ba3a..fa34f19637 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -44,8 +44,19 @@ obsolete(Module, Name, Arity) ->
no
end.
-obsolete_1(net, _, _) ->
- {deprecated, "module 'net' obsolete; use 'net_adm'"};
+obsolete_1(net, call, 4) ->
+ {deprecated, {rpc, call, 4}};
+obsolete_1(net, cast, 4) ->
+ {deprecated, {rpc, cast, 4}};
+obsolete_1(net, broadcast, 3) ->
+ {deprecated, {rpc, eval_everywhere, 3}};
+obsolete_1(net, ping, 1) ->
+ {deprecated, {net_adm, ping, 1}};
+obsolete_1(net, sleep, 1) ->
+ {deprecated, "Use 'receive after T -> ok end' instead"};
+obsolete_1(net, relay, 1) ->
+ {deprecated, {slave, relay, 1}};
+
obsolete_1(erlang, now, 0) ->
{deprecated,
@@ -55,6 +66,14 @@ obsolete_1(erlang, now, 0) ->
obsolete_1(calendar, local_time_to_universal_time, 1) ->
{deprecated, {calendar, local_time_to_universal_time_dst, 1}};
+%% *** STDLIB added in OTP 22 ***
+
+obsolete_1(sys, get_debug, 3) ->
+ {deprecated,
+ "Deprecated function. "
+ "Incorrectly documented and in fact only for internal use. "
+ "Can often be replaced with sys:get_log/1."};
+
%% *** STDLIB added in OTP 20 ***
obsolete_1(gen_fsm, start, 3) ->
@@ -304,90 +323,6 @@ obsolete_1(snmp, N, A) ->
obsolete_1(snmpa, old_info_format, 1) ->
{deprecated, "Deprecated; (will be removed in OTP 18); use \"new\" format instead"};
-obsolete_1(snmpm, agent_info, 3) ->
- {removed, {snmpm, agent_info, 2}, "R16B"};
-obsolete_1(snmpm, update_agent_info, 5) ->
- {removed, {snmpm, update_agent_info, 4}, "R16B"};
-obsolete_1(snmpm, g, 3) ->
- {removed, {snmpm, sync_get, 3}, "R16B"};
-obsolete_1(snmpm, g, 4) ->
- {removed, {snmpm, sync_get, [3,4]}, "R16B"};
-obsolete_1(snmpm, g, 5) ->
- {removed, {snmpm, sync_get, [4,5]}, "R16B"};
-obsolete_1(snmpm, g, 6) ->
- {removed, {snmpm, sync_get, [5,6]}, "R16B"};
-obsolete_1(snmpm, g, 7) ->
- {removed, {snmpm, sync_get, 6}, "R16B"};
-obsolete_1(snmpm, ag, 3) ->
- {removed, {snmpm, async_get, 3}, "R16B"};
-obsolete_1(snmpm, ag, 4) ->
- {removed, {snmpm, async_get, [3,4]}, "R16B"};
-obsolete_1(snmpm, ag, 5) ->
- {removed, {snmpm, async_get, [4,5]}, "R16B"};
-obsolete_1(snmpm, ag, 6) ->
- {removed, {snmpm, async_get, [5,6]}, "R16B"};
-obsolete_1(snmpm, ag, 7) ->
- {removed, {snmpm, async_get, 6}, "R16B"};
-obsolete_1(snmpm, gn, 3) ->
- {removed, {snmpm, sync_get_next, 3}, "R16B"};
-obsolete_1(snmpm, gn, 4) ->
- {removed, {snmpm, sync_get_next, [3,4]}, "R16B"};
-obsolete_1(snmpm, gn, 5) ->
- {removed, {snmpm, sync_get_next, [4,5]}, "R16B"};
-obsolete_1(snmpm, gn, 6) ->
- {removed, {snmpm, sync_get_next, [5,6]}, "R16B"};
-obsolete_1(snmpm, gn, 7) ->
- {removed, {snmpm, sync_get_next, 6}, "R16B"};
-obsolete_1(snmpm, agn, 3) ->
- {removed, {snmpm, async_get_next, 3}, "R16B"};
-obsolete_1(snmpm, agn, 4) ->
- {removed, {snmpm, async_get_next, [3,4]}, "R16B"};
-obsolete_1(snmpm, agn, 5) ->
- {removed, {snmpm, async_get_next, [4,5]}, "R16B"};
-obsolete_1(snmpm, agn, 6) ->
- {removed, {snmpm, async_get_next, [5,6]}, "R16B"};
-obsolete_1(snmpm, agn, 7) ->
- {removed, {snmpm, async_get_next, 6}, "R16B"};
-obsolete_1(snmpm, s, 3) ->
- {removed, {snmpm, sync_set, 3}, "R16B"};
-obsolete_1(snmpm, s, 4) ->
- {removed, {snmpm, sync_set, [3,4]}, "R16B"};
-obsolete_1(snmpm, s, 5) ->
- {removed, {snmpm, sync_set, [4,5]}, "R16B"};
-obsolete_1(snmpm, s, 6) ->
- {removed, {snmpm, sync_set, [5,6]}, "R16B"};
-obsolete_1(snmpm, s, 7) ->
- {removed, {snmpm, sync_set, 6}, "R16B"};
-obsolete_1(snmpm, as, 3) ->
- {removed, {snmpm, async_set, 3}, "R16B"};
-obsolete_1(snmpm, as, 4) ->
- {removed, {snmpm, async_set, [3,4]}, "R16B"};
-obsolete_1(snmpm, as, 5) ->
- {removed, {snmpm, async_set, [4,5]}, "R16B"};
-obsolete_1(snmpm, as, 6) ->
- {removed, {snmpm, async_set, [5,6]}, "R16B"};
-obsolete_1(snmpm, as, 7) ->
- {removed, {snmpm, async_set, 6}, "R16B"};
-obsolete_1(snmpm, gb, 5) ->
- {removed, {snmpm, sync_get_bulk, 5}, "R16B"};
-obsolete_1(snmpm, gb, 6) ->
- {removed, {snmpm, sync_get_bulk, [5,6]}, "R16B"};
-obsolete_1(snmpm, gb, 7) ->
- {removed, {snmpm, sync_get_bulk, [6,7]}, "R16B"};
-obsolete_1(snmpm, gb, 8) ->
- {removed, {snmpm, sync_get_bulk, [7,8]}, "R16B"};
-obsolete_1(snmpm, gb, 9) ->
- {removed, {snmpm, sync_get_bulk, 8}, "R16B"};
-obsolete_1(snmpm, agb, 5) ->
- {removed, {snmpm, async_get_bulk, 5}, "R16B"};
-obsolete_1(snmpm, agb, 6) ->
- {removed, {snmpm, async_get_bulk, [5,6]}, "R16B"};
-obsolete_1(snmpm, agb, 7) ->
- {removed, {snmpm, async_get_bulk, [6,7]}, "R16B"};
-obsolete_1(snmpm, agb, 8) ->
- {removed, {snmpm, async_get_bulk, [7,8]}, "R16B"};
-obsolete_1(snmpm, agb, 9) ->
- {removed, {snmpm, async_get_bulk, 8}, "R16B"};
%% *** MEGACO ***
@@ -398,10 +333,9 @@ obsolete_1(megaco, format_versions, 1) ->
%% *** OS-MON-MIB ***
-obsolete_1(os_mon_mib, init, 1) ->
- {deprecated, {os_mon_mib, load, 1}};
-obsolete_1(os_mon_mib, stop, 1) ->
- {deprecated, {os_mon_mib, unload, 1}};
+%% FIXME: Remove this warning in OTP 24.
+obsolete_1(os_mon_mib, _, _) ->
+ {removed, "was removed in 22.0"};
obsolete_1(auth, is_auth, 1) ->
{deprecated, {net_adm, ping, 1}};
@@ -414,64 +348,6 @@ obsolete_1(auth, node_cookie, 1) ->
obsolete_1(auth, node_cookie, 2) ->
{deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"};
-obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"};
-obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"};
-obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"};
-obsolete_1(http, request, 5) -> {removed,{httpc,request,5},"R15B"};
-obsolete_1(http, cancel_request, 1) -> {removed,{httpc,cancel_request,1},"R15B"};
-obsolete_1(http, cancel_request, 2) -> {removed,{httpc,cancel_request,2},"R15B"};
-obsolete_1(http, set_option, 2) -> {removed,{httpc,set_option,2},"R15B"};
-obsolete_1(http, set_option, 3) -> {removed,{httpc,set_option,3},"R15B"};
-obsolete_1(http, set_options, 1) -> {removed,{httpc,set_options,1},"R15B"};
-obsolete_1(http, set_options, 2) -> {removed,{httpc,set_options,2},"R15B"};
-obsolete_1(http, verify_cookies, 2) -> {removed,{httpc,store_cookies,2},"R15B"};
-obsolete_1(http, verify_cookies, 3) -> {removed,{httpc,store_cookies,3},"R15B"};
-obsolete_1(http, cookie_header, 1) -> {removed,{httpc,cookie_header,1},"R15B"};
-obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B"};
-obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"};
-obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"};
-
-%% Added in R13A.
-obsolete_1(regexp, _, _) ->
- {removed, "removed in R15; use the re module instead"};
-
-%% Added in R13B04.
-obsolete_1(erlang, concat_binary, 1) ->
- {removed,{erlang,list_to_binary,1},"R15B"};
-
-%% Added in R14A.
-obsolete_1(ssl, peercert, 2) ->
- {removed ,"removed in R15A; use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"};
-
-%% Added in R14B.
-obsolete_1(public_key, pem_to_der, 1) ->
- {removed,"removed in R15A; use file:read_file/1 and public_key:pem_decode/1"};
-obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 ->
- {removed, "removed in R15A; use public_key:pem_entry_decode/1"};
-
-%% Added in R14B03.
-obsolete_1(docb_gen, _, _) ->
- {removed,"the DocBuilder application was removed in R15B"};
-obsolete_1(docb_transform, _, _) ->
- {removed,"the DocBuilder application was removed in R15B"};
-obsolete_1(docb_xml_check, _, _) ->
- {removed,"the DocBuilder application was removed in R15B"};
-
-%% Added in R15B
-obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver ->
- {removed,"removed (will be removed in OTP 18); has no effect as drivers are no longer used"};
-obsolete_1(ssl, pid, 1) ->
- {removed,"was removed in R16; is no longer needed"};
-obsolete_1(inviso, _, _) ->
- {removed,"the inviso application was removed in R16"};
-
-%% Added in R15B01.
-obsolete_1(ssh, sign_data, 2) ->
- {removed,"removed in R16A; use public_key:pem_decode/1, public_key:pem_entry_decode/1 "
- "and public_key:sign/3 instead"};
-obsolete_1(ssh, verify_data, 3) ->
- {removed,"removed in R16A; use public_key:ssh_decode/1, and public_key:verify/4 instead"};
-
%% Added in R16
obsolete_1(wxCalendarCtrl, enableYearChange, _) -> %% wx bug documented?
{deprecated,"deprecated function not available in wxWidgets-2.9 and later"};
@@ -592,10 +468,8 @@ obsolete_1(queue, lait, 1) ->
%% Removed in OTP 19.
-obsolete_1(overload, _, _) ->
- {removed, "removed in OTP 19"};
obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 ->
- {removed, {rpc, multi_server_call, A}, "removed in OTP 19"};
+ {removed, {rpc, multi_server_call, A}, "19.0"};
%% Added in OTP 20.
diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl
index 362e98006e..3a9a1e007b 100644
--- a/lib/stdlib/src/rand.erl
+++ b/lib/stdlib/src/rand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -32,18 +32,24 @@
uniform/0, uniform/1, uniform_s/1, uniform_s/2,
uniform_real/0, uniform_real_s/1,
jump/0, jump/1,
- normal/0, normal/2, normal_s/1, normal_s/3
+ normal/0, normal/2, normal_s/1, normal_s/3
]).
+%% Test, dev and internal
+-export([exro928_jump_2pow512/1, exro928_jump_2pow20/1,
+ exro928_seed/1, exro928_next/1, exro928_next_state/1,
+ format_jumpconst58/1, seed58/2]).
+
%% Debug
-export([make_float/3, float2str/1, bc64/1]).
--compile({inline, [exs64_next/1, exsplus_next/1,
+-compile({inline, [exs64_next/1, exsplus_next/1, exsss_next/1,
exs1024_next/1, exs1024_calc/2,
+ exro928_next_state/4,
exrop_next/1, exrop_next_s/2,
get_52/1, normal_kiwi/1]}).
--define(DEFAULT_ALG_HANDLER, exrop).
+-define(DEFAULT_ALG_HANDLER, exsss).
-define(SEED_DICT, rand_seed).
%% =====================================================================
@@ -80,8 +86,8 @@
%% This depends on the algorithm handler function
-type alg_state() ::
- exs64_state() | exsplus_state() | exs1024_state() |
- exrop_state() | term().
+ exsplus_state() | exro928_state() | exrop_state() | exs1024_state() |
+ exs64_state() | term().
%% This is the algorithm handling definition within this module,
%% and the type to use for plugins.
@@ -124,14 +130,17 @@
%% Algorithm state
-type state() :: {alg_handler(), alg_state()}.
--type builtin_alg() :: exs64 | exsplus | exsp | exs1024 | exs1024s | exrop.
+-type builtin_alg() ::
+ exsss | exro928ss | exrop | exs1024s | exsp | exs64 | exsplus | exs1024.
-type alg() :: builtin_alg() | atom().
-type export_state() :: {alg(), alg_state()}.
+-type seed() :: [integer()] | integer() | {integer(), integer(), integer()}.
-export_type(
[builtin_alg/0, alg/0, alg_handler/0, alg_state/0,
- state/0, export_state/0]).
+ state/0, export_state/0, seed/0]).
-export_type(
- [exs64_state/0, exsplus_state/0, exs1024_state/0, exrop_state/0]).
+ [exsplus_state/0, exro928_state/0, exrop_state/0, exs1024_state/0,
+ exs64_state/0]).
%% =====================================================================
%% Range macro and helper
@@ -229,12 +238,12 @@ export_seed() ->
end.
-spec export_seed_s(State :: state()) -> export_state().
-export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}.
+export_seed_s({#{type:=Alg}, AlgState}) -> {Alg, AlgState}.
%% seed(Alg) seeds RNG with runtime dependent values
%% and return the NEW state
-%% seed({Alg,Seed}) setup RNG with a previously exported seed
+%% seed({Alg,AlgState}) setup RNG with a previously exported seed
%% and return the NEW state
-spec seed(
@@ -246,11 +255,11 @@ seed(Alg) ->
-spec seed_s(
AlgOrStateOrExpState :: builtin_alg() | state() | export_state()) ->
state().
-seed_s({AlgHandler, _Seed} = State) when is_map(AlgHandler) ->
+seed_s({AlgHandler, _AlgState} = State) when is_map(AlgHandler) ->
State;
-seed_s({Alg0, Seed}) ->
- {Alg,_SeedFun} = mk_alg(Alg0),
- {Alg, Seed};
+seed_s({Alg, AlgState}) when is_atom(Alg) ->
+ {AlgHandler,_SeedFun} = mk_alg(Alg),
+ {AlgHandler,AlgState};
seed_s(Alg) ->
seed_s(Alg, {erlang:phash2([{node(),self()}]),
erlang:system_time(),
@@ -259,19 +268,15 @@ seed_s(Alg) ->
%% seed/2: seeds RNG with the algorithm and given values
%% and returns the NEW state.
--spec seed(
- Alg :: builtin_alg(), Seed :: {integer(), integer(), integer()}) ->
- state().
-seed(Alg0, S0) ->
- seed_put(seed_s(Alg0, S0)).
+-spec seed(Alg :: builtin_alg(), Seed :: seed()) -> state().
+seed(Alg, Seed) ->
+ seed_put(seed_s(Alg, Seed)).
--spec seed_s(
- Alg :: builtin_alg(), Seed :: {integer(), integer(), integer()}) ->
- state().
-seed_s(Alg0, S0 = {_, _, _}) ->
- {Alg, Seed} = mk_alg(Alg0),
- AS = Seed(S0),
- {Alg, AS}.
+-spec seed_s(Alg :: builtin_alg(), Seed :: seed()) -> state().
+seed_s(Alg, Seed) ->
+ {AlgHandler,SeedFun} = mk_alg(Alg),
+ AlgState = SeedFun(Seed),
+ {AlgHandler,AlgState}.
%%% uniform/0, uniform/1, uniform_s/1, uniform_s/2 are all
%%% uniformly distributed random numbers.
@@ -281,8 +286,8 @@ seed_s(Alg0, S0 = {_, _, _}) ->
-spec uniform() -> X :: float().
uniform() ->
- {X, Seed} = uniform_s(seed_get()),
- _ = seed_put(Seed),
+ {X, State} = uniform_s(seed_get()),
+ _ = seed_put(State),
X.
%% uniform/1: given an integer N >= 1,
@@ -291,8 +296,8 @@ uniform() ->
-spec uniform(N :: pos_integer()) -> X :: pos_integer().
uniform(N) ->
- {X, Seed} = uniform_s(N, seed_get()),
- _ = seed_put(Seed),
+ {X, State} = uniform_s(N, seed_get()),
+ _ = seed_put(State),
X.
%% uniform_s/1: given a state, uniform_s/1
@@ -486,7 +491,7 @@ uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits) ->
{M1 * math:pow(2.0, BitNo - 56), {Alg, R1}};
BitNo =:= -1008 ->
%% Endgame
- %% For the last round we can not have 14 zeros or more
+ %% For the last round we cannot have 14 zeros or more
%% at the top of M1 because then we will underflow,
%% so we need at least 43 bits
if
@@ -613,6 +618,11 @@ mk_alg(exsp) ->
uniform=>fun exsp_uniform/1, uniform_n=>fun exsp_uniform/2,
jump=>fun exsplus_jump/1},
fun exsplus_seed/1};
+mk_alg(exsss) ->
+ {#{type=>exsss, bits=>58, next=>fun exsss_next/1,
+ uniform=>fun exsss_uniform/1, uniform_n=>fun exsss_uniform/2,
+ jump=>fun exsplus_jump/1},
+ fun exsss_seed/1};
mk_alg(exs1024) ->
{#{type=>exs1024, max=>?MASK(64), next=>fun exs1024_next/1,
jump=>fun exs1024_jump/1},
@@ -625,7 +635,13 @@ mk_alg(exrop) ->
{#{type=>exrop, bits=>58, weak_low_bits=>1, next=>fun exrop_next/1,
uniform=>fun exrop_uniform/1, uniform_n=>fun exrop_uniform/2,
jump=>fun exrop_jump/1},
- fun exrop_seed/1}.
+ fun exrop_seed/1};
+mk_alg(exro928ss) ->
+ {#{type=>exro928ss, bits=>58, next=>fun exro928ss_next/1,
+ uniform=>fun exro928ss_uniform/1,
+ uniform_n=>fun exro928ss_uniform/2,
+ jump=>fun exro928_jump/1},
+ fun exro928_seed/1}.
%% =====================================================================
%% exs64 PRNG: Xorshift64*
@@ -635,6 +651,14 @@ mk_alg(exrop) ->
-opaque exs64_state() :: uint64().
+exs64_seed(L) when is_list(L) ->
+ [R] = seed64_nz(1, L),
+ R;
+exs64_seed(A) when is_integer(A) ->
+ [R] = seed64(1, ?MASK(64, A)),
+ R;
+%%
+%% Traditional integer triplet seed
exs64_seed({A1, A2, A3}) ->
{V1, _} = exs64_next((?MASK(32, A1) * 4294967197 + 1)),
{V2, _} = exs64_next((?MASK(32, A2) * 4294967231 + 1)),
@@ -656,11 +680,49 @@ exs64_next(R) ->
%% 58 bits fits into an immediate on 64bits erlang and is thus much faster.
%% Modification of the original Xorshift128+ algorithm to 116
%% by Sebastiano Vigna, a lot of thanks for his help and work.
+%%
+%% Reference C code for Xorshift116+ and Xorshift116**
+%%
+%% #include <stdint.h>
+%%
+%% #define MASK(b, v) (((UINT64_C(1) << (b)) - 1) & (v))
+%% #define BSL(b, v, n) (MASK((b)-(n), (v)) << (n))
+%% #define ROTL(b, v, n) (BSL((b), (v), (n)) | ((v) >> ((b)-(n))))
+%%
+%% uint64_t s[2];
+%%
+%% uint64_t next(void) {
+%% uint64_t s1 = s[0];
+%% const uint64_t s0 = s[1];
+%%
+%% s1 ^= BSL(58, s1, 24); // a
+%% s1 ^= s0 ^ (s1 >> 11) ^ (s0 >> 41); // b, c
+%% s[0] = s0;
+%% s[1] = s1;
+%%
+%% const uint64_t result_plus = MASK(58, s0 + s1);
+%% uint64_t result_starstar = s0;
+%% result_starstar = MASK(58, result_starstar * 5);
+%% result_starstar = ROTL(58, result_starstar, 7);
+%% result_starstar = MASK(58, result_starstar * 9);
+%%
+%% return result_plus;
+%% return result_starstar;
+%% }
+%%
%% =====================================================================
-opaque exsplus_state() :: nonempty_improper_list(uint58(), uint58()).
-dialyzer({no_improper_lists, exsplus_seed/1}).
+exsplus_seed(L) when is_list(L) ->
+ [S0,S1] = seed58_nz(2, L),
+ [S0|S1];
+exsplus_seed(X) when is_integer(X) ->
+ [S0,S1] = seed58(2, ?MASK(64, X)),
+ [S0|S1];
+%%
+%% Traditional integer triplet seed
exsplus_seed({A1, A2, A3}) ->
{_, R1} = exsplus_next(
[?MASK(58, (A1 * 4294967197) + 1)|
@@ -670,16 +732,62 @@ exsplus_seed({A1, A2, A3}) ->
tl(R1)]),
R2.
+-dialyzer({no_improper_lists, exsss_seed/1}).
+
+exsss_seed(L) when is_list(L) ->
+ [S0,S1] = seed58_nz(2, L),
+ [S0|S1];
+exsss_seed(X) when is_integer(X) ->
+ [S0,S1] = seed58(2, ?MASK(64, X)),
+ [S0|S1];
+%%
+%% Seed from traditional integer triple - mix into splitmix
+exsss_seed({A1, A2, A3}) ->
+ {_, X0} = seed58(?MASK(64, A1)),
+ {S0, X1} = seed58(?MASK(64, A2) bxor X0),
+ {S1, _} = seed58(?MASK(64, A3) bxor X1),
+ [S0|S1].
+
+%% Advance Xorshift116 state one step
+-define(
+ exs_next(S0, S1, S1_b),
+ begin
+ S1_b = S1 bxor ?BSL(58, S1, 24),
+ S1_b bxor S0 bxor (S1_b bsr 11) bxor (S0 bsr 41)
+ end).
+
+-define(
+ scramble_starstar(S, V_a, V_b),
+ begin
+ %% The multiply by add shifted trick avoids creating bignums
+ %% which improves performance significantly
+ %%
+ V_a = ?MASK(58, S + ?BSL(58, S, 2)), % V_a = S * 5
+ V_b = ?ROTL(58, V_a, 7),
+ ?MASK(58, V_b + ?BSL(58, V_b, 3)) % V_b * 9
+ end).
+
-dialyzer({no_improper_lists, exsplus_next/1}).
-%% Advance xorshift116+ state for one step and generate 58bit unsigned integer
+%% Advance state and generate 58bit unsigned integer
-spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}.
exsplus_next([S1|S0]) ->
%% Note: members s0 and s1 are swapped here
- S11 = S1 bxor ?BSL(58, S1, 24),
- S12 = S11 bxor S0 bxor (S11 bsr 11) bxor (S0 bsr 41),
- {?MASK(58, S0 + S12), [S0|S12]}.
+ NewS1 = ?exs_next(S0, S1, S1_1),
+ {?MASK(58, S0 + NewS1), [S0|NewS1]}.
+%% %% Note: members s0 and s1 are swapped here
+%% S11 = S1 bxor ?BSL(58, S1, 24),
+%% S12 = S11 bxor S0 bxor (S11 bsr 11) bxor (S0 bsr 41),
+%% {?MASK(58, S0 + S12), [S0|S12]}.
+
+-dialyzer({no_improper_lists, exsss_next/1}).
+-spec exsss_next(exsplus_state()) -> {uint58(), exsplus_state()}.
+exsss_next([S1|S0]) ->
+ %% Note: members s0 and s1 are swapped here
+ NewS1 = ?exs_next(S0, S1, S1_1),
+ {?scramble_starstar(S0, V_0, V_1), [S0|NewS1]}.
+%% {?MASK(58, S0 + NewS1), [S0|NewS1]}.
exsp_uniform({Alg, R0}) ->
{I, R1} = exsplus_next(R0),
@@ -687,18 +795,48 @@ exsp_uniform({Alg, R0}) ->
%% randomness quality than the others
{(I bsr (58-53)) * ?TWO_POW_MINUS53, {Alg, R1}}.
+exsss_uniform({Alg, R0}) ->
+ {I, R1} = exsss_next(R0),
+ {(I bsr (58-53)) * ?TWO_POW_MINUS53, {Alg, R1}}.
+
exsp_uniform(Range, {Alg, R}) ->
{V, R1} = exsplus_next(R),
MaxMinusRange = ?BIT(58) - Range,
?uniform_range(Range, Alg, R1, V, MaxMinusRange, I).
+exsss_uniform(Range, {Alg, R}) ->
+ {V, R1} = exsss_next(R),
+ MaxMinusRange = ?BIT(58) - Range,
+ ?uniform_range(Range, Alg, R1, V, MaxMinusRange, I).
-%% This is the jump function for the exsplus generator, equivalent
+
+%% This is the jump function for the exs* generators,
+%% i.e the Xorshift116 generators, equivalent
%% to 2^64 calls to next/1; it can be used to generate 2^52
%% non-overlapping subsequences for parallel computations.
%% Note: the jump function takes 116 times of the execution time of
%% next/1.
-
+%%
+%% #include <stdint.h>
+%%
+%% void jump(void) {
+%% static const uint64_t JUMP[] = { 0x02f8ea6bc32c797,
+%% 0x345d2a0f85f788c };
+%% int i, b;
+%% uint64_t s0 = 0;
+%% uint64_t s1 = 0;
+%% for(i = 0; i < sizeof JUMP / sizeof *JUMP; i++)
+%% for(b = 0; b < 58; b++) {
+%% if (JUMP[i] & 1ULL << b) {
+%% s0 ^= s[0];
+%% s1 ^= s[1];
+%% }
+%% next();
+%% }
+%% s[0] = s0;
+%% s[1] = s1;
+%% }
+%%
%% -define(JUMPCONST, 16#000d174a83e17de2302f8ea6bc32c797).
%% split into 58-bit chunks
%% and two iterative executions
@@ -708,7 +846,8 @@ exsp_uniform(Range, {Alg, R}) ->
-define(JUMPELEMLEN, 58).
-dialyzer({no_improper_lists, exsplus_jump/1}).
--spec exsplus_jump(state()) -> state().
+-spec exsplus_jump({alg_handler(), exsplus_state()}) ->
+ {alg_handler(), exsplus_state()}.
exsplus_jump({Alg, S}) ->
{S1, AS1} = exsplus_jump(S, [0|0], ?JUMPCONST1, ?JUMPELEMLEN),
{_, AS2} = exsplus_jump(S1, AS1, ?JUMPCONST2, ?JUMPELEMLEN),
@@ -735,6 +874,12 @@ exsplus_jump(S, [AS0|AS1], J, N) ->
-opaque exs1024_state() :: {list(uint64()), list(uint64())}.
+exs1024_seed(L) when is_list(L) ->
+ {seed64_nz(16, L), []};
+exs1024_seed(X) when is_integer(X) ->
+ {seed64(16, ?MASK(64, X)), []};
+%%
+%% Seed from traditional triple, remain backwards compatible
exs1024_seed({A1, A2, A3}) ->
B1 = ?MASK(21, (?MASK(21, A1) + 1) * 2097131),
B2 = ?MASK(21, (?MASK(21, A2) + 1) * 2097133),
@@ -806,8 +951,8 @@ exs1024_next({[H], RL}) ->
-define(JUMPTOTALLEN, 1024).
-define(RINGLEN, 16).
--spec exs1024_jump(state()) -> state().
-
+-spec exs1024_jump({alg_handler(), exs1024_state()}) ->
+ {alg_handler(), exs1024_state()}.
exs1024_jump({Alg, {L, RL}}) ->
P = length(RL),
AS = exs1024_jump({L, RL},
@@ -832,6 +977,195 @@ exs1024_jump({L, RL}, AS, JL, J, N, TN) ->
end.
%% =====================================================================
+%% exro928ss PRNG: Xoroshiro928**
+%%
+%% Reference URL: http://vigna.di.unimi.it/ftp/papers/ScrambledLinear.pdf
+%% i.e the Xoroshiro1024 generator with ** scrambler
+%% with {S, R, T} = {5, 7, 9} as recommended in the paper.
+%%
+%% {A, B, C} were tried out and selected as {44, 9, 45}
+%% and the jump coefficients calculated.
+%%
+%% Standard jump function pseudocode:
+%%
+%% Jump constant j = 0xb10773cb...44085302f77130ca
+%% Generator state: s
+%% New generator state: t = 0
+%% foreach bit in j, low to high:
+%% if the bit is one:
+%% t ^= s
+%% next s
+%% s = t
+%%
+%% Generator used for reference value calculation:
+%%
+%% #include <stdint.h>
+%% #include <stdio.h>
+%%
+%% int p = 0;
+%% uint64_t s[16];
+%%
+%% #define MASK(x) ((x) & ((UINT64_C(1) << 58) - 1))
+%% static __inline uint64_t rotl(uint64_t x, int n) {
+%% return MASK(x << n) | (x >> (58 - n));
+%% }
+%%
+%% uint64_t next() {
+%% const int q = p;
+%% const uint64_t s0 = s[p = (p + 1) & 15];
+%% uint64_t s15 = s[q];
+%%
+%% const uint64_t result_starstar = MASK(rotl(MASK(s0 * 5), 7) * 9);
+%%
+%% s15 ^= s0;
+%% s[q] = rotl(s0, 44) ^ s15 ^ MASK(s15 << 9);
+%% s[p] = rotl(s15, 45);
+%%
+%% return result_starstar;
+%% }
+%%
+%% static const uint64_t jump_2pow512[15] =
+%% { 0x44085302f77130ca, 0xba05381fdfd14902, 0x10a1de1d7d6813d2,
+%% 0xb83fe51a1eb3be19, 0xa81b0090567fd9f0, 0x5ac26d5d20f9b49f,
+%% 0x4ddd98ee4be41e01, 0x0657e19f00d4b358, 0xf02f778573cf0f0a,
+%% 0xb45a3a8a3cef3cc0, 0x6e62a33cc2323831, 0xbcb3b7c4cc049c53,
+%% 0x83f240c6007e76ce, 0xe19f5fc1a1504acd, 0x00000000b10773cb };
+%%
+%% static const uint64_t jump_2pow20[15] =
+%% { 0xbdb966a3daf905e6, 0x644807a56270cf78, 0xda90f4a806c17e9e,
+%% 0x4a426866bfad3c77, 0xaf699c306d8e7566, 0x8ebc73c700b8b091,
+%% 0xc081a7bf148531fb, 0xdc4d3af15f8a4dfd, 0x90627c014098f4b6,
+%% 0x06df2eb1feaf0fb6, 0x5bdeb1a5a90f2e6b, 0xa480c5878c3549bd,
+%% 0xff45ef33c82f3d48, 0xa30bebc15fefcc78, 0x00000000cb3d181c };
+%%
+%% void jump(const uint64_t *jump) {
+%% uint64_t j, t[16] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
+%% int m, n, k;
+%% for (m = 0; m < 15; m++, jump++) {
+%% for (n = 0, j = *jump; n < 64; n++, j >>= 1) {
+%% if ((j & 1) != 0) {
+%% for (k = 0; k < 16; k++) {
+%% t[k] ^= s[(p + k) & 15];
+%% }
+%% }
+%% next();
+%% }
+%% }
+%% for (k = 0; k < 16; k++) {
+%% s[(p + k) & 15] = t[k];
+%% }
+%% }
+%%
+%% =====================================================================
+
+-opaque exro928_state() :: {list(uint58()), list(uint58())}.
+
+-spec exro928_seed(
+ list(uint58()) | integer() | {integer(), integer(), integer()}) ->
+ exro928_state().
+exro928_seed(L) when is_list(L) ->
+ {seed58_nz(16, L), []};
+exro928_seed(X) when is_integer(X) ->
+ {seed58(16, ?MASK(64, X)), []};
+%%
+%% Seed from traditional integer triple - mix into splitmix
+exro928_seed({A1, A2, A3}) ->
+ {S0, X0} = seed58(?MASK(64, A1)),
+ {S1, X1} = seed58(?MASK(64, A2) bxor X0),
+ {S2, X2} = seed58(?MASK(64, A3) bxor X1),
+ {[S0,S1,S2|seed58(13, X2)], []}.
+
+
+%% Update the state and calculate output word
+-spec exro928ss_next(exro928_state()) -> {uint58(), exro928_state()}.
+exro928ss_next({[S15,S0|Ss], Rs}) ->
+ SR = exro928_next_state(Ss, Rs, S15, S0),
+ %%
+ %% {S, R, T} = {5, 7, 9}
+ %% const uint64_t result_starstar = rotl(s0 * S, R) * T;
+ %%
+ {?scramble_starstar(S0, V_0, V_1), SR};
+%% %% The multiply by add shifted trick avoids creating bignums
+%% %% which improves performance significantly
+%% %%
+%% V0 = ?MASK(58, S0 + ?BSL(58, S0, 2)), % V0 = S0 * 5
+%% V1 = ?ROTL(58, V0, 7),
+%% V = ?MASK(58, V1 + ?BSL(58, V1, 3)), % V = V1 * 9
+%% {V, SR};
+exro928ss_next({[S15], Rs}) ->
+ exro928ss_next({[S15|lists:reverse(Rs)], []}).
+
+-spec exro928_next(exro928_state()) -> {{uint58(),uint58()}, exro928_state()}.
+exro928_next({[S15,S0|Ss], Rs}) ->
+ SR = exro928_next_state(Ss, Rs, S15, S0),
+ {{S15,S0}, SR};
+exro928_next({[S15], Rs}) ->
+ exro928_next({[S15|lists:reverse(Rs)], []}).
+
+%% Just update the state
+-spec exro928_next_state(exro928_state()) -> exro928_state().
+exro928_next_state({[S15,S0|Ss], Rs}) ->
+ exro928_next_state(Ss, Rs, S15, S0);
+exro928_next_state({[S15], Rs}) ->
+ [S0|Ss] = lists:reverse(Rs),
+ exro928_next_state(Ss, [], S15, S0).
+
+exro928_next_state(Ss, Rs, S15, S0) ->
+ %% {A, B, C} = {44, 9, 45},
+ %% s15 ^= s0;
+ %% NewS15: s[q] = rotl(s0, A) ^ s15 ^ (s15 << B);
+ %% NewS0: s[p] = rotl(s15, C);
+ %%
+ Q = S15 bxor S0,
+ NewS15 = ?ROTL(58, S0, 44) bxor Q bxor ?BSL(58, Q, 9),
+ NewS0 = ?ROTL(58, Q, 45),
+ {[NewS0|Ss], [NewS15|Rs]}.
+
+
+exro928ss_uniform({Alg, SR}) ->
+ {V, NewSR} = exro928ss_next(SR),
+ {(V bsr (58-53)) * ?TWO_POW_MINUS53, {Alg, NewSR}}.
+
+exro928ss_uniform(Range, {Alg, SR}) ->
+ {V, NewSR} = exro928ss_next(SR),
+ MaxMinusRange = ?BIT(58) - Range,
+ ?uniform_range(Range, Alg, NewSR, V, MaxMinusRange, I).
+
+
+-spec exro928_jump({alg_handler(), exro928_state()}) ->
+ {alg_handler(), exro928_state()}.
+exro928_jump({Alg, SR}) ->
+ {Alg,exro928_jump_2pow512(SR)}.
+
+-spec exro928_jump_2pow512(exro928_state()) -> exro928_state().
+exro928_jump_2pow512(SR) ->
+ polyjump(
+ SR, fun exro928_next_state/1,
+ %% 2^512
+ [16#4085302F77130CA, 16#54E07F7F4524091,
+ 16#5E1D7D6813D2BA0, 16#4687ACEF8644287,
+ 16#4567FD9F0B83FE5, 16#43E6D27EA06C024,
+ 16#641E015AC26D5D2, 16#6CD61377663B92F,
+ 16#70A0657E19F00D4, 16#43C0BDDE15CF3C3,
+ 16#745A3A8A3CEF3CC, 16#58A8CF308C8E0C6,
+ 16#7B7C4CC049C536E, 16#431801F9DB3AF2C,
+ 16#41A1504ACD83F24, 16#6C41DCF2F867D7F]).
+
+-spec exro928_jump_2pow20(exro928_state()) -> exro928_state().
+exro928_jump_2pow20(SR) ->
+ polyjump(
+ SR, fun exro928_next_state/1,
+ %% 2^20
+ [16#5B966A3DAF905E6, 16#601E9589C33DE2F,
+ 16#74A806C17E9E644, 16#59AFEB4F1DF6A43,
+ 16#46D8E75664A4268, 16#42E2C246BDA670C,
+ 16#4531FB8EBC73C70, 16#537F702069EFC52,
+ 16#4B6DC4D3AF15F8A, 16#5A4189F0050263D,
+ 16#46DF2EB1FEAF0FB, 16#77AC696A43CB9AC,
+ 16#4C5878C3549BD5B, 16#7CCF20BCF522920,
+ 16#415FEFCC78FF45E, 16#72CF460728C2FAF]).
+
+%% =====================================================================
%% exrop PRNG: Xoroshiro116+
%%
%% Reference URL: http://xorshift.di.unimi.it/
@@ -899,6 +1233,15 @@ exs1024_jump({L, RL}, AS, JL, J, N, TN) ->
-opaque exrop_state() :: nonempty_improper_list(uint58(), uint58()).
-dialyzer({no_improper_lists, exrop_seed/1}).
+
+exrop_seed(L) when is_list(L) ->
+ [S0,S1] = seed58_nz(2, L),
+ [S0|S1];
+exrop_seed(X) when is_integer(X) ->
+ [S0,S1] = seed58(2, ?MASK(64, X)),
+ [S0|S1];
+%%
+%% Traditional integer triplet seed
exrop_seed({A1, A2, A3}) ->
[_|S1] =
exrop_next_s(
@@ -962,6 +1305,142 @@ exrop_jump([S__0|S__1] = _S, S0, S1, J, Js) ->
end.
%% =====================================================================
+%% Mask and fill state list, ensure not all zeros
+%% =====================================================================
+
+seed58_nz(N, Ss) ->
+ seed_nz(N, Ss, 58, false).
+
+seed64_nz(N, Ss) ->
+ seed_nz(N, Ss, 64, false).
+
+seed_nz(_N, [], _M, false) ->
+ erlang:error(zero_seed);
+seed_nz(0, [_|_], _M, _NZ) ->
+ erlang:error(too_many_seed_integers);
+seed_nz(0, [], _M, _NZ) ->
+ [];
+seed_nz(N, [], M, true) ->
+ [0|seed_nz(N - 1, [], M, true)];
+seed_nz(N, [S|Ss], M, NZ) ->
+ if
+ is_integer(S) ->
+ R = ?MASK(M, S),
+ [R|seed_nz(N - 1, Ss, M, NZ orelse R =/= 0)];
+ true ->
+ erlang:error(non_integer_seed)
+ end.
+
+%% =====================================================================
+%% Splitmix seeders, lowest bits of SplitMix64, zeros skipped
+%% =====================================================================
+
+-spec seed58(non_neg_integer(), uint64()) -> list(uint58()).
+seed58(0, _X) ->
+ [];
+seed58(N, X) ->
+ {Z,NewX} = seed58(X),
+ [Z|seed58(N - 1, NewX)].
+%%
+seed58(X_0) ->
+ {Z0,X} = splitmix64_next(X_0),
+ case ?MASK(58, Z0) of
+ 0 ->
+ seed58(X);
+ Z ->
+ {Z,X}
+ end.
+
+-spec seed64(non_neg_integer(), uint64()) -> list(uint64()).
+seed64(0, _X) ->
+ [];
+seed64(N, X) ->
+ {Z,NewX} = seed64(X),
+ [Z|seed64(N - 1, NewX)].
+%%
+seed64(X_0) ->
+ {Z,X} = ZX = splitmix64_next(X_0),
+ if
+ Z =:= 0 ->
+ seed64(X);
+ true ->
+ ZX
+ end.
+
+%% The SplitMix64 generator:
+%%
+%% uint64_t splitmix64_next() {
+%% uint64_t z = (x += 0x9e3779b97f4a7c15);
+%% z = (z ^ (z >> 30)) * 0xbf58476d1ce4e5b9;
+%% z = (z ^ (z >> 27)) * 0x94d049bb133111eb;
+%% return z ^ (z >> 31);
+%% }
+%%
+splitmix64_next(X_0) ->
+ X = ?MASK(64, X_0 + 16#9e3779b97f4a7c15),
+ Z_0 = ?MASK(64, (X bxor (X bsr 30)) * 16#bf58476d1ce4e5b9),
+ Z_1 = ?MASK(64, (Z_0 bxor (Z_0 bsr 27)) * 16#94d049bb133111eb),
+ {?MASK(64, Z_1 bxor (Z_1 bsr 31)),X}.
+
+%% =====================================================================
+%% Polynomial jump with a jump constant word list,
+%% high bit in each word marking top of word,
+%% SR is a {Forward, Reverse} queue tuple with Forward never empty
+%% =====================================================================
+
+polyjump({Ss, Rs} = SR, NextState, JumpConst) ->
+ %% Create new state accumulator T
+ Ts = lists:duplicate(length(Ss) + length(Rs), 0),
+ polyjump(SR, NextState, JumpConst, Ts).
+%%
+%% Foreach jump word
+polyjump(_SR, _NextState, [], Ts) ->
+ %% Return new calculated state
+ {Ts, []};
+polyjump(SR, NextState, [J|Js], Ts) ->
+ polyjump(SR, NextState, Js, Ts, J).
+%%
+%% Foreach bit in jump word until top bit
+polyjump(SR, NextState, Js, Ts, 1) ->
+ polyjump(SR, NextState, Js, Ts);
+polyjump({Ss, Rs} = SR, NextState, Js, Ts, J) when J =/= 0 ->
+ NewSR = NextState(SR),
+ NewJ = J bsr 1,
+ case ?MASK(1, J) of
+ 0 ->
+ polyjump(NewSR, NextState, Js, Ts, NewJ);
+ 1 ->
+ %% Xor this state onto T
+ polyjump(NewSR, NextState, Js, xorzip_sr(Ts, Ss, Rs), NewJ)
+ end.
+
+xorzip_sr([], [], undefined) ->
+ [];
+xorzip_sr(Ts, [], Rs) ->
+ xorzip_sr(Ts, lists:reverse(Rs), undefined);
+xorzip_sr([T|Ts], [S|Ss], Rs) ->
+ [T bxor S|xorzip_sr(Ts, Ss, Rs)].
+
+%% =====================================================================
+
+format_jumpconst58(String) ->
+ ReOpts = [{newline,any},{capture,all_but_first,binary},global],
+ {match,Matches} = re:run(String, "0x([a-zA-Z0-9]+)", ReOpts),
+ format_jumcons58_matches(lists:reverse(Matches), 0).
+
+format_jumcons58_matches([], J) ->
+ format_jumpconst58_value(J);
+format_jumcons58_matches([[Bin]|Matches], J) ->
+ NewJ = (J bsl 64) bor binary_to_integer(Bin, 16),
+ format_jumcons58_matches(Matches, NewJ).
+
+format_jumpconst58_value(0) ->
+ ok;
+format_jumpconst58_value(J) ->
+ io:format("16#~s,~n", [integer_to_list(?MASK(58, J) bor ?BIT(58), 16)]),
+ format_jumpconst58_value(J bsr 58).
+
+%% =====================================================================
%% Ziggurat cont
%% =====================================================================
-define(NOR_R, 3.6541528853610087963519472518).
diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl
index 5e8c1a43ea..4791e3ebda 100644
--- a/lib/stdlib/src/slave.erl
+++ b/lib/stdlib/src/slave.erl
@@ -104,18 +104,17 @@ relay1(Pid) ->
%% this to work is that the 'erl' program can be found in PATH.
%%
%% If the master and slave are on different hosts, start/N uses
-%% the 'rsh' program to spawn an Erlang node on the other host.
+%% the 'ssh' program to spawn an Erlang node on the other host.
%% Alternative, if the master was started as
%% 'erl -sname xxx -rsh my_rsh...', then 'my_rsh' will be used instead
-%% of 'rsh' (this is useful for systems where the rsh program is named
-%% 'remsh').
+%% of 'ssh' (this is useful for systems still using rsh or remsh).
%%
%% For this to work, the following conditions must be fulfilled:
%%
-%% 1. There must be an Rsh program on computer; if not an error
+%% 1. There must be an ssh program on computer; if not an error
%% is returned.
%%
-%% 2. The hosts must be configured to allowed 'rsh' access without
+%% 2. The hosts must be configured to allow 'ssh' access without
%% prompts for password.
%%
%% The slave node will have its filer and user server redirected
@@ -286,7 +285,7 @@ register_unique_name(Number) ->
%% Makes up the command to start the nodes.
%% If the node should run on the local host, there is
-%% no need to use rsh.
+%% no need to use a remote shell.
mk_cmd(Host, Name, Args, Waiter, Prog0) ->
Prog = quote_progname(Prog0),
@@ -342,9 +341,7 @@ do_quote_progname([Prog,Arg|Args]) ->
lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args]))
end.
-%% Give the user an opportunity to run another program,
-%% than the "rsh". On HP-UX rsh is called remsh; thus HP users
-%% must start erlang as erl -rsh remsh.
+%% Give the user an opportunity to run another program than "ssh".
%%
%% Also checks that the given program exists.
%%
@@ -354,7 +351,7 @@ rsh() ->
Rsh =
case init:get_argument(rsh) of
{ok, [[Prog]]} -> Prog;
- _ -> "rsh"
+ _ -> "ssh"
end,
case os:find_executable(Rsh) of
false -> {error, no_rsh};
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index cd09872b87..ecb514e9f3 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -108,7 +108,7 @@
dets]},
{applications, [kernel]},
{env, []},
- {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.0","crypto-3.3",
+ {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.4","crypto-3.3",
"compiler-5.0"]}
]}.
diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src
index 9a1b92a87c..4990c81dfe 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -19,22 +19,15 @@
%%
%% We allow upgrade from, and downgrade to all previous
%% versions from the following OTP releases:
-%% - OTP 20
%% - OTP 21
+%% - OTP 22
%%
%% We also allow upgrade from, and downgrade to all
%% versions that have branched off from the above
%% stated previous versions.
%%
{"%VSN%",
- [{<<"^3\\.4$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.4(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.5(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.5$">>,[restart_new_emulator]},
+ [{<<"^3\\.5$">>,[restart_new_emulator]},
{<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^3\\.6$">>,[restart_new_emulator]},
@@ -44,15 +37,11 @@
{<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^3\\.8$">>,[restart_new_emulator]},
{<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}],
- [{<<"^3\\.4$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.4(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.4\\.5(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
- {<<"^3\\.5$">>,[restart_new_emulator]},
+ {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.8\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.9$">>,[restart_new_emulator]},
+ {<<"^3\\.9\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}],
+ [{<<"^3\\.5$">>,[restart_new_emulator]},
{<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^3\\.6$">>,[restart_new_emulator]},
@@ -62,4 +51,7 @@
{<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^3\\.8$">>,[restart_new_emulator]},
{<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}.
+ {<<"^3\\.8\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.8\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.9$">>,[restart_new_emulator]},
+ {<<"^3\\.9\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}.
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 2939e78d9d..a418754caf 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -128,7 +128,8 @@ length(CD) ->
to_graphemes(CD0) ->
case unicode_util:gc(CD0) of
[GC|CD] -> [GC|to_graphemes(CD)];
- [] -> []
+ [] -> [];
+ {error, Err} -> error({badarg, Err})
end.
%% Compare two strings return boolean, assumes that the input are
@@ -332,7 +333,10 @@ uppercase(<<CP1/utf8, Rest/binary>>=Orig) ->
catch unchanged -> Orig
end;
uppercase(<<>>) ->
- <<>>.
+ <<>>;
+uppercase(Bin) ->
+ error({badarg, Bin}).
+
%% Lowercase all chars in Str
-spec lowercase(String::unicode:chardata()) -> unicode:chardata().
@@ -346,7 +350,10 @@ lowercase(<<CP1/utf8, Rest/binary>>=Orig) ->
catch unchanged -> Orig
end;
lowercase(<<>>) ->
- <<>>.
+ <<>>;
+lowercase(Bin) ->
+ error({badarg, Bin}).
+
%% Make a titlecase of the first char in Str
-spec titlecase(String::unicode:chardata()) -> unicode:chardata().
@@ -375,7 +382,9 @@ casefold(<<CP1/utf8, Rest/binary>>=Orig) ->
catch unchanged -> Orig
end;
casefold(<<>>) ->
- <<>>.
+ <<>>;
+casefold(Bin) ->
+ error({badarg, Bin}).
-spec to_integer(String) -> {Int, Rest} | {'error', Reason} when
String :: unicode:chardata(),
@@ -544,7 +553,8 @@ length_1([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2) ->
length_1(Str, N) ->
case unicode_util:gc(Str) of
[] -> N;
- [_|Rest] -> length_1(Rest, N+1)
+ [_|Rest] -> length_1(Rest, N+1);
+ {error, Err} -> error({badarg, Err})
end.
length_b(<<CP2/utf8, Rest/binary>>, CP1, N)
@@ -554,7 +564,8 @@ length_b(Bin0, CP1, N) ->
[_|Bin1] = unicode_util:gc([CP1|Bin0]),
case unicode_util:cp(Bin1) of
[] -> N+1;
- [CP3|Bin] -> length_b(Bin, CP3, N+1)
+ [CP3|Bin] -> length_b(Bin, CP3, N+1);
+ {error, Err} -> error({badarg, Err})
end.
equal_1([A|AR], [B|BR]) when is_integer(A), is_integer(B) ->
@@ -599,7 +610,8 @@ reverse_1([CP1|[CP2|_]=Cont], Acc) when ?ASCII_LIST(CP1,CP2) ->
reverse_1(CD, Acc) ->
case unicode_util:gc(CD) of
[GC|Rest] -> reverse_1(Rest, [GC|Acc]);
- [] -> Acc
+ [] -> Acc;
+ {error, Err} -> error({badarg, Err})
end.
reverse_b(<<CP2/utf8, Rest/binary>>, CP1, Acc)
@@ -609,7 +621,8 @@ reverse_b(Bin0, CP1, Acc) ->
[GC|Bin1] = unicode_util:gc([CP1|Bin0]),
case unicode_util:cp(Bin1) of
[] -> [GC|Acc];
- [CP3|Bin] -> reverse_b(Bin, CP3, [GC|Acc])
+ [CP3|Bin] -> reverse_b(Bin, CP3, [GC|Acc]);
+ {error, Err} -> error({badarg, Err})
end.
slice_l0(<<CP1/utf8, Bin/binary>>, N) when N > 0 ->
@@ -622,7 +635,8 @@ slice_l([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 ->
slice_l(CD, N) when N > 0 ->
case unicode_util:gc(CD) of
[_|Cont] -> slice_l(Cont, N-1);
- [] -> []
+ [] -> [];
+ {error, Err} -> error({badarg, Err})
end;
slice_l(Cont, 0) ->
Cont.
@@ -634,7 +648,8 @@ slice_lb(Bin, CP1, N) ->
if N > 1 ->
case unicode_util:cp(Rest) of
[CP2|Cont] -> slice_lb(Cont, CP2, N-1);
- [] -> <<>>
+ [] -> <<>>;
+ {error, Err} -> error({badarg, Err})
end;
N =:= 1 ->
Rest
@@ -647,7 +662,10 @@ slice_trail(Orig, N) when is_binary(Orig) ->
Sz = byte_size(Orig) - Length,
<<Keep:Sz/binary, _/binary>> = Orig,
Keep;
- _ -> <<>>
+ <<_, _/binary>> when N > 0 ->
+ error({badarg, Orig});
+ _ ->
+ <<>>
end;
slice_trail(CD, N) when is_list(CD) ->
slice_list(CD, N).
@@ -657,7 +675,8 @@ slice_list([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 ->
slice_list(CD, N) when N > 0 ->
case unicode_util:gc(CD) of
[GC|Cont] -> append(GC, slice_list(Cont, N-1));
- [] -> []
+ [] -> [];
+ {error, Err} -> error({badarg, Err})
end;
slice_list(_, 0) ->
[].
@@ -668,7 +687,8 @@ slice_bin(CD, CP1, N) when N > 0 ->
[_|Bin] = unicode_util:gc([CP1|CD]),
case unicode_util:cp(Bin) of
[CP2|Cont] -> slice_bin(Cont, CP2, N-1);
- [] -> 0
+ [] -> 0;
+ {error, Err} -> error({badarg, Err})
end;
slice_bin(CD, CP1, 0) ->
byte_size(CD)+byte_size(<<CP1/utf8>>).
@@ -703,14 +723,18 @@ uppercase_bin(CP1, Bin, Changed) ->
[] when Changed ->
[CP1];
[] ->
- throw(unchanged)
+ throw(unchanged);
+ {error, Err} ->
+ error({badarg, Err})
end;
[Char|CPs] ->
case unicode_util:cp(CPs) of
[Next|Rest] ->
[Char|uppercase_bin(Next, Rest, true)];
[] ->
- [Char]
+ [Char];
+ {error, Err} ->
+ error({badarg, Err})
end
end.
@@ -744,14 +768,18 @@ lowercase_bin(CP1, Bin, Changed) ->
[] when Changed ->
[CP1];
[] ->
- throw(unchanged)
+ throw(unchanged);
+ {error, Err} ->
+ error({badarg, Err})
end;
[Char|CPs] ->
case unicode_util:cp(CPs) of
[Next|Rest] ->
[Char|lowercase_bin(Next, Rest, true)];
[] ->
- [Char]
+ [Char];
+ {error, Err} ->
+ error({badarg, Err})
end
end.
@@ -785,14 +813,18 @@ casefold_bin(CP1, Bin, Changed) ->
[] when Changed ->
[CP1];
[] ->
- throw(unchanged)
+ throw(unchanged);
+ {error, Err} ->
+ error({badarg, Err})
end;
[Char|CPs] ->
case unicode_util:cp(CPs) of
[Next|Rest] ->
[Char|casefold_bin(Next, Rest, true)];
[] ->
- [Char]
+ [Char];
+ {error, Err} ->
+ error({badarg, Err})
end
end.
@@ -1247,18 +1279,20 @@ split_1(Bin, [_C|_]=Needle, Start, Where, Curr0, Acc) ->
end
end.
-lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps, Ts) when is_integer(CP) ->
+lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps0, Ts) when is_integer(CP) ->
case lists:member(CP, CPs) of
true ->
[GC|Cs2] = unicode_util:gc(Cs0),
case lists:member(GC, GCs) of
true ->
- lexemes_m(Cs2, Seps, Ts);
+ lexemes_m(Cs2, Seps0, Ts);
false ->
+ Seps = search_compile(Seps0),
{Lexeme,Rest} = lexeme_pick(Cs0, Seps, []),
lexemes_m(Rest, Seps, [Lexeme|Ts])
end;
false ->
+ Seps = search_compile(Seps0),
{Lexeme,Rest} = lexeme_pick(Cs0, Seps, []),
lexemes_m(Rest, Seps, [Lexeme|Ts])
end;
@@ -1632,7 +1666,9 @@ bin_search_inv_1(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Sep) ->
bin_search_inv_1(<<>>, Cont, _Sep) ->
{nomatch, Cont};
bin_search_inv_1([], Cont, _Sep) ->
- {nomatch, Cont}.
+ {nomatch, Cont};
+bin_search_inv_1(Bin, _, _) ->
+ error({badarg, Bin}).
bin_search_inv_n(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Seps) ->
@@ -1664,7 +1700,9 @@ bin_search_inv_n(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Seps) ->
bin_search_inv_n(<<>>, Cont, _Sep) ->
{nomatch, Cont};
bin_search_inv_n([], Cont, _Sep) ->
- {nomatch, Cont}.
+ {nomatch, Cont};
+bin_search_inv_n(Bin, _, _) ->
+ error({badarg, Bin}).
bin_search_str(Bin0, Start, [], SearchCPs) ->
Compiled = binary:compile_pattern(unicode:characters_to_binary(SearchCPs)),
diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl
index 0064414d6f..6ff9aa33b4 100644
--- a/lib/stdlib/src/sys.erl
+++ b/lib/stdlib/src/sys.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,22 +30,30 @@
log_to_file/2, log_to_file/3, no_debug/1, no_debug/2,
install/2, install/3, remove/2, remove/3]).
-export([handle_system_msg/6, handle_system_msg/7, handle_debug/4,
- print_log/1, get_debug/3, debug_options/1, suspend_loop_hib/6]).
+ print_log/1, get_log/1, get_debug/3, debug_options/1, suspend_loop_hib/6]).
+-deprecated([{get_debug,3,eventually}]).
%%-----------------------------------------------------------------
%% Types
%%-----------------------------------------------------------------
--export_type([dbg_opt/0]).
+-export_type([dbg_opt/0, dbg_fun/0, debug_option/0]).
-type name() :: pid() | atom()
| {'global', term()}
| {'via', module(), term()}.
-type system_event() :: {'in', Msg :: _}
- | {'in', Msg :: _, From :: _}
+ | {'in', Msg :: _, State :: _}
| {'out', Msg :: _, To :: _}
| {'out', Msg :: _, To :: _, State :: _}
- | term().
+ | {'noreply', State :: _}
+ | {'continue', Continuation :: _}
+ | {'code_change', Event :: _, State :: _}
+ | {'postpone', Event :: _, State :: _, NextState :: _}
+ | {'consume', Event :: _, State :: _, NextState :: _}
+ | {'enter', State :: _}
+ | {'terminate', Reason :: _, State :: _}
+ | term().
-opaque dbg_opt() :: {'trace', 'true'}
| {'log',
{N :: non_neg_integer(),
@@ -67,6 +75,16 @@
Event :: system_event(),
Extra :: term()) -> any()).
+-type debug_option() ::
+ 'trace'
+ | 'log'
+ | {'log', N :: pos_integer()}
+ | 'statistics'
+ | {'log_to_file', FileName :: file:name()}
+ | {'install',
+ {Func :: dbg_fun(), FuncState :: term()}
+ | {FuncId :: term(), Func :: dbg_fun(), FuncState :: term()}}.
+
%%-----------------------------------------------------------------
%% System messages
%%-----------------------------------------------------------------
@@ -385,31 +403,41 @@ handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib) ->
FormFunc :: format_fun(),
Extra :: term(),
Event :: system_event().
-handle_debug([{trace, true} | T], FormFunc, State, Event) ->
+handle_debug([{trace, true} = DbgOpt | T], FormFunc, State, Event) ->
print_event({Event, State, FormFunc}),
- [{trace, true} | handle_debug(T, FormFunc, State, Event)];
-handle_debug([{log, {N, LogData}} | T], FormFunc, State, Event) ->
- NLogData = [{Event, State, FormFunc} | trim(N, LogData)],
- [{log, {N, NLogData}} | handle_debug(T, FormFunc, State, Event)];
-handle_debug([{log_to_file, Fd} | T], FormFunc, State, Event) ->
+ [DbgOpt | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{log, NLog} | T], FormFunc, State, Event) ->
+ Item = {Event, State, FormFunc},
+ [{log, nlog_put(Item, NLog)} | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{log_to_file, Fd} = DbgOpt | T], FormFunc, State, Event) ->
print_event(Fd, {Event, State, FormFunc}),
- [{log_to_file, Fd} | handle_debug(T, FormFunc, State, Event)];
+ [DbgOpt | handle_debug(T, FormFunc, State, Event)];
handle_debug([{statistics, StatData} | T], FormFunc, State, Event) ->
NStatData = stat(Event, StatData),
[{statistics, NStatData} | handle_debug(T, FormFunc, State, Event)];
handle_debug([{FuncId, {Func, FuncState}} | T], FormFunc, State, Event) ->
- case catch Func(FuncState, Event, State) of
+ try Func(FuncState, Event, State) of
+ done -> handle_debug(T, FormFunc, State, Event);
+ NFuncState ->
+ [{FuncId, {Func, NFuncState}} |
+ handle_debug(T, FormFunc, State, Event)]
+ catch
done -> handle_debug(T, FormFunc, State, Event);
- {'EXIT', _} -> handle_debug(T, FormFunc, State, Event);
NFuncState ->
- [{FuncId, {Func, NFuncState}} | handle_debug(T, FormFunc, State, Event)]
+ [{FuncId, {Func, NFuncState}} |
+ handle_debug(T, FormFunc, State, Event)];
+ _:_ -> handle_debug(T, FormFunc, State, Event)
end;
handle_debug([{Func, FuncState} | T], FormFunc, State, Event) ->
- case catch Func(FuncState, Event, State) of
+ try Func(FuncState, Event, State) of
done -> handle_debug(T, FormFunc, State, Event);
- {'EXIT', _} -> handle_debug(T, FormFunc, State, Event);
- NFuncState ->
+ NFuncState ->
[{Func, NFuncState} | handle_debug(T, FormFunc, State, Event)]
+ catch
+ done -> handle_debug(T, FormFunc, State, Event);
+ NFuncState ->
+ [{Func, NFuncState} | handle_debug(T, FormFunc, State, Event)];
+ _:_ -> handle_debug(T, FormFunc, State, Event)
end;
handle_debug([], _FormFunc, _State, _Event) ->
[].
@@ -526,19 +554,19 @@ debug_cmd({trace, true}, Debug) ->
debug_cmd({trace, false}, Debug) ->
{ok, remove_debug(trace, Debug)};
debug_cmd({log, true}, Debug) ->
- {_N, Logs} = get_debug(log, Debug, {0, []}),
- {ok, install_debug(log, {10, trim(10, Logs)}, Debug)};
-debug_cmd({log, {true, N}}, Debug) when is_integer(N), N > 0 ->
- {_N, Logs} = get_debug(log, Debug, {0, []}),
- {ok, install_debug(log, {N, trim(N, Logs)}, Debug)};
+ NLog = get_debug(log, Debug, nlog_new()),
+ {ok, install_debug(log, nlog_new(NLog), Debug)};
+debug_cmd({log, {true, N}}, Debug) when is_integer(N), 1 =< N ->
+ NLog = get_debug(log, Debug, nlog_new(N)),
+ {ok, install_debug(log, nlog_new(N, NLog), Debug)};
debug_cmd({log, false}, Debug) ->
{ok, remove_debug(log, Debug)};
debug_cmd({log, print}, Debug) ->
print_log(Debug),
{ok, Debug};
debug_cmd({log, get}, Debug) ->
- {_N, Logs} = get_debug(log, Debug, {0, []}),
- {{ok, lists:reverse(Logs)}, Debug};
+ NLog = get_debug(log, Debug, nlog_new()),
+ {{ok, [Event || {Event, _State, _FormFunc} <- nlog_get(NLog)]}, Debug};
debug_cmd({log_to_file, false}, Debug) ->
NDebug = close_log_file(Debug),
{ok, NDebug};
@@ -595,9 +623,6 @@ stat({out, _Msg, _To}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
stat({out, _Msg, _To, _State}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
stat(_, StatData) -> StatData.
-trim(N, LogData) ->
- lists:sublist(LogData, 1, N-1).
-
%%-----------------------------------------------------------------
%% Debug structure manipulating functions
%%-----------------------------------------------------------------
@@ -625,9 +650,14 @@ get_debug2(Item, Debug, Default) ->
-spec print_log(Debug) -> 'ok' when
Debug :: [dbg_opt()].
print_log(Debug) ->
- {_N, Logs} = get_debug(log, Debug, {0, []}),
- lists:foreach(fun print_event/1,
- lists:reverse(Logs)).
+ NLog = get_debug(log, Debug, nlog_new()),
+ lists:foreach(fun print_event/1, nlog_get(NLog)).
+
+-spec get_log(Debug) -> [system_event()] when
+ Debug :: [dbg_opt()].
+get_log(Debug) ->
+ NLog = get_debug(log, Debug, nlog_new()),
+ [Event || {Event, _State, _FormFunc} <- nlog_get(NLog)].
close_log_file(Debug) ->
case get_debug2(log_to_file, Debug, []) of
@@ -639,6 +669,74 @@ close_log_file(Debug) ->
end.
%%-----------------------------------------------------------------
+%% Keep the last N Log functions
+%%-----------------------------------------------------------------
+%%
+%% Streamlined Okasaki queue as base for "keep the last N" log.
+%%
+%% To the reverse list head we cons new items.
+%% The forward list contains elements in insertion order,
+%% so the head is the oldest and the one to drop off
+%% when the log is full.
+%%
+%% Here is how we can get away with only using one cons cell
+%% to wrap the forward and reverse list, and the log size:
+%%
+%% A full log does not need a counter; we just cons one
+%% and drop one:
+%%
+%% [ReverseList|ForwardList]
+%%
+%% A non-full log is filling up to N elements;
+%% use a down counter instead of a list as first element:
+%%
+%% [RemainingToFullCount|ReverseList]
+
+nlog_new() ->
+ nlog_new(10).
+%%
+nlog_new([_|_] = NLog) ->
+ nlog_new(10, NLog);
+nlog_new(N) ->
+ [N]. % Empty log size N >= 1
+%%
+nlog_new(N, NLog) ->
+ lists:foldl(
+ fun (Item, NL) -> nlog_put(Item, NL) end,
+ nlog_new(N),
+ nlog_get(NLog)).
+
+%%
+nlog_put(Item, NLog) ->
+ case NLog of
+ [R|FF] when is_list(R) ->
+ %% Full log
+ case FF of
+ [_|F] ->
+ %% Cons to reverse list, drop from forward list
+ [[Item|R]|F];
+ [] ->
+ %% Create new forward list from reverse list,
+ %% create new empty reverse list
+ [_|F] = lists:reverse(R, [Item]),
+ [[]|F]
+ end;
+ [1|R] ->
+ %% Log now gets full
+ [[Item|R]];
+ [J|R] ->
+ %% Filling up to N elements
+ [J - 1,Item|R]
+ end.
+
+nlog_get([[]|F]) ->
+ F;
+nlog_get([[_|_] = R|F]) ->
+ F ++ lists:reverse(R);
+nlog_get([_J|R]) ->
+ lists:reverse(R).
+
+%%-----------------------------------------------------------------
%% Func: debug_options/1
%% Purpose: Initiate a debug structure. Called by a process that
%% wishes to initiate the debug structure without the
@@ -646,28 +744,16 @@ close_log_file(Debug) ->
%% Returns: [debug_opts()]
%%-----------------------------------------------------------------
--spec debug_options(Options) -> [dbg_opt()] when
- Options :: [Opt],
- Opt :: 'trace'
- | 'log'
- | {'log', pos_integer()}
- | 'statistics'
- | {'log_to_file', FileName}
- | {'install', FuncSpec},
- FileName :: file:name(),
- FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
- FuncId :: term(),
- Func :: dbg_fun(),
- FuncState :: term().
+-spec debug_options([Opt :: debug_option()]) -> [dbg_opt()].
debug_options(Options) ->
debug_options(Options, []).
debug_options([trace | T], Debug) ->
debug_options(T, install_debug(trace, true, Debug));
debug_options([log | T], Debug) ->
- debug_options(T, install_debug(log, {10, []}, Debug));
+ debug_options(T, install_debug(log, nlog_new(), Debug));
debug_options([{log, N} | T], Debug) when is_integer(N), N > 0 ->
- debug_options(T, install_debug(log, {N, []}, Debug));
+ debug_options(T, install_debug(log, nlog_new(N), Debug));
debug_options([statistics | T], Debug) ->
debug_options(T, install_debug(statistics, init_stat(), Debug));
debug_options([{log_to_file, FileName} | T], Debug) ->
diff --git a/lib/stdlib/src/uri_string.erl b/lib/stdlib/src/uri_string.erl
index f07307c039..d33dc89af8 100644
--- a/lib/stdlib/src/uri_string.erl
+++ b/lib/stdlib/src/uri_string.erl
@@ -415,7 +415,7 @@ transcode(URIString, Options) when is_list(URIString) ->
%% (application/x-www-form-urlencoded encoding algorithm)
%%-------------------------------------------------------------------------
-spec compose_query(QueryList) -> QueryString when
- QueryList :: [{unicode:chardata(), unicode:chardata()}],
+ QueryList :: [{unicode:chardata(), unicode:chardata() | true}],
QueryString :: uri_string()
| error().
compose_query(List) ->
@@ -423,7 +423,7 @@ compose_query(List) ->
-spec compose_query(QueryList, Options) -> QueryString when
- QueryList :: [{unicode:chardata(), unicode:chardata()}],
+ QueryList :: [{unicode:chardata(), unicode:chardata() | true}],
Options :: [{encoding, atom()}],
QueryString :: uri_string()
| error().
@@ -435,6 +435,11 @@ compose_query(List, Options) ->
throw:{error, Atom, RestData} -> {error, Atom, RestData}
end.
%%
+compose_query([{Key,true}|Rest], Options, IsList, Acc) ->
+ Separator = get_separator(Rest),
+ K = form_urlencode(Key, Options),
+ IsListNew = IsList orelse is_list(Key),
+ compose_query(Rest, Options, IsListNew, <<Acc/binary,K/binary,Separator/binary>>);
compose_query([{Key,Value}|Rest], Options, IsList, Acc) ->
Separator = get_separator(Rest),
K = form_urlencode(Key, Options),
@@ -454,7 +459,7 @@ compose_query([], _Options, IsList, Acc) ->
%%-------------------------------------------------------------------------
-spec dissect_query(QueryString) -> QueryList when
QueryString :: uri_string(),
- QueryList :: [{unicode:chardata(), unicode:chardata()}]
+ QueryList :: [{unicode:chardata(), unicode:chardata() | true}]
| error().
dissect_query(<<>>) ->
[];
@@ -1889,13 +1894,12 @@ dissect_query_key(<<$=,T/binary>>, IsList, Acc, Key, Value) ->
dissect_query_value(T, IsList, Acc, Key, Value);
dissect_query_key(<<"&#",T/binary>>, IsList, Acc, Key, Value) ->
dissect_query_key(T, IsList, Acc, <<Key/binary,"&#">>, Value);
-dissect_query_key(<<$&,_T/binary>>, _IsList, _Acc, _Key, _Value) ->
- throw({error, missing_value, "&"});
+dissect_query_key(T = <<$&,_/binary>>, IsList, Acc, Key, <<>>) ->
+ dissect_query_value(T, IsList, Acc, Key, true);
dissect_query_key(<<H,T/binary>>, IsList, Acc, Key, Value) ->
dissect_query_key(T, IsList, Acc, <<Key/binary,H>>, Value);
-dissect_query_key(B, _, _, _, _) ->
- throw({error, missing_value, B}).
-
+dissect_query_key(T = <<>>, IsList, Acc, Key, <<>>) ->
+ dissect_query_value(T, IsList, Acc, Key, true).
dissect_query_value(<<$&,T/binary>>, IsList, Acc, Key, Value) ->
K = form_urldecode(IsList, Key),
@@ -1908,9 +1912,10 @@ dissect_query_value(<<>>, IsList, Acc, Key, Value) ->
V = form_urldecode(IsList, Value),
lists:reverse([{K,V}|Acc]).
-
%% HTML 5.2 - 4.10.21.6 URL-encoded form data - WHATWG URL (10 Jan 2018) - UTF-8
%% HTML 5.0 - 4.10.22.6 URL-encoded form data - decoding (non UTF-8)
+form_urldecode(_, true) ->
+ true;
form_urldecode(true, B) ->
Result = base10_decode(form_urldecode(B, <<>>)),
convert_to_list(Result, utf8);
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 07:07:10 +0000