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