Merge branch 'rickard/timer-optimization/OTP-12650'

* rickard/timer-optimization/OTP-12650:
  Optimized timer implementation
  Reusable red-black tree implementation

Conflicts:
	erts/emulator/beam/erl_bif_timer.c

6 files changed, 53 insertions, 432 deletions

diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 3478a80dd4..ce61199567 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index 9ed45b34bf..bee3477b2e 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index 7361139cde..f3abb5c1c7 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 629702fc1c..4ef4288ead 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -129,10 +129,11 @@
 -export([process_display/2]).
 -export([process_flag/3, process_info/1, processes/0, purge_module/1]).
 -export([put/2, raise/3, read_timer/1, read_timer/2, ref_to_list/1, register/2]).
--export([registered/0, resume_process/1, round/1, self/0, send_after/3]).
+-export([send_after/3, send_after/4, start_timer/3, start_timer/4]).
+-export([registered/0, resume_process/1, round/1, self/0]).
 -export([seq_trace/2, seq_trace_print/1, seq_trace_print/2, setnode/2]).
 -export([setnode/3, size/1, spawn/3, spawn_link/3, split_binary/2]).
--export([start_timer/3, suspend_process/2, system_monitor/0]).
+-export([suspend_process/2, system_monitor/0]).
 -export([system_monitor/1, system_monitor/2, system_profile/0]).
 -export([system_profile/2, throw/1, time/0, trace/3, trace_delivered/1]).
 -export([trace_info/2, trunc/1, tuple_size/1, universaltime/0]).
@@ -427,23 +428,9 @@ call_on_load_function(_P1) ->
 -spec erlang:cancel_timer(TimerRef) -> Time | false when
       TimerRef :: reference(),
       Time :: non_neg_integer().
-cancel_timer(TimerRef) ->
-    try
-	case erts_internal:access_bif_timer(TimerRef) of
-	    undefined ->
-		false;
-	    {BTR, TSrv} ->
-		Req = erlang:make_ref(),
-		TSrv ! {cancel_timeout, BTR, erlang:self(),
-			true, Req, TimerRef},
-		receive
-		    {cancel_timer, Req, Result} ->
-			Result
-		end
-	end
-    catch
-	_:_ -> erlang:error(badarg, [TimerRef])
-    end.
+
+cancel_timer(_TimerRef) ->
+    erlang:nif_error(undefined).
 
 %% cancel_timer/2
 -spec erlang:cancel_timer(TimerRef, Options) -> Time | false | ok when
@@ -451,53 +438,9 @@ cancel_timer(TimerRef) ->
       Option :: {async, boolean()} | {info, boolean()},
       Options :: [Option],
       Time :: non_neg_integer().
-cancel_timer(TimerRef, Options) ->
-    try
-	{Async, Info} = get_cancel_timer_options(Options, false, true),
-	case erts_internal:access_bif_timer(TimerRef) of
-	    undefined ->
-		case {Async, Info} of
-		    {true, true} ->
-			erlang:self() ! {cancel_timer, TimerRef, false}, ok;
-		    {false, true} ->
-			false;
-		    _ ->
-			ok
-		end;
-	    {BTR, TSrv} ->
-		case Async of
-		    true ->
-			TSrv ! {cancel_timeout, BTR, erlang:self(),
-				Info, TimerRef, TimerRef},
-			ok;
-		    false ->
-			Req = erlang:make_ref(),
-			TSrv ! {cancel_timeout, BTR, erlang:self(),
-				true, Req, TimerRef},
-			receive
-			    {cancel_timer, Req, Result} ->
-				case Info of
-				    true -> Result;
-				    false -> ok
-				end
-			end
-		end
-	end
-    catch
-	_:_ -> erlang:error(badarg, [TimerRef, Options])
-    end.
 
-get_cancel_timer_options([], Async, Info) ->
-    {Async, Info};
-get_cancel_timer_options([{async, Bool} | Opts],
-			 _Async, Info) when Bool == true;
-					    Bool == false ->
-    get_cancel_timer_options(Opts, Bool, Info);
-get_cancel_timer_options([{info, Bool} | Opts],
-			 Async, _Info) when Bool == true;
-					    Bool == false ->
-    get_cancel_timer_options(Opts, Async, Bool).
-    
+cancel_timer(_TimerRef, _Options) ->
+    erlang:nif_error(undefined).
 
 %% check_old_code/1
 -spec check_old_code(Module) -> boolean() when
