1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2019. 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(sys).
21
22%% External exports
23-export([suspend/1, suspend/2, resume/1, resume/2,
24	 get_status/1, get_status/2,
25	 get_state/1, get_state/2,
26	 replace_state/2, replace_state/3,
27	 change_code/4, change_code/5,
28	 terminate/2, terminate/3,
29	 log/2, log/3, trace/2, trace/3, statistics/2, statistics/3,
30	 log_to_file/2, log_to_file/3, no_debug/1, no_debug/2,
31	 install/2, install/3, remove/2, remove/3]).
32-export([handle_system_msg/6, handle_system_msg/7, handle_debug/4,
33	 print_log/1, get_log/1, get_debug/3, debug_options/1, suspend_loop_hib/6]).
34
35-deprecated([{get_debug,3,
36              "incorrectly documented and only for internal use. Can often "
37              "be replaced with sys:get_log/1"}]).
38
39%%-----------------------------------------------------------------
40%% Types
41%%-----------------------------------------------------------------
42
43-export_type([dbg_opt/0, dbg_fun/0, debug_option/0]).
44
45-type name()         :: pid() | atom()
46                      | {'global', term()}
47                      | {'via', module(), term()}.
48-type system_event() :: {'in', Msg :: _}
49                      | {'in', Msg :: _, State :: _}
50                      | {'out', Msg :: _, To :: _}
51                      | {'out', Msg :: _, To :: _, State :: _}
52                      | {'noreply', State :: _}
53                      | {'continue', Continuation :: _}
54                      | {'code_change', Event :: _, State :: _}
55                      | {'postpone', Event :: _, State :: _, NextState :: _}
56                      | {'consume', Event :: _, State :: _, NextState :: _}
57                      | {'start_timer', Action :: _, State :: _}
58                      | {'insert_timeout', Event :: _, State :: _}
59                      | {'enter', State :: _}
60                      | {'terminate', Reason :: _, State :: _}
61                      | term().
62-opaque dbg_opt()    :: {'trace', 'true'}
63                      | {'log',
64                         {N :: non_neg_integer(),
65                          [{Event :: system_event(),
66                            FuncState :: _,
67                            FormFunc :: format_fun()}]}}
68                      | {'statistics', {file:date_time(),
69                                        {'reductions', non_neg_integer()},
70                                        MessagesIn :: non_neg_integer(),
71                                        MessagesOut :: non_neg_integer()}}
72                      | {'log_to_file', file:io_device()}
73                      | {Func :: dbg_fun(), FuncState :: term()}
74                      | {FuncId :: term(), Func :: dbg_fun(), FuncState :: term()}.
75-type dbg_fun()      :: fun((FuncState :: _,
76                             Event :: system_event(),
77                             ProcState :: _) -> 'done' | (NewFuncState :: _)).
78
79-type format_fun()   :: fun((Device :: io:device() | file:io_device(),
80			     Event :: system_event(),
81			     Extra :: term()) -> any()).
82
83-type debug_option() ::
84        'trace'
85      | 'log'
86      | {'log', N :: pos_integer()}
87      | 'statistics'
88      | {'log_to_file', FileName :: file:name()}
89      | {'install',
90         {Func :: dbg_fun(), FuncState :: term()}
91         | {FuncId :: term(), Func :: dbg_fun(), FuncState :: term()}}.
92
93%%-----------------------------------------------------------------
94%% System messages
95%%-----------------------------------------------------------------
96-spec suspend(Name) -> 'ok' when
97      Name :: name().
98suspend(Name) -> send_system_msg(Name, suspend).
99
100-spec suspend(Name, Timeout) -> 'ok' when
101      Name :: name(),
102      Timeout :: timeout().
103suspend(Name, Timeout) -> send_system_msg(Name, suspend, Timeout).
104
105-spec resume(Name) -> 'ok' when
106      Name :: name().
107resume(Name) -> send_system_msg(Name, resume).
108
109-spec resume(Name, Timeout) -> 'ok' when
110      Name :: name(),
111      Timeout :: timeout().
112resume(Name, Timeout) -> send_system_msg(Name, resume, Timeout).
113
114-spec get_status(Name) -> Status when
115      Name :: name(),
116      Status :: {status, Pid :: pid(), {module, Module :: module()}, [SItem]},
117      SItem :: (PDict :: [{Key :: term(), Value :: term()}])
118             | (SysState :: 'running' | 'suspended')
119             | (Parent :: pid())
120             | (Dbg :: [dbg_opt()])
121             | (Misc :: term()).
122get_status(Name) -> send_system_msg(Name, get_status).
123
124-spec get_status(Name, Timeout) -> Status when
125      Name :: name(),
126      Timeout :: timeout(),
127      Status :: {status, Pid :: pid(), {module, Module :: module()}, [SItem]},
128      SItem :: (PDict :: [{Key :: term(), Value :: term()}])
129             | (SysState :: 'running' | 'suspended')
130             | (Parent :: pid())
131             | (Dbg :: [dbg_opt()])
132             | (Misc :: term()).
133get_status(Name, Timeout) -> send_system_msg(Name, get_status, Timeout).
134
135-spec get_state(Name) -> State when
136      Name :: name(),
137      State :: term().
138get_state(Name) ->
139    case send_system_msg(Name, get_state) of
140	{error, Reason} -> error(Reason);
141	State -> State
142    end.
143
144-spec get_state(Name, Timeout) -> State when
145      Name :: name(),
146      Timeout :: timeout(),
147      State :: term().
148get_state(Name, Timeout) ->
149    case send_system_msg(Name, get_state, Timeout) of
150	{error, Reason} -> error(Reason);
151	State -> State
152    end.
153
154-spec replace_state(Name, StateFun) -> NewState when
155      Name :: name(),
156      StateFun :: fun((State :: term()) -> NewState :: term()),
157      NewState :: term().
158replace_state(Name, StateFun) ->
159    case send_system_msg(Name, {replace_state, StateFun}) of
160	{error, Reason} -> error(Reason);
161	State -> State
162    end.
163
164-spec replace_state(Name, StateFun, Timeout) -> NewState when
165      Name :: name(),
166      StateFun :: fun((State :: term()) -> NewState :: term()),
167      Timeout :: timeout(),
168      NewState :: term().
169replace_state(Name, StateFun, Timeout) ->
170    case send_system_msg(Name, {replace_state, StateFun}, Timeout) of
171	{error, Reason} -> error(Reason);
172	State -> State
173    end.
174
175-spec change_code(Name, Module, OldVsn, Extra) -> 'ok' | {error, Reason} when
176      Name :: name(),
177      Module :: module(),
178      OldVsn :: 'undefined' | term(),
179      Extra :: term(),
180      Reason :: term().
181change_code(Name, Mod, Vsn, Extra) ->
182    send_system_msg(Name, {change_code, Mod, Vsn, Extra}).
183
184-spec change_code(Name, Module, OldVsn, Extra, Timeout) ->
185                         'ok' | {error, Reason} when
186      Name :: name(),
187      Module :: module(),
188      OldVsn :: 'undefined' | term(),
189      Extra :: term(),
190      Timeout :: timeout(),
191      Reason :: term().
192change_code(Name, Mod, Vsn, Extra, Timeout) ->
193    send_system_msg(Name, {change_code, Mod, Vsn, Extra}, Timeout).
194
195-spec terminate(Name, Reason) -> 'ok' when
196      Name :: name(),
197      Reason :: term().
198terminate(Name, Reason) ->
199    send_system_msg(Name, {terminate, Reason}).
200
201-spec terminate(Name, Reason, Timeout) -> 'ok' when
202      Name :: name(),
203      Reason :: term(),
204      Timeout :: timeout().
205terminate(Name, Reason, Timeout) ->
206    send_system_msg(Name, {terminate, Reason}, Timeout).
207
208%%-----------------------------------------------------------------
209%% Debug commands
210%%-----------------------------------------------------------------
211
212-spec log(Name, Flag) -> 'ok' | {'ok', [system_event()]} when
213      Name :: name(),
214      Flag :: 'true' |
215              {'true', N :: pos_integer()}
216            | 'false' | 'get' | 'print'.
217log(Name, Flag) ->
218    send_system_msg(Name, {debug, {log, Flag}}).
219
220-spec log(Name, Flag, Timeout) -> 'ok' | {'ok', [system_event()]} when
221      Name :: name(),
222      Flag :: 'true' |
223              {'true', N :: pos_integer()}
224            | 'false' | 'get' | 'print',
225      Timeout :: timeout().
226log(Name, Flag, Timeout) ->
227    send_system_msg(Name, {debug, {log, Flag}}, Timeout).
228
229-spec trace(Name, Flag) -> 'ok' when
230      Name :: name(),
231      Flag :: boolean().
232trace(Name, Flag) ->
233    send_system_msg(Name, {debug, {trace, Flag}}).
234
235-spec trace(Name, Flag, Timeout) -> 'ok' when
236      Name :: name(),
237      Flag :: boolean(),
238      Timeout :: timeout().
239trace(Name, Flag, Timeout) ->
240    send_system_msg(Name, {debug, {trace, Flag}}, Timeout).
241
242-spec log_to_file(Name, Flag) -> 'ok' | {'error','open_file'} when
243      Name :: name(),
244      Flag :: (FileName :: string()) | 'false'.
245log_to_file(Name, FileName) ->
246    send_system_msg(Name, {debug, {log_to_file, FileName}}).
247
248-spec log_to_file(Name, Flag, Timeout) -> 'ok' | {'error','open_file'} when
249      Name :: name(),
250      Flag :: (FileName :: string()) | 'false',
251      Timeout :: timeout().
252log_to_file(Name, FileName, Timeout) ->
253    send_system_msg(Name, {debug, {log_to_file, FileName}}, Timeout).
254
255-spec statistics(Name, Flag) -> 'ok' | {'ok', Statistics} when
256      Name :: name(),
257      Flag :: 'true' | 'false' | 'get',
258      Statistics :: [StatisticsTuple] | no_statistics,
259      StatisticsTuple :: {'start_time', DateTime1}
260                       | {'current_time', DateTime2}
261                       | {'reductions', non_neg_integer()}
262                       | {'messages_in', non_neg_integer()}
263                       | {'messages_out', non_neg_integer()},
264      DateTime1 :: file:date_time(),
265      DateTime2 :: file:date_time().
266statistics(Name, Flag) ->
267    send_system_msg(Name, {debug, {statistics, Flag}}).
268
269-spec statistics(Name, Flag, Timeout) -> 'ok' | {'ok', Statistics} when
270      Name :: name(),
271      Flag :: 'true' | 'false' | 'get',
272      Statistics :: [StatisticsTuple] | no_statistics,
273      StatisticsTuple :: {'start_time', DateTime1}
274                       | {'current_time', DateTime2}
275                       | {'reductions', non_neg_integer()}
276                       | {'messages_in', non_neg_integer()}
277                       | {'messages_out', non_neg_integer()},
278      DateTime1 :: file:date_time(),
279      DateTime2 :: file:date_time(),
280      Timeout :: timeout().
281statistics(Name, Flag, Timeout) ->
282    send_system_msg(Name, {debug, {statistics, Flag}}, Timeout).
283
284-spec no_debug(Name) -> 'ok' when
285      Name :: name().
286no_debug(Name) -> send_system_msg(Name, {debug, no_debug}).
287
288-spec no_debug(Name, Timeout) -> 'ok' when
289      Name :: name(),
290      Timeout :: timeout().
291no_debug(Name, Timeout) -> send_system_msg(Name, {debug, no_debug}, Timeout).
292
293-spec install(Name, FuncSpec) -> 'ok' when
294      Name :: name(),
295      FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
296      FuncId :: term(),
297      Func :: dbg_fun(),
298      FuncState :: term().
299install(Name, {Func, FuncState}) ->
300    send_system_msg(Name, {debug, {install, {Func, FuncState}}});
301install(Name, {FuncId, Func, FuncState}) ->
302    send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}).
303
304-spec install(Name, FuncSpec, Timeout) -> 'ok' when
305      Name :: name(),
306      FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
307      FuncId :: term(),
308      Func :: dbg_fun(),
309      FuncState :: term(),
310      Timeout :: timeout().
311install(Name, {Func, FuncState}, Timeout) ->
312    send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout);
313install(Name, {FuncId, Func, FuncState}, Timeout) ->
314    send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}, Timeout).
315
316-spec remove(Name, Func | FuncId) -> 'ok' when
317      Name :: name(),
318      Func :: dbg_fun(),
319      FuncId :: term().
320remove(Name, FuncOrFuncId) ->
321    send_system_msg(Name, {debug, {remove, FuncOrFuncId}}).
322
323-spec remove(Name, Func | FuncId, Timeout) -> 'ok' when
324      Name :: name(),
325      Func :: dbg_fun(),
326      FuncId :: term(),
327      Timeout :: timeout().
328remove(Name, FuncOrFuncId, Timeout) ->
329    send_system_msg(Name, {debug, {remove, FuncOrFuncId}}, Timeout).
330
331%%-----------------------------------------------------------------
332%% All system messages sent are on the form {system, From, Msg}
333%% The receiving side should send Msg to handle_system_msg/5.
334%%-----------------------------------------------------------------
335send_system_msg(Name, Request) ->
336    case catch gen:call(Name, system, Request) of
337	{ok,Res} -> Res;
338	{'EXIT', Reason} -> exit({Reason, mfa(Name, Request)})
339    end.
340
341send_system_msg(Name, Request, Timeout) ->
342    case catch gen:call(Name, system, Request, Timeout) of
343	{ok,Res} -> Res;
344	{'EXIT', Reason} -> exit({Reason, mfa(Name, Request, Timeout)})
345    end.
346
347mfa(Name, {debug, {Func, Arg2}}) ->
348    {sys, Func, [Name, Arg2]};
349mfa(Name, {change_code, Mod, Vsn, Extra}) ->
350    {sys, change_code, [Name, Mod, Vsn, Extra]};
351mfa(Name, {terminate, Reason}) ->
352    {sys, terminate, [Name, Reason]};
353mfa(Name, Atom) ->
354    {sys, Atom, [Name]}.
355
356mfa(Name, Req, Timeout) ->
357    {M, F, A} = mfa(Name, Req),
358    {M, F, A ++ [Timeout]}.
359
360%%-----------------------------------------------------------------
361%% Func: handle_system_msg/6
362%% Purpose: Used by a process module that wishes to take care of
363%%          system messages.  The process receives a {system, From,
364%%          Msg} message, and passes the Msg to this function.
365%% Returns: This function *never* returns! It calls the function
366%%          Module:system_continue(Parent, NDebug, Misc)
367%%          there the process continues the execution or
368%%          Module:system_terminate(Reason, Parent, Debug, Misc) if
369%%          the process should terminate.
370%%          The Module must export system_continue/3, system_terminate/4
371%%          and format_status/2 for status information.
372%%-----------------------------------------------------------------
373-spec handle_system_msg(Msg, From, Parent, Module, Debug, Misc) ->
374                               no_return() when
375      Msg :: term(),
376      From :: {pid(), Tag :: _},
377      Parent :: pid(),
378      Module :: module(),
379      Debug :: [dbg_opt()],
380      Misc :: term().
381handle_system_msg(Msg, From, Parent, Module, Debug, Misc) ->
382    handle_system_msg(running, Msg, From, Parent, Module, Debug, Misc, false).
383
384handle_system_msg(Msg, From, Parent, Mod, Debug, Misc, Hib) ->
385   handle_system_msg(running, Msg, From, Parent, Mod, Debug, Misc, Hib).
386
387handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib) ->
388    case do_cmd(SysState, Msg, Parent, Mod, Debug, Misc) of
389	{suspended, Reply, NDebug, NMisc} ->
390	    _ = gen:reply(From, Reply),
391	    suspend_loop(suspended, Parent, Mod, NDebug, NMisc, Hib);
392	{running, Reply, NDebug, NMisc} ->
393	    _ = gen:reply(From, Reply),
394            Mod:system_continue(Parent, NDebug, NMisc);
395	{{terminating, Reason}, Reply, NDebug, NMisc} ->
396	    _ = gen:reply(From, Reply),
397	    Mod:system_terminate(Reason, Parent, NDebug, NMisc)
398    end.
399
400%%-----------------------------------------------------------------
401%% Func: handle_debug/4
402%% Purpose: Called by a process that wishes to debug an event.
403%%          Func is a formatting function, called as Func(Device, Event).
404%% Returns: [debug_opts()]
405%%-----------------------------------------------------------------
406-spec handle_debug(Debug, FormFunc, Extra, Event) -> [dbg_opt()] when
407      Debug :: [dbg_opt()],
408      FormFunc :: format_fun(),
409      Extra :: term(),
410      Event :: system_event().
411handle_debug([{trace, true} = DbgOpt | T], FormFunc, State, Event) ->
412    print_event({Event, State, FormFunc}),
413    [DbgOpt | handle_debug(T, FormFunc, State, Event)];
414handle_debug([{log, NLog} | T], FormFunc, State, Event) ->
415    Item = {Event, State, FormFunc},
416    [{log, nlog_put(Item, NLog)} | handle_debug(T, FormFunc, State, Event)];
417handle_debug([{log_to_file, Fd} = DbgOpt | T], FormFunc, State, Event) ->
418    print_event(Fd, {Event, State, FormFunc}),
419    [DbgOpt | handle_debug(T, FormFunc, State, Event)];
420handle_debug([{statistics, StatData} | T], FormFunc, State, Event) ->
421    NStatData = stat(Event, StatData),
422    [{statistics, NStatData} | handle_debug(T, FormFunc, State, Event)];
423handle_debug([{FuncId, {Func, FuncState}} | T], FormFunc, State, Event) ->
424    try Func(FuncState, Event, State) of
425        done -> handle_debug(T, FormFunc, State, Event);
426        NFuncState ->
427            [{FuncId, {Func, NFuncState}} |
428             handle_debug(T, FormFunc, State, Event)]
429    catch
430        done -> handle_debug(T, FormFunc, State, Event);
431        NFuncState ->
432            [{FuncId, {Func, NFuncState}} |
433             handle_debug(T, FormFunc, State, Event)];
434        _:_ -> handle_debug(T, FormFunc, State, Event)
435    end;
436handle_debug([{Func, FuncState} | T], FormFunc, State, Event) ->
437    try Func(FuncState, Event, State) of
438	done -> handle_debug(T, FormFunc, State, Event);
439	NFuncState ->
440	    [{Func, NFuncState} | handle_debug(T, FormFunc, State, Event)]
441    catch
442	done -> handle_debug(T, FormFunc, State, Event);
443	NFuncState ->
444	    [{Func, NFuncState} | handle_debug(T, FormFunc, State, Event)];
445        _:_ -> handle_debug(T, FormFunc, State, Event)
446    end;
447handle_debug([], _FormFunc, _State, _Event) ->
448    [].
449
450%%-----------------------------------------------------------------
451%% When a process is suspended, it can only respond to system
452%% messages.
453%%-----------------------------------------------------------------
454suspend_loop(SysState, Parent, Mod, Debug, Misc, Hib) ->
455    case Hib of
456	true ->
457	   suspend_loop_hib(SysState, Parent, Mod, Debug, Misc, Hib);
458	_ ->
459	    receive
460		{system, From, Msg} ->
461		    handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib);
462		{'EXIT', Parent, Reason} ->
463		    Mod:system_terminate(Reason, Parent, Debug, Misc)
464	    end
465    end.
466
467suspend_loop_hib(SysState, Parent, Mod, Debug, Misc, Hib) ->
468    receive
469	{system, From, Msg} ->
470	    handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib);
471	{'EXIT', Parent, Reason} ->
472            Mod:system_terminate(Reason, Parent, Debug, Misc)
473    after 0 -> % Not a system message, go back into hibernation
474	 proc_lib:hibernate(?MODULE, suspend_loop_hib, [SysState, Parent, Mod,
475							Debug, Misc, Hib])
476    end.
477
478
479do_cmd(_, suspend, _Parent, _Mod, Debug, Misc) ->
480    {suspended, ok, Debug, Misc};
481do_cmd(_, resume, _Parent, _Mod, Debug, Misc) ->
482    {running, ok, Debug, Misc};
483do_cmd(SysState, get_state, _Parent, Mod, Debug, Misc) ->
484    {SysState, do_get_state(Mod, Misc), Debug, Misc};
485do_cmd(SysState, {replace_state, StateFun},  _Parent, Mod, Debug, Misc) ->
486    {Res, NMisc} = do_replace_state(StateFun, Mod, Misc),
487    {SysState, Res, Debug, NMisc};
488do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) ->
489    Res = get_status(SysState, Parent, Mod, Debug, Misc),
490    {SysState, Res, Debug, Misc};
491do_cmd(SysState, {debug, What}, _Parent, _Mod, Debug, Misc) ->
492    {Res, NDebug} = debug_cmd(What, Debug),
493    {SysState, Res, NDebug, Misc};
494do_cmd(_, {terminate, Reason}, _Parent, _Mod, Debug, Misc) ->
495    {{terminating, Reason}, ok, Debug, Misc};
496do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent,
497       Mod, Debug, Misc) ->
498    {Res, NMisc} = do_change_code(Mod, Module, Vsn, Extra, Misc),
499    {suspended, Res, Debug, NMisc};
500do_cmd(SysState, Other, _Parent, _Mod, Debug, Misc) ->
501    {SysState, {error, {unknown_system_msg, Other}}, Debug, Misc}.
502
503do_get_state(Mod, Misc) ->
504    case erlang:function_exported(Mod, system_get_state, 1) of
505	true ->
506	    try
507		{ok, State} = Mod:system_get_state(Misc),
508		State
509	    catch
510		Cl:Exc ->
511		    {error, {callback_failed,{Mod,system_get_state},{Cl,Exc}}}
512	    end;
513	false ->
514	    Misc
515    end.
516
517do_replace_state(StateFun, Mod, Misc) ->
518    case erlang:function_exported(Mod, system_replace_state, 2) of
519	true ->
520	    try
521		{ok, State, NMisc} = Mod:system_replace_state(StateFun, Misc),
522		{State, NMisc}
523	    catch
524		Cl:Exc ->
525		    {{error, {callback_failed,{Mod,system_replace_state},{Cl,Exc}}}, Misc}
526	    end;
527	false ->
528	    try
529		NMisc = StateFun(Misc),
530		{NMisc, NMisc}
531	    catch
532		Cl:Exc ->
533		    {{error, {callback_failed,StateFun,{Cl,Exc}}}, Misc}
534	    end
535    end.
536
537get_status(SysState, Parent, Mod, Debug, Misc) ->
538    PDict = get(),
539    FmtMisc =
540        case erlang:function_exported(Mod, format_status, 2) of
541            true ->
542                FmtArgs = [PDict, SysState, Parent, Debug, Misc],
543                Mod:format_status(normal, FmtArgs);
544            _ ->
545                Misc
546        end,
547    {status, self(), {module, Mod},
548     [PDict, SysState, Parent, Debug, FmtMisc]}.
549
550%%-----------------------------------------------------------------
551%% These are the system debug commands.
552%% {trace,       true|false} -> io:format
553%% {log,         true|false|get|print} -> keeps the 10 last debug messages
554%% {log_to_file, FileName | false} -> io:format to file.
555%% {statistics,  true|false|get}   -> keeps track of messages in/out + reds.
556%%-----------------------------------------------------------------
557debug_cmd({trace, true}, Debug) ->
558    {ok, install_debug(trace, true, Debug)};
559debug_cmd({trace, false}, Debug) ->
560    {ok, remove_debug(trace, Debug)};
561debug_cmd({log, true}, Debug) ->
562    NLog = get_debug(log, Debug, nlog_new()),
563    {ok, install_debug(log, nlog_new(NLog), Debug)};
564debug_cmd({log, {true, N}}, Debug) when is_integer(N), 1 =< N ->
565    NLog = get_debug(log, Debug, nlog_new(N)),
566    {ok, install_debug(log, nlog_new(N, NLog), Debug)};
567debug_cmd({log, false}, Debug) ->
568    {ok, remove_debug(log, Debug)};
569debug_cmd({log, print}, Debug) ->
570    print_log(Debug),
571    {ok, Debug};
572debug_cmd({log, get}, Debug) ->
573    NLog = get_debug(log, Debug, nlog_new()),
574    {{ok, [Event || {Event, _State, _FormFunc} <- nlog_get(NLog)]}, Debug};
575debug_cmd({log_to_file, false}, Debug) ->
576    NDebug = close_log_file(Debug),
577    {ok, NDebug};
578debug_cmd({log_to_file, FileName}, Debug) ->
579    NDebug = close_log_file(Debug),
580    case file:open(FileName, [write,{encoding,utf8}]) of
581	{ok, Fd} ->
582	    {ok, install_debug(log_to_file, Fd, NDebug)};
583	_Error ->
584	    {{error, open_file}, NDebug}
585    end;
586debug_cmd({statistics, true}, Debug) ->
587    {ok, install_debug(statistics, init_stat(), Debug)};
588debug_cmd({statistics, false}, Debug) ->
589    {ok, remove_debug(statistics, Debug)};
590debug_cmd({statistics, get}, Debug) ->
591    {{ok, get_stat(get_debug(statistics, Debug, []))}, Debug};
592debug_cmd(no_debug, Debug) ->
593    close_log_file(Debug),
594    {ok, []};
595debug_cmd({install, {Func, FuncState}}, Debug) ->
596    {ok, install_debug(Func, FuncState, Debug)};
597debug_cmd({install, {FuncId, Func, FuncState}}, Debug) ->
598    {ok, install_debug(FuncId, {Func, FuncState}, Debug)};
599debug_cmd({remove, FuncOrFuncId}, Debug) ->
600    {ok, remove_debug(FuncOrFuncId, Debug)};
601debug_cmd(_Unknown, Debug) ->
602    {unknown_debug, Debug}.
603
604
605do_change_code(Mod, Module, Vsn, Extra, Misc) ->
606    case catch Mod:system_code_change(Misc, Module, Vsn, Extra) of
607	{ok, NMisc} -> {ok, NMisc};
608	Else -> {{error, Else}, Misc}
609    end.
610
611print_event(X) -> print_event(standard_io, X).
612
613print_event(Dev, {Event, State, FormFunc}) ->
614    FormFunc(Dev, Event, State).
615
616init_stat() -> {erlang:localtime(), process_info(self(), reductions), 0, 0}.
617
618get_stat({Time, {reductions, Reds}, In, Out}) ->
619    {reductions, Reds2} = process_info(self(), reductions),
620    [{start_time, Time}, {current_time, erlang:localtime()},
621     {reductions, Reds2 - Reds}, {messages_in, In}, {messages_out, Out}];
622get_stat(_) ->
623    no_statistics.
624
625stat({in, _Msg}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
626stat({in, _Msg, _From}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
627stat({out, _Msg, _To}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
628stat({out, _Msg, _To, _State}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
629stat(_, StatData) -> StatData.
630
631%%-----------------------------------------------------------------
632%% Debug structure manipulating functions
633%%-----------------------------------------------------------------
634install_debug(Item, Data, Debug) ->
635    case lists:keysearch(Item, 1, Debug) of
636        false -> [{Item, Data} | Debug];
637        _ -> Debug
638    end.
639remove_debug(Item, Debug) -> lists:keydelete(Item, 1, Debug).
640
641-spec get_debug(Item, Debug, Default) -> term() when
642      Item :: 'log' | 'statistics',
643      Debug :: [dbg_opt()],
644      Default :: term().
645get_debug(Item, Debug, Default) ->
646    get_debug2(Item, Debug, Default).
647
648%% Workaround: accepts more Item types than get_debug/3.
649get_debug2(Item, Debug, Default) ->
650    case lists:keysearch(Item, 1, Debug) of
651	{value, {Item, Data}} -> Data;
652	_ -> Default
653    end.
654
655-spec print_log(Debug) -> 'ok' when
656      Debug :: [dbg_opt()].
657print_log(Debug) ->
658    NLog = get_debug(log, Debug, nlog_new()),
659    lists:foreach(fun print_event/1, nlog_get(NLog)).
660
661-spec get_log(Debug) -> [system_event()] when
662      Debug :: [dbg_opt()].
663get_log(Debug) ->
664    NLog = get_debug(log, Debug, nlog_new()),
665    [Event || {Event, _State, _FormFunc} <- nlog_get(NLog)].
666
667close_log_file(Debug) ->
668    case get_debug2(log_to_file, Debug, []) of
669	[] ->
670	    Debug;
671	Fd ->
672	    ok = file:close(Fd),
673	    remove_debug(log_to_file, Debug)
674    end.
675
676%%-----------------------------------------------------------------
677%% Keep the last N Log functions
678%%-----------------------------------------------------------------
679%%
680%% Streamlined Okasaki queue as base for "keep the last N" log.
681%%
682%% To the reverse list head we cons new items.
683%% The forward list contains elements in insertion order,
684%% so the head is the oldest and the one to drop off
685%% when the log is full.
686%%
687%% Here is how we can get away with only using one cons cell
688%% to wrap the forward and reverse list, and the log size:
689%%
690%% A full log does not need a counter; we just cons one
691%% and drop one:
692%%
693%%     [ReverseList|ForwardList]
694%%
695%% A non-full log is filling up to N elements;
696%% use a down counter instead of a list as first element:
697%%
698%%     [RemainingToFullCount|ReverseList]
699
700nlog_new() ->
701    nlog_new(10).
702%%
703nlog_new([_|_] = NLog) ->
704    nlog_new(10, NLog);
705nlog_new(N) ->
706    [N]. % Empty log size N >= 1
707%%
708nlog_new(N, NLog) ->
709    lists:foldl(
710      fun (Item, NL) -> nlog_put(Item, NL) end,
711      nlog_new(N),
712      nlog_get(NLog)).
713
714%%
715nlog_put(Item, NLog) ->
716    case NLog of
717        [R|FF] when is_list(R) ->
718            %% Full log
719            case FF of
720                [_|F] ->
721                    %% Cons to reverse list, drop from forward list
722                    [[Item|R]|F];
723                [] ->
724                    %% Create new forward list from reverse list,
725                    %% create new empty reverse list
726                    [_|F] = lists:reverse(R, [Item]),
727                    [[]|F]
728            end;
729        [1|R] ->
730            %% Log now gets full
731            [[Item|R]];
732        [J|R] ->
733            %% Filling up to N elements
734            [J - 1,Item|R]
735    end.
736
737nlog_get([[]|F]) ->
738    F;
739nlog_get([[_|_] = R|F]) ->
740    F ++ lists:reverse(R);
741nlog_get([_J|R]) ->
742    lists:reverse(R).
743
744%%-----------------------------------------------------------------
745%% Func: debug_options/1
746%% Purpose: Initiate a debug structure.  Called by a process that
747%%          wishes to initiate the debug structure without the
748%%          system messages.
749%% Returns: [debug_opts()]
750%%-----------------------------------------------------------------
751
752-spec debug_options([Opt :: debug_option()]) -> [dbg_opt()].
753debug_options(Options) ->
754    debug_options(Options, []).
755
756debug_options([trace | T], Debug) ->
757    debug_options(T, install_debug(trace, true, Debug));
758debug_options([log | T], Debug) ->
759    debug_options(T, install_debug(log, nlog_new(), Debug));
760debug_options([{log, N} | T], Debug) when is_integer(N), N > 0 ->
761    debug_options(T, install_debug(log, nlog_new(N), Debug));
762debug_options([statistics | T], Debug) ->
763    debug_options(T, install_debug(statistics, init_stat(), Debug));
764debug_options([{log_to_file, FileName} | T], Debug) ->
765    case file:open(FileName, [write,{encoding,utf8}]) of
766	{ok, Fd} ->
767	    debug_options(T, install_debug(log_to_file, Fd, Debug));
768	_Error ->
769	    debug_options(T, Debug)
770    end;
771debug_options([{install, {Func, FuncState}} | T], Debug) ->
772    debug_options(T, install_debug(Func, FuncState, Debug));
773debug_options([{install, {FuncId, Func, FuncState}} | T], Debug) ->
774    debug_options(T, install_debug(FuncId, {Func, FuncState}, Debug));
775debug_options([_ | T], Debug) ->
776    debug_options(T, Debug);
777debug_options([], Debug) ->
778    Debug.
779