1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(timer).
21
22-export([apply_after/4,
23	 send_after/3, send_after/2,
24	 exit_after/3, exit_after/2, kill_after/2, kill_after/1,
25	 apply_interval/4, send_interval/3, send_interval/2,
26	 cancel/1, sleep/1, tc/1, tc/2, tc/3, now_diff/2,
27	 seconds/1, minutes/1, hours/1, hms/3]).
28
29-export([start_link/0, start/0,
30	 handle_call/3,  handle_info/2,
31	 init/1,
32	 code_change/3, handle_cast/2, terminate/2]).
33
34%% internal exports for test purposes only
35-export([get_status/0]).
36
37%% types which can be used by other modules
38-export_type([tref/0]).
39
40%% Max
41-define(MAX_TIMEOUT, 16#0800000).
42-define(TIMER_TAB, timer_tab).
43-define(INTERVAL_TAB, timer_interval_tab).
44
45%%
46%% Time is in milliseconds.
47%%
48-opaque tref()    :: {integer(), reference()}.
49-type time()      :: non_neg_integer().
50
51%%
52%% Interface functions
53%%
54-spec apply_after(Time, Module, Function, Arguments) ->
55                         {'ok', TRef} | {'error', Reason} when
56      Time :: time(),
57      Module :: module(),
58      Function :: atom(),
59      Arguments :: [term()],
60      TRef :: tref(),
61      Reason :: term().
62
63apply_after(Time, M, F, A) ->
64    req(apply_after, {Time, {M, F, A}}).
65
66-spec send_after(Time, Pid, Message) -> {'ok', TRef} | {'error', Reason} when
67      Time :: time(),
68      Pid :: pid() | (RegName :: atom()),
69      Message :: term(),
70      TRef :: tref(),
71      Reason :: term().
72send_after(Time, Pid, Message) ->
73    req(apply_after, {Time, {?MODULE, send, [Pid, Message]}}).
74
75-spec send_after(Time, Message) -> {'ok', TRef} | {'error', Reason} when
76      Time :: time(),
77      Message :: term(),
78      TRef :: tref(),
79      Reason :: term().
80send_after(Time, Message) ->
81    send_after(Time, self(), Message).
82
83-spec exit_after(Time, Pid, Reason1) -> {'ok', TRef} | {'error', Reason2} when
84      Time :: time(),
85      Pid :: pid() | (RegName :: atom()),
86      TRef :: tref(),
87      Reason1 :: term(),
88      Reason2 :: term().
89exit_after(Time, Pid, Reason) ->
90    req(apply_after, {Time, {erlang, exit, [Pid, Reason]}}).
91
92-spec exit_after(Time, Reason1) -> {'ok', TRef} | {'error', Reason2} when
93      Time :: time(),
94      TRef :: tref(),
95      Reason1 :: term(),
96      Reason2 :: term().
97exit_after(Time, Reason) ->
98    exit_after(Time, self(), Reason).
99
100-spec kill_after(Time, Pid) -> {'ok', TRef} | {'error', Reason2} when
101      Time :: time(),
102      Pid :: pid() | (RegName :: atom()),
103      TRef :: tref(),
104      Reason2 :: term().
105kill_after(Time, Pid) ->
106    exit_after(Time, Pid, kill).
107
108-spec kill_after(Time) -> {'ok', TRef} | {'error', Reason2} when
109      Time :: time(),
110      TRef :: tref(),
111      Reason2 :: term().
112kill_after(Time) ->
113    exit_after(Time, self(), kill).
114
115-spec apply_interval(Time, Module, Function, Arguments) ->
116                            {'ok', TRef} | {'error', Reason} when
117      Time :: time(),
118      Module :: module(),
119      Function :: atom(),
120      Arguments :: [term()],
121      TRef :: tref(),
122      Reason :: term().
123apply_interval(Time, M, F, A) ->
124    req(apply_interval, {Time, self(), {M, F, A}}).
125
126-spec send_interval(Time, Pid, Message) ->
127                           {'ok', TRef} | {'error', Reason} when
128      Time :: time(),
129      Pid :: pid() | (RegName :: atom()),
130      Message :: term(),
131      TRef :: tref(),
132      Reason :: term().
133send_interval(Time, Pid, Message) ->
134    req(apply_interval, {Time, Pid, {?MODULE, send, [Pid, Message]}}).
135
136-spec send_interval(Time, Message) -> {'ok', TRef} | {'error', Reason} when
137      Time :: time(),
138      Message :: term(),
139      TRef :: tref(),
140      Reason :: term().
141send_interval(Time, Message) ->
142    send_interval(Time, self(), Message).
143
144-spec cancel(TRef) -> {'ok', 'cancel'} | {'error', Reason} when
145      TRef :: tref(),
146      Reason :: term().
147cancel(BRef) ->
148    req(cancel, BRef).
149
150-spec sleep(Time) -> 'ok' when
151      Time :: timeout().
152sleep(T) ->
153    receive
154    after T -> ok
155    end.
156
157%%
158%% Measure the execution time (in microseconds) for Fun().
159%%
160-spec tc(Fun) -> {Time, Value} when
161      Fun :: function(),
162      Time :: integer(),
163      Value :: term().
164tc(F) ->
165    T1 = erlang:monotonic_time(),
166    Val = F(),
167    T2 = erlang:monotonic_time(),
168    Time = erlang:convert_time_unit(T2 - T1, native, microsecond),
169    {Time, Val}.
170
171%%
172%% Measure the execution time (in microseconds) for Fun(Args).
173%%
174-spec tc(Fun, Arguments) -> {Time, Value} when
175      Fun :: function(),
176      Arguments :: [term()],
177      Time :: integer(),
178      Value :: term().
179tc(F, A) ->
180    T1 = erlang:monotonic_time(),
181    Val = apply(F, A),
182    T2 = erlang:monotonic_time(),
183    Time = erlang:convert_time_unit(T2 - T1, native, microsecond),
184    {Time, Val}.
185
186%%
187%% Measure the execution time (in microseconds) for an MFA.
188%%
189-spec tc(Module, Function, Arguments) -> {Time, Value} when
190      Module :: module(),
191      Function :: atom(),
192      Arguments :: [term()],
193      Time :: integer(),
194      Value :: term().
195tc(M, F, A) ->
196    T1 = erlang:monotonic_time(),
197    Val = apply(M, F, A),
198    T2 = erlang:monotonic_time(),
199    Time = erlang:convert_time_unit(T2 - T1, native, microsecond),
200    {Time, Val}.
201
202%%
203%% Calculate the time difference (in microseconds) of two
204%% erlang:now() timestamps, T2-T1.
205%%
206-spec now_diff(T2, T1) -> Tdiff when
207      T1 :: erlang:timestamp(),
208      T2 :: erlang:timestamp(),
209      Tdiff :: integer().
210now_diff({A2, B2, C2}, {A1, B1, C1}) ->
211    ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1.
212
213%%
214%% Convert seconds, minutes etc. to milliseconds.
215%%
216-spec seconds(Seconds) -> MilliSeconds when
217      Seconds :: non_neg_integer(),
218      MilliSeconds :: non_neg_integer().
219seconds(Seconds) ->
220    1000*Seconds.
221-spec minutes(Minutes) -> MilliSeconds when
222      Minutes :: non_neg_integer(),
223      MilliSeconds :: non_neg_integer().
224minutes(Minutes) ->
225    1000*60*Minutes.
226-spec hours(Hours) -> MilliSeconds when
227      Hours :: non_neg_integer(),
228      MilliSeconds :: non_neg_integer().
229hours(Hours) ->
230    1000*60*60*Hours.
231-spec hms(Hours, Minutes, Seconds) -> MilliSeconds when
232      Hours :: non_neg_integer(),
233      Minutes :: non_neg_integer(),
234      Seconds :: non_neg_integer(),
235      MilliSeconds :: non_neg_integer().
236hms(H, M, S) ->
237    hours(H) + minutes(M) + seconds(S).
238
239%%
240%%   Start/init functions
241%%
242
243%%   Start is only included because of backward compatibility!
244-spec start() -> 'ok'.
245start() ->
246    ensure_started().
247
248-spec start_link() -> {'ok', pid()} | {'error', term()}.
249start_link() ->
250    gen_server:start_link({local, timer_server}, ?MODULE, [], []).
251
252-spec init([]) -> {'ok', [], 'infinity'}.
253init([]) ->
254    process_flag(trap_exit, true),
255    ?TIMER_TAB = ets:new(?TIMER_TAB, [named_table,ordered_set,protected]),
256    ?INTERVAL_TAB = ets:new(?INTERVAL_TAB, [named_table,protected]),
257    {ok, [], infinity}.
258
259-spec ensure_started() -> 'ok'.
260ensure_started() ->
261    case whereis(timer_server) of
262	undefined ->
263	    C = {timer_server, {?MODULE, start_link, []}, permanent, 1000,
264		 worker, [?MODULE]},
265	    _ = supervisor:start_child(kernel_safe_sup, C),
266	    ok;
267	_ -> ok
268    end.
269
270%% server calls
271
272req(Req, Arg) ->
273    SysTime = system_time(),
274    ensure_started(),
275    gen_server:call(timer_server, {Req, Arg, SysTime}, infinity).
276
277%%
278%% handle_call(Request, From, Timers) ->
279%%  {reply, Response, Timers, Timeout}
280%%
281%% Time and Timeout is in milliseconds. Started is in microseconds.
282%%
283-type timers() :: term(). % XXX: refine?
284
285-spec handle_call(term(), term(), timers()) ->
286        {'reply', term(), timers(), timeout()} | {'noreply', timers(), timeout()}.
287handle_call({apply_after, {Time, Op}, Started}, _From, _Ts)
288  when is_integer(Time), Time >= 0 ->
289    BRef = {Started + 1000*Time, make_ref()},
290    Timer = {BRef, timeout, Op},
291    ets:insert(?TIMER_TAB, Timer),
292    Timeout = timer_timeout(system_time()),
293    {reply, {ok, BRef}, [], Timeout};
294handle_call({apply_interval, {Time, To, MFA}, Started}, _From, _Ts)
295  when is_integer(Time), Time >= 0 ->
296    %% To must be a pid or a registered name
297    case get_pid(To) of
298	Pid when is_pid(Pid) ->
299	    catch link(Pid),
300	    SysTime = system_time(),
301	    Ref = make_ref(),
302	    BRef1 = {interval, Ref},
303	    Interval = Time*1000,
304	    BRef2 = {Started + Interval, Ref},
305	    Timer = {BRef2, {repeat, Interval, Pid}, MFA},
306	    ets:insert(?INTERVAL_TAB, {BRef1,BRef2,Pid}),
307	    ets:insert(?TIMER_TAB, Timer),
308	    Timeout = timer_timeout(SysTime),
309	    {reply, {ok, BRef1}, [], Timeout};
310	_ ->
311	    {reply, {error, badarg}, [], next_timeout()}
312    end;
313handle_call({cancel, BRef = {_Time, Ref}, _}, _From, Ts)
314  when is_reference(Ref) ->
315    delete_ref(BRef),
316    {reply, {ok, cancel}, Ts, next_timeout()};
317handle_call({cancel, _BRef, _}, _From, Ts) ->
318    {reply, {error, badarg}, Ts, next_timeout()};
319handle_call({apply_after, _, _}, _From, Ts) ->
320    {reply, {error, badarg}, Ts, next_timeout()};
321handle_call({apply_interval, _, _}, _From, Ts) ->
322    {reply, {error, badarg}, Ts, next_timeout()};
323handle_call(_Else, _From, Ts) ->		  % Catch anything else
324    {noreply, Ts, next_timeout()}.
325
326-spec handle_info(term(), timers()) -> {'noreply', timers(), timeout()}.
327handle_info(timeout, Ts) ->                       % Handle timeouts
328    Timeout = timer_timeout(system_time()),
329    {noreply, Ts, Timeout};
330handle_info({'EXIT',  Pid, _Reason}, Ts) ->       % Oops, someone died
331    pid_delete(Pid),
332    {noreply, Ts, next_timeout()};
333handle_info(_OtherMsg, Ts) ->                     % Other Msg's
334    {noreply, Ts, next_timeout()}.
335
336-spec handle_cast(term(), timers()) -> {'noreply', timers(), timeout()}.
337handle_cast(_Req, Ts) ->                          % Not predicted but handled
338    {noreply, Ts, next_timeout()}.
339
340-spec terminate(term(), _State) -> 'ok'.
341terminate(_Reason, _State) ->
342    ok.
343
344-spec code_change(term(), State, term()) -> {'ok', State}.
345code_change(_OldVsn, State, _Extra) ->
346    %% According to the man for gen server no timer can be set here.
347    {ok, State}.
348
349%%
350%% timer_timeout(SysTime)
351%%
352%% Apply and remove already timed-out timers. A timer is a tuple
353%% {Time, BRef, Op, MFA}, where Time is in microseconds.
354%% Returns {Timeout, Timers}, where Timeout is in milliseconds.
355%%
356timer_timeout(SysTime) ->
357    case ets:first(?TIMER_TAB) of
358	'$end_of_table' ->
359	    infinity;
360	{Time, _Ref} when Time > SysTime ->
361	    Timeout = (Time - SysTime + 999) div 1000,
362	    %% Returned timeout must fit in a small int
363	    erlang:min(Timeout, ?MAX_TIMEOUT);
364	Key ->
365	    case ets:lookup(?TIMER_TAB, Key) of
366		[{Key, timeout, MFA}] ->
367		    ets:delete(?TIMER_TAB,Key),
368		    do_apply(MFA),
369		    timer_timeout(SysTime);
370		[{{Time, Ref}, Repeat = {repeat, Interv, To}, MFA}] ->
371		    ets:delete(?TIMER_TAB,Key),
372		    NewTime = Time + Interv,
373		    %% Update the interval entry (last in table)
374		    ets:insert(?INTERVAL_TAB,{{interval,Ref},{NewTime,Ref},To}),
375		    do_apply(MFA),
376		    ets:insert(?TIMER_TAB, {{NewTime, Ref}, Repeat, MFA}),
377		    timer_timeout(SysTime)
378	    end
379    end.
380
381%%
382%% delete_ref
383%%
384
385delete_ref(BRef = {interval, _}) ->
386    case ets:lookup(?INTERVAL_TAB, BRef) of
387	[{_, BRef2, _Pid}] ->
388	    ets:delete(?INTERVAL_TAB, BRef),
389	    ets:delete(?TIMER_TAB, BRef2);
390	_ -> % TimerReference does not exist, do nothing
391	    ok
392    end;
393delete_ref(BRef) ->
394    ets:delete(?TIMER_TAB, BRef).
395
396%%
397%% pid_delete
398%%
399
400-spec pid_delete(pid()) -> 'ok'.
401pid_delete(Pid) ->
402    IntervalTimerList =
403	ets:select(?INTERVAL_TAB,
404		   [{{'_', '_','$1'},
405		     [{'==','$1',Pid}],
406		     ['$_']}]),
407    lists:foreach(fun({IntKey, TimerKey, _ }) ->
408			  ets:delete(?INTERVAL_TAB, IntKey),
409			  ets:delete(?TIMER_TAB, TimerKey)
410		  end, IntervalTimerList).
411
412%% Calculate time to the next timeout. Returned timeout must fit in a
413%% small int.
414
415-spec next_timeout() -> timeout().
416next_timeout() ->
417    case ets:first(?TIMER_TAB) of
418	'$end_of_table' ->
419	    infinity;
420	{Time, _} ->
421	    erlang:min(positive((Time - system_time() + 999) div 1000), ?MAX_TIMEOUT)
422    end.
423
424%% Help functions
425do_apply({M,F,A}) ->
426    case {M, F, A} of
427	{?MODULE, send, A} ->
428	    %% If send op. send directly, (faster than spawn)
429	    catch send(A);
430	{erlang, exit, [Name, Reason]} ->
431	    catch exit(get_pid(Name), Reason);
432	_ ->
433	    %% else spawn process with the operation
434	    catch spawn(M,F,A)
435    end.
436
437positive(X) ->
438    erlang:max(X, 0).
439
440
441%%
442%%  system_time() -> time in microseconds
443%%
444system_time() ->
445    erlang:monotonic_time(1000000).
446
447send([Pid, Msg]) ->
448    Pid ! Msg.
449
450get_pid(Name) when is_pid(Name) ->
451    Name;
452get_pid(undefined) ->
453    undefined;
454get_pid(Name) when is_atom(Name) ->
455    get_pid(whereis(Name));
456get_pid(_) ->
457    undefined.
458
459%%
460%% get_status() ->
461%%    {{TimerTabName,TotalNumTimers},{IntervalTabName,NumIntervalTimers}}
462%%
463%% This function is for test purposes only; it is used by the test suite.
464%% There is a small possibility that there is a mismatch of one entry
465%% between the 2 tables if this call is made when the timer server is
466%% in the middle of a transaction
467
468-spec get_status() ->
469	{{?TIMER_TAB,non_neg_integer()},{?INTERVAL_TAB,non_neg_integer()}}.
470
471get_status() ->
472    Info1 = ets:info(?TIMER_TAB),
473    {size,TotalNumTimers} = lists:keyfind(size, 1, Info1),
474    Info2 = ets:info(?INTERVAL_TAB),
475    {size,NumIntervalTimers} = lists:keyfind(size, 1, Info2),
476    {{?TIMER_TAB,TotalNumTimers},{?INTERVAL_TAB,NumIntervalTimers}}.
477