@@ -1538,8 +1481,8 @@ raise(_Class, _Reason, _Stacktrace) ->
 -spec erlang:read_timer(TimerRef) -> non_neg_integer() | false when
       TimerRef :: reference().
 
-read_timer(TimerRef) ->
-    read_timer(TimerRef, []).
+read_timer(_TimerRef) ->
+    erlang:nif_error(undefined).
 
 %% read_timer/2
 -spec erlang:read_timer(TimerRef, Options) -> non_neg_integer() | false | ok when
@@ -1547,43 +1490,8 @@ read_timer(TimerRef) ->
       Option :: {async, boolean()},
       Options :: [Option].
 
-read_timer(TimerRef, Options) ->
-    try
-	Async = get_read_timer_options(Options, false),
-	case erts_internal:access_bif_timer(TimerRef) of
-	    undefined ->
-		case Async of
-		    true ->
-			erlang:self() ! {read_timer, TimerRef, false},
-			ok;
-		    false ->
-			false
-		end;
-	    {BTR, TSrv} ->
-		case Async of
-		    true ->
-			TSrv ! {read_timeout, BTR, erlang:self(),
-				TimerRef, TimerRef},
-			ok;
-		    false ->
-			Req = erlang:make_ref(),
-			TSrv ! {read_timeout, BTR, erlang:self(),
-				Req, TimerRef},
-			receive
-			    {read_timer, Req, Result} ->
-				Result
-			end
-		end
-	end
-    catch
-	_:_ -> erlang:error(badarg, [TimerRef])
-    end.
-
-get_read_timer_options([], Async) ->
-    Async;
-get_read_timer_options([{async, Bool} | Opts],
-		       _Async) when Bool == true; Bool == false ->
-    get_read_timer_options(Opts, Bool).
+read_timer(_TimerRef, _Options) ->
+    erlang:nif_error(undefined).
 
 %% ref_to_list/1
 -spec erlang:ref_to_list(Ref) -> string() when
@@ -1630,35 +1538,20 @@ self() ->
       Msg :: term(),
       TimerRef :: reference().
 
-send_after(0, Dest, Msg) ->
-    try
-	true = ((erlang:is_pid(Dest)
-		 andalso erlang:node(Dest) == erlang:node())
-		orelse (erlang:is_atom(Dest)
-			andalso Dest /= undefined)),
-	try Dest ! Msg catch _:_ -> ok end,
-	erlang:make_ref()
-    catch
-	_:_ ->
-	    erlang:error(badarg, [0, Dest, Msg])
-    end;
-send_after(Time, Dest, Msg) ->
-    Now = erlang:monotonic_time(),
-    try
-	true = ((erlang:is_pid(Dest)
-		 andalso erlang:node(Dest) == erlang:node())
-		orelse (erlang:is_atom(Dest)
-			andalso Dest /= undefined)),
-	true = Time > 0,
-	true = Time < (1 bsl 32), % Maybe lift this restriction...
-	TO = Now + (erts_internal:time_unit()*Time) div 1000,
-	{BTR, TSrv, TRef} = erts_internal:create_bif_timer(),
-	TSrv ! {set_timeout, BTR, Dest, TO, TRef, Msg},
-	TRef
-    catch
-	_:_ ->
-	    erlang:error(badarg, [Time, Dest, Msg])
-    end.
+send_after(_Time, _Dest, _Msg) ->
+    erlang:nif_error(undefined).
+
+%% send_after/4
+-spec erlang:send_after(Time, Dest, Msg, Options) -> TimerRef when
+      Time :: integer(),
+      Dest :: pid() | atom(),
+      Msg :: term(),
+      Options :: [Option],
+      Option :: {abs, boolean()} | {accessor, pid()},
+      TimerRef :: reference().
+
+send_after(_Time, _Dest, _Msg, _Options) ->
+    erlang:nif_error(undefined).
 
 %% seq_trace/2
 -spec erlang:seq_trace(P1, P2) -> seq_trace_info_returns() | {term(), term(), term(), term(), term()} when
@@ -1731,37 +1624,21 @@ split_binary(_Bin, _Pos) ->
       Dest :: pid() | atom(),
       Msg :: term(),
       TimerRef :: reference().
-start_timer(0, Dest, Msg) ->
-    try
-	true = ((erlang:is_pid(Dest)
-		 andalso erlang:node(Dest) == erlang:node())
-		orelse (erlang:is_atom(Dest)
-			andalso Dest /= undefined)),
-	TimerRef = erlang:make_ref(),
-	_ = try Dest ! {timeout, TimerRef, Msg} catch _:_ -> ok end,
-	TimerRef
-    catch
-	_:_ ->
-	    erlang:error(badarg, [0, Dest, Msg])
-    end;
-start_timer(Time, Dest, Msg) ->
-    Now = erlang:monotonic_time(),
-    try
-	true = ((erlang:is_pid(Dest)
-		 andalso erlang:node(Dest) == erlang:node())
-		orelse (erlang:is_atom(Dest)
-			andalso Dest /= undefined)),
-	true = Time > 0,
-	true = Time < (1 bsl 32), % Maybe lift this restriction...
-	TO = Now + (erts_internal:time_unit()*Time) div 1000,
-	{BTR, TSrv, TimerRef} = erts_internal:create_bif_timer(),
-	TSrv ! {set_timeout, BTR, Dest, TO, TimerRef,
-		{timeout, TimerRef, Msg}},
-	TimerRef
-    catch
-	_:_ ->
-	    erlang:error(badarg, [Time, Dest, Msg])
-    end.
+
+start_timer(_Time, _Dest, _Msg) ->
+    erlang:nif_error(undefined).
+
+%% start_timer/4
+-spec erlang:start_timer(Time, Dest, Msg, Options) -> TimerRef when
+      Time :: integer(),
+      Dest :: pid() | atom(),
+      Msg :: term(),
+      Options :: [Option],
+      Option :: {abs, boolean()} | {accessor, pid()},
+      TimerRef :: reference().
+
+start_timer(_Time, _Dest, _Msg, _Options) ->
+    erlang:nif_error(undefined).
 
 %% suspend_process/2
 -spec erlang:suspend_process(Suspendee, OptList) -> boolean() when
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index e489001532..65a1f1ed3a 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -40,13 +40,9 @@
 
 -export([flush_monitor_messages/3]).
 
--export([time_unit/0]).
-
--export([bif_timer_server/2]).
-
--export([get_bif_timer_servers/0, create_bif_timer/0, access_bif_timer/1]).
+-export([await_result/1]).
 
--export([monitor_process/2]).
+-export([time_unit/0]).
 
 -export([is_system_process/1]).
 
@@ -61,6 +57,16 @@ await_port_send_result(Ref, Busy, Ok) ->
     end.
 
 %%
+%% Await result...
+%%
+
+await_result(Ref) when is_reference(Ref) ->
+    receive
+	{Ref, Result} ->
+	    Result
+    end.
+
+%%
 %% Statically linked port NIFs
 %%
 
@@ -234,245 +240,8 @@ flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) ->
 time_unit() ->
     erlang:nif_error(undefined).
 
--spec erts_internal:get_bif_timer_servers() -> Pids when
-      Pid :: pid(),
-      Pids :: [Pid].
-
-get_bif_timer_servers() ->
-    erlang:nif_error(undefined).
-
--spec erts_internal:create_bif_timer() -> Res when
-      Res :: {reference(), pid(), reference()}.
-
-create_bif_timer() ->
-    erlang:nif_error(undefined).
-
--spec erts_internal:access_bif_timer(Ref) -> Res when
-      Ref :: reference(),
-      Res :: {reference(), pid()} | 'undefined'.
-
-access_bif_timer(_Ref) ->
-    erlang:nif_error(undefined).
-
--spec erts_internal:monitor_process(Pid, Ref) -> boolean() when
-      Pid :: pid(),
-      Ref :: reference().
-
-monitor_process(_Pid, _Ref) ->
-    erlang:nif_error(undefined).
-
 -spec erts_internal:is_system_process(Pid) -> boolean() when
       Pid :: pid().
 
 is_system_process(_Pid) ->
     erlang:nif_error(undefined).
-
-%%
-%% BIF timer servers
-%%
-
--record(tsrv_state, {rtab,
-		     ttab,
-		     btr,
-		     unit,
-		     next}).
-
-bif_timer_server(N, BTR) ->
-    try
-	tsrv_loop(tsrv_init_static_state(N, BTR), infinity)
-    catch
-	Type:Reason ->
-	    erlang:display({'BIF_timer_server',
-			    {Type, Reason},
-			    erlang:get_stacktrace()}),
-	    exit(Reason)
-    end.
-
-tsrv_init_static_state(N, BTR) ->
-    process_flag(trap_exit, true),
-    NList = integer_to_list(N),
-    RTabName = list_to_atom("BIF_timer_reference_table_" ++ NList),
-    TTabName = list_to_atom("BIF_timer_time_table_" ++ NList),
-    #tsrv_state{rtab = ets:new(RTabName,
-			       [set, private, {keypos, 2}]),
-		ttab = ets:new(TTabName,
-			       [ordered_set, private, {keypos, 1}]),
-		btr = BTR,
-		unit = erts_internal:time_unit(),
-		next = infinity}.
-    
-
-tsrv_loop(#tsrv_state{unit = Unit} = StaticState, Nxt) ->
-    CallTime = erlang:monotonic_time(),
-    %% 'infinity' is greater than all integers...
-    NewNxt = case CallTime >= Nxt of
-		 true ->
-		     tsrv_handle_timeout(CallTime, StaticState);
-		 false ->
-		     TMO = try
-			       (1000*(Nxt - CallTime - 1)) div Unit + 1
-			   catch
-			       error:badarith when Nxt == infinity -> infinity
-			   end,
-		     receive
-			 Msg ->
-			     tsrv_handle_msg(Msg, StaticState, Nxt)
-		     after TMO ->
-			     Nxt
-		     end
-	     end,
-    tsrv_loop(StaticState, NewNxt).
-
-tsrv_handle_msg({set_timeout, BTR, Proc, Time, TRef, Msg},
-		#tsrv_state{rtab = RTab,
-			    ttab = TTab,
-			    btr = BTR},
-		Nxt) when erlang:is_integer(Time) ->
-    RcvTime = erlang:monotonic_time(),
-    case Time =< RcvTime of
-	true ->
-	    try Proc ! Msg catch _:_ -> ok end,
-	    Nxt;
-	false ->
-	    Ins = case erlang:is_atom(Proc) of
-		      true ->
-			  true;
-		      false ->
-			  try
-			      erts_internal:monitor_process(Proc, TRef)
-			  catch
-			      _:_ -> false
-			  end
-		  end,
-	    case Ins of
-		false ->
-		    Nxt;
-		true ->
-		    TKey = {Time, TRef},
-		    true = ets:insert(RTab, TKey),
-		    true = ets:insert(TTab, {TKey, Proc, Msg}),
-		    case Time < Nxt of
-			true -> Time;
-			false -> Nxt
-		    end
-	    end
-    end;
-tsrv_handle_msg({cancel_timeout, BTR, From, Reply, Req, TRef},
-		#tsrv_state{rtab = RTab,
-			    ttab = TTab,
-			    unit = Unit,
-			    btr = BTR},
-		Nxt) ->
-    case ets:lookup(RTab, TRef) of
-	[] ->
-	    case Reply of
-		false ->
-		    ok;
-		_ ->
-		    _ = try From ! {cancel_timer, Req, false} catch _:_ -> ok end
-	    end,
-	    Nxt;
-	[{Time, TRef} = TKey] ->
-	    ets:delete(RTab, TRef),
-	    ets:delete(TTab, TKey),
-	    erlang:demonitor(TRef),
-	    case Reply of
-		false ->
-		    ok;
-		_ ->
-		    RcvTime = erlang:monotonic_time(),
-		    RT = case Time =< RcvTime of
-			     true ->
-				 0;
-			     false ->
-				 ((1000*(Time - RcvTime)) div Unit)
-			 end,
-		    _ = try From ! {cancel_timer, Req, RT} catch _:_ -> ok end
-	    end,
-	    case Time =:= Nxt of
-		false ->
-		    Nxt;
-		true ->
-		    case ets:first(TTab) of
-			'$end_of_table' -> infinity;
-			{NextTime, _TRef} -> NextTime
-		    end
-	    end
-    end;
-tsrv_handle_msg({read_timeout, BTR, From, Req, TRef},
-		#tsrv_state{rtab = RTab,
-			    unit = Unit,
-			    btr = BTR},
-		Nxt) ->
-    case ets:lookup(RTab, TRef) of
-	[] ->
-	    _ = try From ! {read_timer, Req, false} catch _:_ -> ok end;
-	[{Time, TRef}] ->
-	    RcvTime = erlang:monotonic_time(),
-	    RT = case Time =< RcvTime of
-		     true -> 0;
-		     false -> (1000*(Time - RcvTime)) div Unit
-		 end,
-	    _ = try From ! {read_timer, Req, RT} catch _:_ -> ok end
-    end,
-    Nxt;
-tsrv_handle_msg({'DOWN', TRef, process, _, _},
-		#tsrv_state{rtab = RTab,
-			    ttab = TTab},
-		Nxt) ->
-    case ets:lookup(RTab, TRef) of
-	[] ->
-	    Nxt;
-	[{Time, TRef} = TKey] ->
-	    ets:delete(RTab, TRef),
-	    ets:delete(TTab, TKey),
-	    case Time =:= Nxt of
-		false ->
-		    Nxt;
-		true ->
-		    case ets:first(TTab) of
-			'$end_of_table' -> infinity;
-			{NextTime, _} -> NextTime
-		    end
-	    end
-    end;
-tsrv_handle_msg({cancel_all_timeouts, BTR, From, Ref},
-		#tsrv_state{rtab = RTab,
-			    ttab = TTab,
-			    btr = BTR},
-		_Nxt) ->
-    tsrv_delete_monitor_objects(RTab),
-    ets:delete_all_objects(TTab),
-    try From ! {canceled_all_timeouts, Ref} catch _:_ -> ok end,
-    infinity;
-tsrv_handle_msg(_GarbageMsg, _StaticState, Nxt) ->
-    Nxt.
-
-tsrv_delete_monitor_objects(RTab) ->
-    case ets:first(RTab) of
-	'$end_of_table' ->
-	    ok;
-	TRef ->
-	    erlang:demonitor(TRef),
-	    ets:delete(RTab, TRef),
-	    tsrv_delete_monitor_objects(RTab)
-    end.
-
-tsrv_handle_timeout(CallTime, #tsrv_state{rtab = RTab,
-					  ttab = TTab} = S) ->
-    case ets:first(TTab) of
-	'$end_of_table' ->
-	    infinity;
-	{Time, _TRef} when Time > CallTime ->
-	    Time;
-	{_Time, TRef} = TKey ->
-	    [{TKey, Proc, Msg}] = ets:lookup(TTab, TKey),
-	    case erlang:is_pid(Proc) of
-		false -> ok;
-		_ -> erlang:demonitor(TRef)
-	    end,
-	    ets:delete(TTab, TKey),
-	    ets:delete(RTab, TRef),
-	    _ = try Proc ! Msg catch _:_ -> ok end,
-	    tsrv_handle_timeout(CallTime, S)
-    end.
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index 48c5c37717..bb56c9ff73 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -522,7 +522,6 @@ shutdown_pids(Heart,BootPid,State) ->
     Timer = shutdown_timer(State#state.flags),
     catch shutdown(State#state.kernel,BootPid,Timer,State),
     kill_all_pids(Heart), % Even the shutdown timer.
-    cancel_all_bif_timeouts(),
     kill_all_ports(Heart),
     flush_timout(Timer).
 
@@ -581,30 +580,6 @@ resend([ExitMsg|Exits]) ->
 resend(_) ->
     ok.
 
-
-cancel_all_bif_timeouts() ->
-    TSrvs = erts_internal:get_bif_timer_servers(),
-    Ref = make_ref(),
-    {BTR, _TSrv} = erts_internal:access_bif_timer(Ref), %% Cheat...
-    request_cancel_all_bif_timeouts(Ref, BTR, TSrvs),
-    wait_response_cancel_all_bif_timeouts(Ref, BTR, TSrvs),
-    ok.
-
-request_cancel_all_bif_timeouts(_Ref, _BTR, []) ->
-    ok;
-request_cancel_all_bif_timeouts(Ref, BTR, [TSrv|TSrvs]) ->
-    TSrv ! {cancel_all_timeouts, BTR, self(), {Ref, TSrv}},
-    request_cancel_all_bif_timeouts(Ref, BTR, TSrvs).
-
-wait_response_cancel_all_bif_timeouts(_Ref, _BTR, []) ->
-    ok;
-wait_response_cancel_all_bif_timeouts(Ref, BTR, [TSrv|TSrvs]) ->
-    receive
-	{canceled_all_timeouts, {Ref, TSrv}} ->
-	    wait_response_cancel_all_bif_timeouts(Ref, BTR, TSrvs)
-    end.
-
-
 %%
 %% Kill all existing pids in the system (except init and heart).
 kill_all_pids(Heart) ->